diff --git a/src/HOL/Analysis/Convex_Euclidean_Space.thy b/src/HOL/Analysis/Convex_Euclidean_Space.thy
--- a/src/HOL/Analysis/Convex_Euclidean_Space.thy
+++ b/src/HOL/Analysis/Convex_Euclidean_Space.thy
@@ -1,2524 +1,3129 @@
 (* Title:      HOL/Analysis/Convex_Euclidean_Space.thy
    Author:     L C Paulson, University of Cambridge
    Author:     Robert Himmelmann, TU Muenchen
    Author:     Bogdan Grechuk, University of Edinburgh
    Author:     Armin Heller, TU Muenchen
    Author:     Johannes Hoelzl, TU Muenchen
 *)
 
 section \<open>Convex Sets and Functions on (Normed) Euclidean Spaces\<close>
 
 theory Convex_Euclidean_Space
 imports
   Convex
   Topology_Euclidean_Space
 begin
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Topological Properties of Convex Sets and Functions\<close>
 
 lemma convex_supp_sum:
   assumes "convex S" and 1: "supp_sum u I = 1"
       and "\<And>i. i \<in> I \<Longrightarrow> 0 \<le> u i \<and> (u i = 0 \<or> f i \<in> S)"
     shows "supp_sum (\<lambda>i. u i *\<^sub>R f i) I \<in> S"
 proof -
   have fin: "finite {i \<in> I. u i \<noteq> 0}"
     using 1 sum.infinite by (force simp: supp_sum_def support_on_def)
   then have eq: "supp_sum (\<lambda>i. u i *\<^sub>R f i) I = sum (\<lambda>i. u i *\<^sub>R f i) {i \<in> I. u i \<noteq> 0}"
     by (force intro: sum.mono_neutral_left simp: supp_sum_def support_on_def)
   show ?thesis
     apply (simp add: eq)
     apply (rule convex_sum [OF fin \<open>convex S\<close>])
     using 1 assms apply (auto simp: supp_sum_def support_on_def)
     done
 qed
 
 lemma closure_bounded_linear_image_subset:
   assumes f: "bounded_linear f"
   shows "f ` closure S \<subseteq> closure (f ` S)"
   using linear_continuous_on [OF f] closed_closure closure_subset
   by (rule image_closure_subset)
 
 lemma closure_linear_image_subset:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::real_normed_vector"
   assumes "linear f"
   shows "f ` (closure S) \<subseteq> closure (f ` S)"
   using assms unfolding linear_conv_bounded_linear
   by (rule closure_bounded_linear_image_subset)
 
 lemma closed_injective_linear_image:
     fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
     assumes S: "closed S" and f: "linear f" "inj f"
     shows "closed (f ` S)"
 proof -
   obtain g where g: "linear g" "g \<circ> f = id"
     using linear_injective_left_inverse [OF f] by blast
   then have confg: "continuous_on (range f) g"
     using linear_continuous_on linear_conv_bounded_linear by blast
   have [simp]: "g ` f ` S = S"
     using g by (simp add: image_comp)
   have cgf: "closed (g ` f ` S)"
     by (simp add: \<open>g \<circ> f = id\<close> S image_comp)
   have [simp]: "(range f \<inter> g -` S) = f ` S"
     using g unfolding o_def id_def image_def by auto metis+
   show ?thesis
   proof (rule closedin_closed_trans [of "range f"])
     show "closedin (top_of_set (range f)) (f ` S)"
       using continuous_closedin_preimage [OF confg cgf] by simp
     show "closed (range f)"
       apply (rule closed_injective_image_subspace)
       using f apply (auto simp: linear_linear linear_injective_0)
       done
   qed
 qed
 
 lemma closed_injective_linear_image_eq:
     fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
     assumes f: "linear f" "inj f"
       shows "(closed(image f s) \<longleftrightarrow> closed s)"
   by (metis closed_injective_linear_image closure_eq closure_linear_image_subset closure_subset_eq f(1) f(2) inj_image_subset_iff)
 
 lemma closure_injective_linear_image:
     fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
     shows "\<lbrakk>linear f; inj f\<rbrakk> \<Longrightarrow> f ` (closure S) = closure (f ` S)"
   apply (rule subset_antisym)
   apply (simp add: closure_linear_image_subset)
   by (simp add: closure_minimal closed_injective_linear_image closure_subset image_mono)
 
 lemma closure_bounded_linear_image:
     fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
     shows "\<lbrakk>linear f; bounded S\<rbrakk> \<Longrightarrow> f ` (closure S) = closure (f ` S)"
   apply (rule subset_antisym, simp add: closure_linear_image_subset)
   apply (rule closure_minimal, simp add: closure_subset image_mono)
   by (meson bounded_closure closed_closure compact_continuous_image compact_eq_bounded_closed linear_continuous_on linear_conv_bounded_linear)
 
 lemma closure_scaleR:
   fixes S :: "'a::real_normed_vector set"
   shows "((*\<^sub>R) c) ` (closure S) = closure (((*\<^sub>R) c) ` S)"
 proof
   show "((*\<^sub>R) c) ` (closure S) \<subseteq> closure (((*\<^sub>R) c) ` S)"
     using bounded_linear_scaleR_right
     by (rule closure_bounded_linear_image_subset)
   show "closure (((*\<^sub>R) c) ` S) \<subseteq> ((*\<^sub>R) c) ` (closure S)"
     by (intro closure_minimal image_mono closure_subset closed_scaling closed_closure)
 qed
 
 lemma sphere_eq_empty [simp]:
   fixes a :: "'a::{real_normed_vector, perfect_space}"
   shows "sphere a r = {} \<longleftrightarrow> r < 0"
 by (auto simp: sphere_def dist_norm) (metis dist_norm le_less_linear vector_choose_dist)
 
 lemma cone_closure:
   fixes S :: "'a::real_normed_vector set"
   assumes "cone S"
   shows "cone (closure S)"
 proof (cases "S = {}")
   case True
   then show ?thesis by auto
 next
   case False
   then have "0 \<in> S \<and> (\<forall>c. c > 0 \<longrightarrow> (*\<^sub>R) c ` S = S)"
     using cone_iff[of S] assms by auto
   then have "0 \<in> closure S \<and> (\<forall>c. c > 0 \<longrightarrow> (*\<^sub>R) c ` closure S = closure S)"
     using closure_subset by (auto simp: closure_scaleR)
   then show ?thesis
     using False cone_iff[of "closure S"] by auto
 qed
 
 corollary component_complement_connected:
   fixes S :: "'a::real_normed_vector set"
   assumes "connected S" "C \<in> components (-S)"
   shows "connected(-C)"
   using component_diff_connected [of S UNIV] assms
   by (auto simp: Compl_eq_Diff_UNIV)
 
 proposition clopen:
   fixes S :: "'a :: real_normed_vector set"
   shows "closed S \<and> open S \<longleftrightarrow> S = {} \<or> S = UNIV"
     by (force intro!: connected_UNIV [unfolded connected_clopen, rule_format])
 
 corollary compact_open:
   fixes S :: "'a :: euclidean_space set"
   shows "compact S \<and> open S \<longleftrightarrow> S = {}"
   by (auto simp: compact_eq_bounded_closed clopen)
 
 corollary finite_imp_not_open:
     fixes S :: "'a::{real_normed_vector, perfect_space} set"
     shows "\<lbrakk>finite S; open S\<rbrakk> \<Longrightarrow> S={}"
   using clopen [of S] finite_imp_closed not_bounded_UNIV by blast
 
 corollary empty_interior_finite:
     fixes S :: "'a::{real_normed_vector, perfect_space} set"
     shows "finite S \<Longrightarrow> interior S = {}"
   by (metis interior_subset finite_subset open_interior [of S] finite_imp_not_open)
 
 text \<open>Balls, being convex, are connected.\<close>
 
 lemma convex_local_global_minimum:
   fixes s :: "'a::real_normed_vector set"
   assumes "e > 0"
     and "convex_on s f"
     and "ball x e \<subseteq> s"
     and "\<forall>y\<in>ball x e. f x \<le> f y"
   shows "\<forall>y\<in>s. f x \<le> f y"
 proof (rule ccontr)
   have "x \<in> s" using assms(1,3) by auto
   assume "\<not> ?thesis"
   then obtain y where "y\<in>s" and y: "f x > f y" by auto
   then have xy: "0 < dist x y"  by auto
   then obtain u where "0 < u" "u \<le> 1" and u: "u < e / dist x y"
     using field_lbound_gt_zero[of 1 "e / dist x y"] xy \<open>e>0\<close> by auto
   then have "f ((1-u) *\<^sub>R x + u *\<^sub>R y) \<le> (1-u) * f x + u * f y"
     using \<open>x\<in>s\<close> \<open>y\<in>s\<close>
     using assms(2)[unfolded convex_on_def,
       THEN bspec[where x=x], THEN bspec[where x=y], THEN spec[where x="1-u"]]
     by auto
   moreover
   have *: "x - ((1 - u) *\<^sub>R x + u *\<^sub>R y) = u *\<^sub>R (x - y)"
     by (simp add: algebra_simps)
   have "(1 - u) *\<^sub>R x + u *\<^sub>R y \<in> ball x e"
     unfolding mem_ball dist_norm
     unfolding * and norm_scaleR and abs_of_pos[OF \<open>0<u\<close>]
     unfolding dist_norm[symmetric]
     using u
     unfolding pos_less_divide_eq[OF xy]
     by auto
   then have "f x \<le> f ((1 - u) *\<^sub>R x + u *\<^sub>R y)"
     using assms(4) by auto
   ultimately show False
     using mult_strict_left_mono[OF y \<open>u>0\<close>]
     unfolding left_diff_distrib
     by auto
 qed
 
 lemma convex_ball [iff]:
   fixes x :: "'a::real_normed_vector"
   shows "convex (ball x e)"
 proof (auto simp: convex_def)
   fix y z
   assume yz: "dist x y < e" "dist x z < e"
   fix u v :: real
   assume uv: "0 \<le> u" "0 \<le> v" "u + v = 1"
   have "dist x (u *\<^sub>R y + v *\<^sub>R z) \<le> u * dist x y + v * dist x z"
     using uv yz
     using convex_on_dist [of "ball x e" x, unfolded convex_on_def,
       THEN bspec[where x=y], THEN bspec[where x=z]]
     by auto
   then show "dist x (u *\<^sub>R y + v *\<^sub>R z) < e"
     using convex_bound_lt[OF yz uv] by auto
 qed
 
 lemma convex_cball [iff]:
   fixes x :: "'a::real_normed_vector"
   shows "convex (cball x e)"
 proof -
   {
     fix y z
     assume yz: "dist x y \<le> e" "dist x z \<le> e"
     fix u v :: real
     assume uv: "0 \<le> u" "0 \<le> v" "u + v = 1"
     have "dist x (u *\<^sub>R y + v *\<^sub>R z) \<le> u * dist x y + v * dist x z"
       using uv yz
       using convex_on_dist [of "cball x e" x, unfolded convex_on_def,
         THEN bspec[where x=y], THEN bspec[where x=z]]
       by auto
     then have "dist x (u *\<^sub>R y + v *\<^sub>R z) \<le> e"
       using convex_bound_le[OF yz uv] by auto
   }
   then show ?thesis by (auto simp: convex_def Ball_def)
 qed
 
 lemma connected_ball [iff]:
   fixes x :: "'a::real_normed_vector"
   shows "connected (ball x e)"
   using convex_connected convex_ball by auto
 
 lemma connected_cball [iff]:
   fixes x :: "'a::real_normed_vector"
   shows "connected (cball x e)"
   using convex_connected convex_cball by auto
 
 
 lemma bounded_convex_hull:
   fixes s :: "'a::real_normed_vector set"
   assumes "bounded s"
   shows "bounded (convex hull s)"
 proof -
   from assms obtain B where B: "\<forall>x\<in>s. norm x \<le> B"
     unfolding bounded_iff by auto
   show ?thesis
     apply (rule bounded_subset[OF bounded_cball, of _ 0 B])
     unfolding subset_hull[of convex, OF convex_cball]
     unfolding subset_eq mem_cball dist_norm using B
     apply auto
     done
 qed
 
 lemma finite_imp_bounded_convex_hull:
   fixes s :: "'a::real_normed_vector set"
   shows "finite s \<Longrightarrow> bounded (convex hull s)"
   using bounded_convex_hull finite_imp_bounded
   by auto
 
 lemma aff_dim_cball:
   fixes a :: "'n::euclidean_space"
   assumes "e > 0"
   shows "aff_dim (cball a e) = int (DIM('n))"
 proof -
   have "(\<lambda>x. a + x) ` (cball 0 e) \<subseteq> cball a e"
     unfolding cball_def dist_norm by auto
   then have "aff_dim (cball (0 :: 'n::euclidean_space) e) \<le> aff_dim (cball a e)"
     using aff_dim_translation_eq[of a "cball 0 e"]
           aff_dim_subset[of "(+) a ` cball 0 e" "cball a e"]
     by auto
   moreover have "aff_dim (cball (0 :: 'n::euclidean_space) e) = int (DIM('n))"
     using hull_inc[of "(0 :: 'n::euclidean_space)" "cball 0 e"]
       centre_in_cball[of "(0 :: 'n::euclidean_space)"] assms
     by (simp add: dim_cball[of e] aff_dim_zero[of "cball 0 e"])
   ultimately show ?thesis
     using aff_dim_le_DIM[of "cball a e"] by auto
 qed
 
 lemma aff_dim_open:
   fixes S :: "'n::euclidean_space set"
   assumes "open S"
     and "S \<noteq> {}"
   shows "aff_dim S = int (DIM('n))"
 proof -
   obtain x where "x \<in> S"
     using assms by auto
   then obtain e where e: "e > 0" "cball x e \<subseteq> S"
     using open_contains_cball[of S] assms by auto
   then have "aff_dim (cball x e) \<le> aff_dim S"
     using aff_dim_subset by auto
   with e show ?thesis
     using aff_dim_cball[of e x] aff_dim_le_DIM[of S] by auto
 qed
 
 lemma low_dim_interior:
   fixes S :: "'n::euclidean_space set"
   assumes "\<not> aff_dim S = int (DIM('n))"
   shows "interior S = {}"
 proof -
   have "aff_dim(interior S) \<le> aff_dim S"
     using interior_subset aff_dim_subset[of "interior S" S] by auto
   then show ?thesis
     using aff_dim_open[of "interior S"] aff_dim_le_DIM[of S] assms by auto
 qed
 
 corollary empty_interior_lowdim:
   fixes S :: "'n::euclidean_space set"
   shows "dim S < DIM ('n) \<Longrightarrow> interior S = {}"
 by (metis low_dim_interior affine_hull_UNIV dim_affine_hull less_not_refl dim_UNIV)
 
 corollary aff_dim_nonempty_interior:
   fixes S :: "'a::euclidean_space set"
   shows "interior S \<noteq> {} \<Longrightarrow> aff_dim S = DIM('a)"
 by (metis low_dim_interior)
 
 
 subsection \<open>Relative interior of a set\<close>
 
 definition\<^marker>\<open>tag important\<close> "rel_interior S =
   {x. \<exists>T. openin (top_of_set (affine hull S)) T \<and> x \<in> T \<and> T \<subseteq> S}"
 
 lemma rel_interior_mono:
    "\<lbrakk>S \<subseteq> T; affine hull S = affine hull T\<rbrakk>
    \<Longrightarrow> (rel_interior S) \<subseteq> (rel_interior T)"
   by (auto simp: rel_interior_def)
 
 lemma rel_interior_maximal:
    "\<lbrakk>T \<subseteq> S; openin(top_of_set (affine hull S)) T\<rbrakk> \<Longrightarrow> T \<subseteq> (rel_interior S)"
   by (auto simp: rel_interior_def)
 
 lemma rel_interior:
   "rel_interior S = {x \<in> S. \<exists>T. open T \<and> x \<in> T \<and> T \<inter> affine hull S \<subseteq> S}"
   unfolding rel_interior_def[of S] openin_open[of "affine hull S"]
   apply auto
 proof -
   fix x T
   assume *: "x \<in> S" "open T" "x \<in> T" "T \<inter> affine hull S \<subseteq> S"
   then have **: "x \<in> T \<inter> affine hull S"
     using hull_inc by auto
   show "\<exists>Tb. (\<exists>Ta. open Ta \<and> Tb = affine hull S \<inter> Ta) \<and> x \<in> Tb \<and> Tb \<subseteq> S"
     apply (rule_tac x = "T \<inter> (affine hull S)" in exI)
     using * **
     apply auto
     done
 qed
 
 lemma mem_rel_interior: "x \<in> rel_interior S \<longleftrightarrow> (\<exists>T. open T \<and> x \<in> T \<inter> S \<and> T \<inter> affine hull S \<subseteq> S)"
   by (auto simp: rel_interior)
 
 lemma mem_rel_interior_ball:
   "x \<in> rel_interior S \<longleftrightarrow> x \<in> S \<and> (\<exists>e. e > 0 \<and> ball x e \<inter> affine hull S \<subseteq> S)"
   apply (simp add: rel_interior, safe)
   apply (force simp: open_contains_ball)
   apply (rule_tac x = "ball x e" in exI, simp)
   done
 
 lemma rel_interior_ball:
   "rel_interior S = {x \<in> S. \<exists>e. e > 0 \<and> ball x e \<inter> affine hull S \<subseteq> S}"
   using mem_rel_interior_ball [of _ S] by auto
 
 lemma mem_rel_interior_cball:
   "x \<in> rel_interior S \<longleftrightarrow> x \<in> S \<and> (\<exists>e. e > 0 \<and> cball x e \<inter> affine hull S \<subseteq> S)"
   apply (simp add: rel_interior, safe)
   apply (force simp: open_contains_cball)
   apply (rule_tac x = "ball x e" in exI)
   apply (simp add: subset_trans [OF ball_subset_cball], auto)
   done
 
 lemma rel_interior_cball:
   "rel_interior S = {x \<in> S. \<exists>e. e > 0 \<and> cball x e \<inter> affine hull S \<subseteq> S}"
   using mem_rel_interior_cball [of _ S] by auto
 
 lemma rel_interior_empty [simp]: "rel_interior {} = {}"
    by (auto simp: rel_interior_def)
 
 lemma affine_hull_sing [simp]: "affine hull {a :: 'n::euclidean_space} = {a}"
   by (metis affine_hull_eq affine_sing)
 
 lemma rel_interior_sing [simp]:
     fixes a :: "'n::euclidean_space"  shows "rel_interior {a} = {a}"
   apply (auto simp: rel_interior_ball)
   apply (rule_tac x=1 in exI, force)
   done
 
 lemma subset_rel_interior:
   fixes S T :: "'n::euclidean_space set"
   assumes "S \<subseteq> T"
     and "affine hull S = affine hull T"
   shows "rel_interior S \<subseteq> rel_interior T"
   using assms by (auto simp: rel_interior_def)
 
 lemma rel_interior_subset: "rel_interior S \<subseteq> S"
   by (auto simp: rel_interior_def)
 
 lemma rel_interior_subset_closure: "rel_interior S \<subseteq> closure S"
   using rel_interior_subset by (auto simp: closure_def)
 
 lemma interior_subset_rel_interior: "interior S \<subseteq> rel_interior S"
   by (auto simp: rel_interior interior_def)
 
 lemma interior_rel_interior:
   fixes S :: "'n::euclidean_space set"
   assumes "aff_dim S = int(DIM('n))"
   shows "rel_interior S = interior S"
 proof -
   have "affine hull S = UNIV"
     using assms affine_hull_UNIV[of S] by auto
   then show ?thesis
     unfolding rel_interior interior_def by auto
 qed
 
 lemma rel_interior_interior:
   fixes S :: "'n::euclidean_space set"
   assumes "affine hull S = UNIV"
   shows "rel_interior S = interior S"
   using assms unfolding rel_interior interior_def by auto
 
 lemma rel_interior_open:
   fixes S :: "'n::euclidean_space set"
   assumes "open S"
   shows "rel_interior S = S"
   by (metis assms interior_eq interior_subset_rel_interior rel_interior_subset set_eq_subset)
 
 lemma interior_ball [simp]: "interior (ball x e) = ball x e"
   by (simp add: interior_open)
 
 lemma interior_rel_interior_gen:
   fixes S :: "'n::euclidean_space set"
   shows "interior S = (if aff_dim S = int(DIM('n)) then rel_interior S else {})"
   by (metis interior_rel_interior low_dim_interior)
 
 lemma rel_interior_nonempty_interior:
   fixes S :: "'n::euclidean_space set"
   shows "interior S \<noteq> {} \<Longrightarrow> rel_interior S = interior S"
 by (metis interior_rel_interior_gen)
 
 lemma affine_hull_nonempty_interior:
   fixes S :: "'n::euclidean_space set"
   shows "interior S \<noteq> {} \<Longrightarrow> affine hull S = UNIV"
 by (metis affine_hull_UNIV interior_rel_interior_gen)
 
 lemma rel_interior_affine_hull [simp]:
   fixes S :: "'n::euclidean_space set"
   shows "rel_interior (affine hull S) = affine hull S"
 proof -
   have *: "rel_interior (affine hull S) \<subseteq> affine hull S"
     using rel_interior_subset by auto
   {
     fix x
     assume x: "x \<in> affine hull S"
     define e :: real where "e = 1"
     then have "e > 0" "ball x e \<inter> affine hull (affine hull S) \<subseteq> affine hull S"
       using hull_hull[of _ S] by auto
     then have "x \<in> rel_interior (affine hull S)"
       using x rel_interior_ball[of "affine hull S"] by auto
   }
   then show ?thesis using * by auto
 qed
 
 lemma rel_interior_UNIV [simp]: "rel_interior (UNIV :: ('n::euclidean_space) set) = UNIV"
   by (metis open_UNIV rel_interior_open)
 
 lemma rel_interior_convex_shrink:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S"
     and "c \<in> rel_interior S"
     and "x \<in> S"
     and "0 < e"
     and "e \<le> 1"
   shows "x - e *\<^sub>R (x - c) \<in> rel_interior S"
 proof -
   obtain d where "d > 0" and d: "ball c d \<inter> affine hull S \<subseteq> S"
     using assms(2) unfolding  mem_rel_interior_ball by auto
   {
     fix y
     assume as: "dist (x - e *\<^sub>R (x - c)) y < e * d" "y \<in> affine hull S"
     have *: "y = (1 - (1 - e)) *\<^sub>R ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) + (1 - e) *\<^sub>R x"
       using \<open>e > 0\<close> by (auto simp: scaleR_left_diff_distrib scaleR_right_diff_distrib)
     have "x \<in> affine hull S"
       using assms hull_subset[of S] by auto
     moreover have "1 / e + - ((1 - e) / e) = 1"
       using \<open>e > 0\<close> left_diff_distrib[of "1" "(1-e)" "1/e"] by auto
     ultimately have **: "(1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x \<in> affine hull S"
       using as affine_affine_hull[of S] mem_affine[of "affine hull S" y x "(1 / e)" "-((1 - e) / e)"]
       by (simp add: algebra_simps)
     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)"
       unfolding dist_norm norm_scaleR[symmetric]
       apply (rule arg_cong[where f=norm])
       using \<open>e > 0\<close>
       apply (auto simp: euclidean_eq_iff[where 'a='a] field_simps inner_simps)
       done
     also have "\<dots> = \<bar>1/e\<bar> * norm (x - e *\<^sub>R (x - c) - y)"
       by (auto intro!:arg_cong[where f=norm] simp add: algebra_simps)
     also have "\<dots> < d"
       using as[unfolded dist_norm] and \<open>e > 0\<close>
       by (auto simp:pos_divide_less_eq[OF \<open>e > 0\<close>] mult.commute)
     finally have "y \<in> S"
       apply (subst *)
       apply (rule assms(1)[unfolded convex_alt,rule_format])
       apply (rule d[THEN subsetD])
       unfolding mem_ball
       using assms(3-5) **
       apply auto
       done
   }
   then have "ball (x - e *\<^sub>R (x - c)) (e*d) \<inter> affine hull S \<subseteq> S"
     by auto
   moreover have "e * d > 0"
     using \<open>e > 0\<close> \<open>d > 0\<close> by simp
   moreover have c: "c \<in> S"
     using assms rel_interior_subset by auto
   moreover from c have "x - e *\<^sub>R (x - c) \<in> S"
     using convexD_alt[of S x c e]
     apply (simp add: algebra_simps)
     using assms
     apply auto
     done
   ultimately show ?thesis
     using mem_rel_interior_ball[of "x - e *\<^sub>R (x - c)" S] \<open>e > 0\<close> by auto
 qed
 
 lemma interior_real_atLeast [simp]:
   fixes a :: real
   shows "interior {a..} = {a<..}"
 proof -
   {
     fix y
     assume "a < y"
     then have "y \<in> interior {a..}"
       apply (simp add: mem_interior)
       apply (rule_tac x="(y-a)" in exI)
       apply (auto simp: dist_norm)
       done
   }
   moreover
   {
     fix y
     assume "y \<in> interior {a..}"
     then obtain e where e: "e > 0" "cball y e \<subseteq> {a..}"
       using mem_interior_cball[of y "{a..}"] by auto
     moreover from e have "y - e \<in> cball y e"
       by (auto simp: cball_def dist_norm)
     ultimately have "a \<le> y - e" by blast
     then have "a < y" using e by auto
   }
   ultimately show ?thesis by auto
 qed
 
 lemma continuous_ge_on_Ioo:
   assumes "continuous_on {c..d} g" "\<And>x. x \<in> {c<..<d} \<Longrightarrow> g x \<ge> a" "c < d" "x \<in> {c..d}"
   shows "g (x::real) \<ge> (a::real)"
 proof-
   from assms(3) have "{c..d} = closure {c<..<d}" by (rule closure_greaterThanLessThan[symmetric])
   also from assms(2) have "{c<..<d} \<subseteq> (g -` {a..} \<inter> {c..d})" by auto
   hence "closure {c<..<d} \<subseteq> closure (g -` {a..} \<inter> {c..d})" by (rule closure_mono)
   also from assms(1) have "closed (g -` {a..} \<inter> {c..d})"
     by (auto simp: continuous_on_closed_vimage)
   hence "closure (g -` {a..} \<inter> {c..d}) = g -` {a..} \<inter> {c..d}" by simp
   finally show ?thesis using \<open>x \<in> {c..d}\<close> by auto
 qed
 
 lemma interior_real_atMost [simp]:
   fixes a :: real
   shows "interior {..a} = {..<a}"
 proof -
   {
     fix y
     assume "a > y"
     then have "y \<in> interior {..a}"
       apply (simp add: mem_interior)
       apply (rule_tac x="(a-y)" in exI)
       apply (auto simp: dist_norm)
       done
   }
   moreover
   {
     fix y
     assume "y \<in> interior {..a}"
     then obtain e where e: "e > 0" "cball y e \<subseteq> {..a}"
       using mem_interior_cball[of y "{..a}"] by auto
     moreover from e have "y + e \<in> cball y e"
       by (auto simp: cball_def dist_norm)
     ultimately have "a \<ge> y + e" by auto
     then have "a > y" using e by auto
   }
   ultimately show ?thesis by auto
 qed
 
 lemma interior_atLeastAtMost_real [simp]: "interior {a..b} = {a<..<b :: real}"
 proof-
   have "{a..b} = {a..} \<inter> {..b}" by auto
   also have "interior \<dots> = {a<..} \<inter> {..<b}"
     by (simp add: interior_real_atLeast interior_real_atMost)
   also have "\<dots> = {a<..<b}" by auto
   finally show ?thesis .
 qed
 
 lemma interior_atLeastLessThan [simp]:
   fixes a::real shows "interior {a..<b} = {a<..<b}"
   by (metis atLeastLessThan_def greaterThanLessThan_def interior_atLeastAtMost_real interior_Int interior_interior interior_real_atLeast)
 
 lemma interior_lessThanAtMost [simp]:
   fixes a::real shows "interior {a<..b} = {a<..<b}"
   by (metis atLeastAtMost_def greaterThanAtMost_def interior_atLeastAtMost_real interior_Int
             interior_interior interior_real_atLeast)
 
 lemma interior_greaterThanLessThan_real [simp]: "interior {a<..<b} = {a<..<b :: real}"
   by (metis interior_atLeastAtMost_real interior_interior)
 
 lemma frontier_real_atMost [simp]:
   fixes a :: real
   shows "frontier {..a} = {a}"
   unfolding frontier_def by (auto simp: interior_real_atMost)
 
 lemma frontier_real_atLeast [simp]: "frontier {a..} = {a::real}"
   by (auto simp: frontier_def)
 
 lemma frontier_real_greaterThan [simp]: "frontier {a<..} = {a::real}"
   by (auto simp: interior_open frontier_def)
 
 lemma frontier_real_lessThan [simp]: "frontier {..<a} = {a::real}"
   by (auto simp: interior_open frontier_def)
 
 lemma rel_interior_real_box [simp]:
   fixes a b :: real
   assumes "a < b"
   shows "rel_interior {a .. b} = {a <..< b}"
 proof -
   have "box a b \<noteq> {}"
     using assms
     unfolding set_eq_iff
     by (auto intro!: exI[of _ "(a + b) / 2"] simp: box_def)
   then show ?thesis
     using interior_rel_interior_gen[of "cbox a b", symmetric]
     by (simp split: if_split_asm del: box_real add: box_real[symmetric] interior_cbox)
 qed
 
 lemma rel_interior_real_semiline [simp]:
   fixes a :: real
   shows "rel_interior {a..} = {a<..}"
 proof -
   have *: "{a<..} \<noteq> {}"
     unfolding set_eq_iff by (auto intro!: exI[of _ "a + 1"])
   then show ?thesis using interior_real_atLeast interior_rel_interior_gen[of "{a..}"]
     by (auto split: if_split_asm)
 qed
 
 subsubsection \<open>Relative open sets\<close>
 
 definition\<^marker>\<open>tag important\<close> "rel_open S \<longleftrightarrow> rel_interior S = S"
 
 lemma rel_open: "rel_open S \<longleftrightarrow> openin (top_of_set (affine hull S)) S"
   unfolding rel_open_def rel_interior_def
   apply auto
   using openin_subopen[of "top_of_set (affine hull S)" S]
   apply auto
   done
 
 lemma openin_rel_interior: "openin (top_of_set (affine hull S)) (rel_interior S)"
   apply (simp add: rel_interior_def)
   apply (subst openin_subopen, blast)
   done
 
 lemma openin_set_rel_interior:
    "openin (top_of_set S) (rel_interior S)"
 by (rule openin_subset_trans [OF openin_rel_interior rel_interior_subset hull_subset])
 
 lemma affine_rel_open:
   fixes S :: "'n::euclidean_space set"
   assumes "affine S"
   shows "rel_open S"
   unfolding rel_open_def
   using assms rel_interior_affine_hull[of S] affine_hull_eq[of S]
   by metis
 
 lemma affine_closed:
   fixes S :: "'n::euclidean_space set"
   assumes "affine S"
   shows "closed S"
 proof -
   {
     assume "S \<noteq> {}"
     then obtain L where L: "subspace L" "affine_parallel S L"
       using assms affine_parallel_subspace[of S] by auto
     then obtain a where a: "S = ((+) a ` L)"
       using affine_parallel_def[of L S] affine_parallel_commut by auto
     from L have "closed L" using closed_subspace by auto
     then have "closed S"
       using closed_translation a by auto
   }
   then show ?thesis by auto
 qed
 
 lemma closure_affine_hull:
   fixes S :: "'n::euclidean_space set"
   shows "closure S \<subseteq> affine hull S"
   by (intro closure_minimal hull_subset affine_closed affine_affine_hull)
 
 lemma closure_same_affine_hull [simp]:
   fixes S :: "'n::euclidean_space set"
   shows "affine hull (closure S) = affine hull S"
 proof -
   have "affine hull (closure S) \<subseteq> affine hull S"
     using hull_mono[of "closure S" "affine hull S" "affine"]
       closure_affine_hull[of S] hull_hull[of "affine" S]
     by auto
   moreover have "affine hull (closure S) \<supseteq> affine hull S"
     using hull_mono[of "S" "closure S" "affine"] closure_subset by auto
   ultimately show ?thesis by auto
 qed
 
 lemma closure_aff_dim [simp]:
   fixes S :: "'n::euclidean_space set"
   shows "aff_dim (closure S) = aff_dim S"
 proof -
   have "aff_dim S \<le> aff_dim (closure S)"
     using aff_dim_subset closure_subset by auto
   moreover have "aff_dim (closure S) \<le> aff_dim (affine hull S)"
     using aff_dim_subset closure_affine_hull by blast
   moreover have "aff_dim (affine hull S) = aff_dim S"
     using aff_dim_affine_hull by auto
   ultimately show ?thesis by auto
 qed
 
 lemma rel_interior_closure_convex_shrink:
   fixes S :: "_::euclidean_space set"
   assumes "convex S"
     and "c \<in> rel_interior S"
     and "x \<in> closure S"
     and "e > 0"
     and "e \<le> 1"
   shows "x - e *\<^sub>R (x - c) \<in> rel_interior S"
 proof -
   obtain d where "d > 0" and d: "ball c d \<inter> affine hull S \<subseteq> S"
     using assms(2) unfolding mem_rel_interior_ball by auto
   have "\<exists>y \<in> S. norm (y - x) * (1 - e) < e * d"
   proof (cases "x \<in> S")
     case True
     then show ?thesis using \<open>e > 0\<close> \<open>d > 0\<close>
       apply (rule_tac bexI[where x=x], auto)
       done
   next
     case False
     then have x: "x islimpt S"
       using assms(3)[unfolded closure_def] by auto
     show ?thesis
     proof (cases "e = 1")
       case True
       obtain y where "y \<in> S" "y \<noteq> x" "dist y x < 1"
         using x[unfolded islimpt_approachable,THEN spec[where x=1]] by auto
       then show ?thesis
         apply (rule_tac x=y in bexI)
         unfolding True
         using \<open>d > 0\<close>
         apply auto
         done
     next
       case False
       then have "0 < e * d / (1 - e)" and *: "1 - e > 0"
         using \<open>e \<le> 1\<close> \<open>e > 0\<close> \<open>d > 0\<close> by auto
       then obtain y where "y \<in> S" "y \<noteq> x" "dist y x < e * d / (1 - e)"
         using x[unfolded islimpt_approachable,THEN spec[where x="e*d / (1 - e)"]] by auto
       then show ?thesis
         apply (rule_tac x=y in bexI)
         unfolding dist_norm
         using pos_less_divide_eq[OF *]
         apply auto
         done
     qed
   qed
   then obtain y where "y \<in> S" and y: "norm (y - x) * (1 - e) < e * d"
     by auto
   define z where "z = c + ((1 - e) / e) *\<^sub>R (x - y)"
   have *: "x - e *\<^sub>R (x - c) = y - e *\<^sub>R (y - z)"
     unfolding z_def using \<open>e > 0\<close>
     by (auto simp: scaleR_right_diff_distrib scaleR_right_distrib scaleR_left_diff_distrib)
   have zball: "z \<in> ball c d"
     using mem_ball z_def dist_norm[of c]
     using y and assms(4,5)
     by (simp add: norm_minus_commute) (simp add: field_simps)
   have "x \<in> affine hull S"
     using closure_affine_hull assms by auto
   moreover have "y \<in> affine hull S"
     using \<open>y \<in> S\<close> hull_subset[of S] by auto
   moreover have "c \<in> affine hull S"
     using assms rel_interior_subset hull_subset[of S] by auto
   ultimately have "z \<in> affine hull S"
     using z_def affine_affine_hull[of S]
       mem_affine_3_minus [of "affine hull S" c x y "(1 - e) / e"]
       assms
     by simp
   then have "z \<in> S" using d zball by auto
   obtain d1 where "d1 > 0" and d1: "ball z d1 \<le> ball c d"
     using zball open_ball[of c d] openE[of "ball c d" z] by auto
   then have "ball z d1 \<inter> affine hull S \<subseteq> ball c d \<inter> affine hull S"
     by auto
   then have "ball z d1 \<inter> affine hull S \<subseteq> S"
     using d by auto
   then have "z \<in> rel_interior S"
     using mem_rel_interior_ball using \<open>d1 > 0\<close> \<open>z \<in> S\<close> by auto
   then have "y - e *\<^sub>R (y - z) \<in> rel_interior S"
     using rel_interior_convex_shrink[of S z y e] assms \<open>y \<in> S\<close> by auto
   then show ?thesis using * by auto
 qed
 
 lemma rel_interior_eq:
    "rel_interior s = s \<longleftrightarrow> openin(top_of_set (affine hull s)) s"
 using rel_open rel_open_def by blast
 
 lemma rel_interior_openin:
    "openin(top_of_set (affine hull s)) s \<Longrightarrow> rel_interior s = s"
 by (simp add: rel_interior_eq)
 
 lemma rel_interior_affine:
   fixes S :: "'n::euclidean_space set"
   shows  "affine S \<Longrightarrow> rel_interior S = S"
 using affine_rel_open rel_open_def by auto
 
 lemma rel_interior_eq_closure:
   fixes S :: "'n::euclidean_space set"
   shows "rel_interior S = closure S \<longleftrightarrow> affine S"
 proof (cases "S = {}")
   case True
  then show ?thesis
     by auto
 next
   case False show ?thesis
   proof
     assume eq: "rel_interior S = closure S"
     have "S = {} \<or> S = affine hull S"
       apply (rule connected_clopen [THEN iffD1, rule_format])
        apply (simp add: affine_imp_convex convex_connected)
       apply (rule conjI)
        apply (metis eq closure_subset openin_rel_interior rel_interior_subset subset_antisym)
       apply (metis closed_subset closure_subset_eq eq hull_subset rel_interior_subset)
       done
     with False have "affine hull S = S"
       by auto
     then show "affine S"
       by (metis affine_hull_eq)
   next
     assume "affine S"
     then show "rel_interior S = closure S"
       by (simp add: rel_interior_affine affine_closed)
   qed
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close>\<open>Relative interior preserves under linear transformations\<close>
 
 lemma rel_interior_translation_aux:
   fixes a :: "'n::euclidean_space"
   shows "((\<lambda>x. a + x) ` rel_interior S) \<subseteq> rel_interior ((\<lambda>x. a + x) ` S)"
 proof -
   {
     fix x
     assume x: "x \<in> rel_interior S"
     then obtain T where "open T" "x \<in> T \<inter> S" "T \<inter> affine hull S \<subseteq> S"
       using mem_rel_interior[of x S] by auto
     then have "open ((\<lambda>x. a + x) ` T)"
       and "a + x \<in> ((\<lambda>x. a + x) ` T) \<inter> ((\<lambda>x. a + x) ` S)"
       and "((\<lambda>x. a + x) ` T) \<inter> affine hull ((\<lambda>x. a + x) ` S) \<subseteq> (\<lambda>x. a + x) ` S"
       using affine_hull_translation[of a S] open_translation[of T a] x by auto
     then have "a + x \<in> rel_interior ((\<lambda>x. a + x) ` S)"
       using mem_rel_interior[of "a+x" "((\<lambda>x. a + x) ` S)"] by auto
   }
   then show ?thesis by auto
 qed
 
 lemma rel_interior_translation:
   fixes a :: "'n::euclidean_space"
   shows "rel_interior ((\<lambda>x. a + x) ` S) = (\<lambda>x. a + x) ` rel_interior S"
 proof -
   have "(\<lambda>x. (-a) + x) ` rel_interior ((\<lambda>x. a + x) ` S) \<subseteq> rel_interior S"
     using rel_interior_translation_aux[of "-a" "(\<lambda>x. a + x) ` S"]
       translation_assoc[of "-a" "a"]
     by auto
   then have "((\<lambda>x. a + x) ` rel_interior S) \<supseteq> rel_interior ((\<lambda>x. a + x) ` S)"
     using translation_inverse_subset[of a "rel_interior ((+) a ` S)" "rel_interior S"]
     by auto
   then show ?thesis
     using rel_interior_translation_aux[of a S] by auto
 qed
 
 
 lemma affine_hull_linear_image:
   assumes "bounded_linear f"
   shows "f ` (affine hull s) = affine hull f ` s"
 proof -
   interpret f: bounded_linear f by fact
   have "affine {x. f x \<in> affine hull f ` s}"
     unfolding affine_def
     by (auto simp: f.scaleR f.add affine_affine_hull[unfolded affine_def, rule_format])
   moreover have "affine {x. x \<in> f ` (affine hull s)}"
     using affine_affine_hull[unfolded affine_def, of s]
     unfolding affine_def by (auto simp: f.scaleR [symmetric] f.add [symmetric])
   ultimately show ?thesis
     by (auto simp: hull_inc elim!: hull_induct)
 qed 
 
 
 lemma rel_interior_injective_on_span_linear_image:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
     and S :: "'m::euclidean_space set"
   assumes "bounded_linear f"
     and "inj_on f (span S)"
   shows "rel_interior (f ` S) = f ` (rel_interior S)"
 proof -
   {
     fix z
     assume z: "z \<in> rel_interior (f ` S)"
     then have "z \<in> f ` S"
       using rel_interior_subset[of "f ` S"] by auto
     then obtain x where x: "x \<in> S" "f x = z" by auto
     obtain e2 where e2: "e2 > 0" "cball z e2 \<inter> affine hull (f ` S) \<subseteq> (f ` S)"
       using z rel_interior_cball[of "f ` S"] by auto
     obtain K where K: "K > 0" "\<And>x. norm (f x) \<le> norm x * K"
      using assms Real_Vector_Spaces.bounded_linear.pos_bounded[of f] by auto
     define e1 where "e1 = 1 / K"
     then have e1: "e1 > 0" "\<And>x. e1 * norm (f x) \<le> norm x"
       using K pos_le_divide_eq[of e1] by auto
     define e where "e = e1 * e2"
     then have "e > 0" using e1 e2 by auto
     {
       fix y
       assume y: "y \<in> cball x e \<inter> affine hull S"
       then have h1: "f y \<in> affine hull (f ` S)"
         using affine_hull_linear_image[of f S] assms by auto
       from y have "norm (x-y) \<le> e1 * e2"
         using cball_def[of x e] dist_norm[of x y] e_def by auto
       moreover have "f x - f y = f (x - y)"
         using assms linear_diff[of f x y] linear_conv_bounded_linear[of f] by auto
       moreover have "e1 * norm (f (x-y)) \<le> norm (x - y)"
         using e1 by auto
       ultimately have "e1 * norm ((f x)-(f y)) \<le> e1 * e2"
         by auto
       then have "f y \<in> cball z e2"
         using cball_def[of "f x" e2] dist_norm[of "f x" "f y"] e1 x by auto
       then have "f y \<in> f ` S"
         using y e2 h1 by auto
       then have "y \<in> S"
         using assms y hull_subset[of S] affine_hull_subset_span
           inj_on_image_mem_iff [OF \<open>inj_on f (span S)\<close>]
         by (metis Int_iff span_superset subsetCE)
     }
     then have "z \<in> f ` (rel_interior S)"
       using mem_rel_interior_cball[of x S] \<open>e > 0\<close> x by auto
   }
   moreover
   {
     fix x
     assume x: "x \<in> rel_interior S"
     then obtain e2 where e2: "e2 > 0" "cball x e2 \<inter> affine hull S \<subseteq> S"
       using rel_interior_cball[of S] by auto
     have "x \<in> S" using x rel_interior_subset by auto
     then have *: "f x \<in> f ` S" by auto
     have "\<forall>x\<in>span S. f x = 0 \<longrightarrow> x = 0"
       using assms subspace_span linear_conv_bounded_linear[of f]
         linear_injective_on_subspace_0[of f "span S"]
       by auto
     then obtain e1 where e1: "e1 > 0" "\<forall>x \<in> span S. e1 * norm x \<le> norm (f x)"
       using assms injective_imp_isometric[of "span S" f]
         subspace_span[of S] closed_subspace[of "span S"]
       by auto
     define e where "e = e1 * e2"
     hence "e > 0" using e1 e2 by auto
     {
       fix y
       assume y: "y \<in> cball (f x) e \<inter> affine hull (f ` S)"
       then have "y \<in> f ` (affine hull S)"
         using affine_hull_linear_image[of f S] assms by auto
       then obtain xy where xy: "xy \<in> affine hull S" "f xy = y" by auto
       with y have "norm (f x - f xy) \<le> e1 * e2"
         using cball_def[of "f x" e] dist_norm[of "f x" y] e_def by auto
       moreover have "f x - f xy = f (x - xy)"
         using assms linear_diff[of f x xy] linear_conv_bounded_linear[of f] by auto
       moreover have *: "x - xy \<in> span S"
         using subspace_diff[of "span S" x xy] subspace_span \<open>x \<in> S\<close> xy
           affine_hull_subset_span[of S] span_superset
         by auto
       moreover from * have "e1 * norm (x - xy) \<le> norm (f (x - xy))"
         using e1 by auto
       ultimately have "e1 * norm (x - xy) \<le> e1 * e2"
         by auto
       then have "xy \<in> cball x e2"
         using cball_def[of x e2] dist_norm[of x xy] e1 by auto
       then have "y \<in> f ` S"
         using xy e2 by auto
     }
     then have "f x \<in> rel_interior (f ` S)"
       using mem_rel_interior_cball[of "(f x)" "(f ` S)"] * \<open>e > 0\<close> by auto
   }
   ultimately show ?thesis by auto
 qed
 
 lemma rel_interior_injective_linear_image:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes "bounded_linear f"
     and "inj f"
   shows "rel_interior (f ` S) = f ` (rel_interior S)"
   using assms rel_interior_injective_on_span_linear_image[of f S]
     subset_inj_on[of f "UNIV" "span S"]
   by auto
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Openness and compactness are preserved by convex hull operation\<close>
 
 lemma open_convex_hull[intro]:
   fixes S :: "'a::real_normed_vector set"
   assumes "open S"
   shows "open (convex hull S)"
 proof (clarsimp simp: open_contains_cball convex_hull_explicit)
   fix T and u :: "'a\<Rightarrow>real"
   assume obt: "finite T" "T\<subseteq>S" "\<forall>x\<in>T. 0 \<le> u x" "sum u T = 1" 
 
   from assms[unfolded open_contains_cball] obtain b
     where b: "\<And>x. x\<in>S \<Longrightarrow> 0 < b x \<and> cball x (b x) \<subseteq> S" by metis
   have "b ` T \<noteq> {}"
     using obt by auto
   define i where "i = b ` T"
   let ?\<Phi> = "\<lambda>y. \<exists>F. finite F \<and> F \<subseteq> S \<and> (\<exists>u. (\<forall>x\<in>F. 0 \<le> u x) \<and> sum u F = 1 \<and> (\<Sum>v\<in>F. u v *\<^sub>R v) = y)"
   let ?a = "\<Sum>v\<in>T. u v *\<^sub>R v"
   show "\<exists>e > 0. cball ?a e \<subseteq> {y. ?\<Phi> y}"
   proof (intro exI subsetI conjI)
     show "0 < Min i"
       unfolding i_def and Min_gr_iff[OF finite_imageI[OF obt(1)] \<open>b ` T\<noteq>{}\<close>]
       using b \<open>T\<subseteq>S\<close> by auto
   next
     fix y
     assume "y \<in> cball ?a (Min i)"
     then have y: "norm (?a - y) \<le> Min i"
       unfolding dist_norm[symmetric] by auto
     { fix x
       assume "x \<in> T"
       then have "Min i \<le> b x"
         by (simp add: i_def obt(1))
       then have "x + (y - ?a) \<in> cball x (b x)"
         using y unfolding mem_cball dist_norm by auto
       moreover have "x \<in> S"
         using \<open>x\<in>T\<close> \<open>T\<subseteq>S\<close> by auto
       ultimately have "x + (y - ?a) \<in> S"
         using y b by blast
     }
     moreover
     have *: "inj_on (\<lambda>v. v + (y - ?a)) T"
       unfolding inj_on_def by auto
     have "(\<Sum>v\<in>(\<lambda>v. v + (y - ?a)) ` T. u (v - (y - ?a)) *\<^sub>R v) = y"
       unfolding sum.reindex[OF *] o_def using obt(4)
       by (simp add: sum.distrib sum_subtractf scaleR_left.sum[symmetric] scaleR_right_distrib)
     ultimately show "y \<in> {y. ?\<Phi> y}"
     proof (intro CollectI exI conjI)
       show "finite ((\<lambda>v. v + (y - ?a)) ` T)"
         by (simp add: obt(1))
       show "sum (\<lambda>v. u (v - (y - ?a))) ((\<lambda>v. v + (y - ?a)) ` T) = 1"
         unfolding sum.reindex[OF *] o_def using obt(4) by auto
     qed (use obt(1, 3) in auto)
   qed
 qed
 
 lemma compact_convex_combinations:
   fixes S T :: "'a::real_normed_vector set"
   assumes "compact S" "compact T"
   shows "compact { (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u. 0 \<le> u \<and> u \<le> 1 \<and> x \<in> S \<and> y \<in> T}"
 proof -
   let ?X = "{0..1} \<times> S \<times> T"
   let ?h = "(\<lambda>z. (1 - fst z) *\<^sub>R fst (snd z) + fst z *\<^sub>R snd (snd z))"
   have *: "{ (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u. 0 \<le> u \<and> u \<le> 1 \<and> x \<in> S \<and> y \<in> T} = ?h ` ?X"
     by force
   have "continuous_on ?X (\<lambda>z. (1 - fst z) *\<^sub>R fst (snd z) + fst z *\<^sub>R snd (snd z))"
     unfolding continuous_on by (rule ballI) (intro tendsto_intros)
   with assms show ?thesis
     by (simp add: * compact_Times compact_continuous_image)
 qed
 
 lemma finite_imp_compact_convex_hull:
   fixes S :: "'a::real_normed_vector set"
   assumes "finite S"
   shows "compact (convex hull S)"
 proof (cases "S = {}")
   case True
   then show ?thesis by simp
 next
   case False
   with assms show ?thesis
   proof (induct rule: finite_ne_induct)
     case (singleton x)
     show ?case by simp
   next
     case (insert x A)
     let ?f = "\<lambda>(u, y::'a). u *\<^sub>R x + (1 - u) *\<^sub>R y"
     let ?T = "{0..1::real} \<times> (convex hull A)"
     have "continuous_on ?T ?f"
       unfolding split_def continuous_on by (intro ballI tendsto_intros)
     moreover have "compact ?T"
       by (intro compact_Times compact_Icc insert)
     ultimately have "compact (?f ` ?T)"
       by (rule compact_continuous_image)
     also have "?f ` ?T = convex hull (insert x A)"
       unfolding convex_hull_insert [OF \<open>A \<noteq> {}\<close>]
       apply safe
       apply (rule_tac x=a in exI, simp)
       apply (rule_tac x="1 - a" in exI, simp, fast)
       apply (rule_tac x="(u, b)" in image_eqI, simp_all)
       done
     finally show "compact (convex hull (insert x A))" .
   qed
 qed
 
 lemma compact_convex_hull:
   fixes S :: "'a::euclidean_space set"
   assumes "compact S"
   shows "compact (convex hull S)"
 proof (cases "S = {}")
   case True
   then show ?thesis using compact_empty by simp
 next
   case False
   then obtain w where "w \<in> S" by auto
   show ?thesis
     unfolding caratheodory[of S]
   proof (induct ("DIM('a) + 1"))
     case 0
     have *: "{x.\<exists>sa. finite sa \<and> sa \<subseteq> S \<and> card sa \<le> 0 \<and> x \<in> convex hull sa} = {}"
       using compact_empty by auto
     from 0 show ?case unfolding * by simp
   next
     case (Suc n)
     show ?case
     proof (cases "n = 0")
       case True
       have "{x. \<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T} = S"
         unfolding set_eq_iff and mem_Collect_eq
       proof (rule, rule)
         fix x
         assume "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T"
         then obtain T where T: "finite T" "T \<subseteq> S" "card T \<le> Suc n" "x \<in> convex hull T"
           by auto
         show "x \<in> S"
         proof (cases "card T = 0")
           case True
           then show ?thesis
             using T(4) unfolding card_0_eq[OF T(1)] by simp
         next
           case False
           then have "card T = Suc 0" using T(3) \<open>n=0\<close> by auto
           then obtain a where "T = {a}" unfolding card_Suc_eq by auto
           then show ?thesis using T(2,4) by simp
         qed
       next
         fix x assume "x\<in>S"
         then show "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T"
           apply (rule_tac x="{x}" in exI)
           unfolding convex_hull_singleton
           apply auto
           done
       qed
       then show ?thesis using assms by simp
     next
       case False
       have "{x. \<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T} =
         {(1 - u) *\<^sub>R x + u *\<^sub>R y | x y u.
           0 \<le> u \<and> u \<le> 1 \<and> x \<in> S \<and> y \<in> {x. \<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> n \<and> x \<in> convex hull T}}"
         unfolding set_eq_iff and mem_Collect_eq
       proof (rule, rule)
         fix x
         assume "\<exists>u v c. x = (1 - c) *\<^sub>R u + c *\<^sub>R v \<and>
           0 \<le> c \<and> c \<le> 1 \<and> u \<in> S \<and> (\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> n \<and> v \<in> convex hull T)"
         then obtain u v c T where obt: "x = (1 - c) *\<^sub>R u + c *\<^sub>R v"
           "0 \<le> c \<and> c \<le> 1" "u \<in> S" "finite T" "T \<subseteq> S" "card T \<le> n"  "v \<in> convex hull T"
           by auto
         moreover have "(1 - c) *\<^sub>R u + c *\<^sub>R v \<in> convex hull insert u T"
           apply (rule convexD_alt)
           using obt(2) and convex_convex_hull and hull_subset[of "insert u T" convex]
           using obt(7) and hull_mono[of T "insert u T"]
           apply auto
           done
         ultimately show "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T"
           apply (rule_tac x="insert u T" in exI)
           apply (auto simp: card_insert_if)
           done
       next
         fix x
         assume "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T"
         then obtain T where T: "finite T" "T \<subseteq> S" "card T \<le> Suc n" "x \<in> convex hull T"
           by auto
         show "\<exists>u v c. x = (1 - c) *\<^sub>R u + c *\<^sub>R v \<and>
           0 \<le> c \<and> c \<le> 1 \<and> u \<in> S \<and> (\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> n \<and> v \<in> convex hull T)"
         proof (cases "card T = Suc n")
           case False
           then have "card T \<le> n" using T(3) by auto
           then show ?thesis
             apply (rule_tac x=w in exI, rule_tac x=x in exI, rule_tac x=1 in exI)
             using \<open>w\<in>S\<close> and T
             apply (auto intro!: exI[where x=T])
             done
         next
           case True
           then obtain a u where au: "T = insert a u" "a\<notin>u"
             apply (drule_tac card_eq_SucD, auto)
             done
           show ?thesis
           proof (cases "u = {}")
             case True
             then have "x = a" using T(4)[unfolded au] by auto
             show ?thesis unfolding \<open>x = a\<close>
               apply (rule_tac x=a in exI)
               apply (rule_tac x=a in exI)
               apply (rule_tac x=1 in exI)
               using T and \<open>n \<noteq> 0\<close>
               unfolding au
               apply (auto intro!: exI[where x="{a}"])
               done
           next
             case False
             obtain ux vx b where obt: "ux\<ge>0" "vx\<ge>0" "ux + vx = 1"
               "b \<in> convex hull u" "x = ux *\<^sub>R a + vx *\<^sub>R b"
               using T(4)[unfolded au convex_hull_insert[OF False]]
               by auto
             have *: "1 - vx = ux" using obt(3) by auto
             show ?thesis
               apply (rule_tac x=a in exI)
               apply (rule_tac x=b in exI)
               apply (rule_tac x=vx in exI)
               using obt and T(1-3)
               unfolding au and * using card_insert_disjoint[OF _ au(2)]
               apply (auto intro!: exI[where x=u])
               done
           qed
         qed
       qed
       then show ?thesis
         using compact_convex_combinations[OF assms Suc] by simp
     qed
   qed
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Extremal points of a simplex are some vertices\<close>
 
 lemma dist_increases_online:
   fixes a b d :: "'a::real_inner"
   assumes "d \<noteq> 0"
   shows "dist a (b + d) > dist a b \<or> dist a (b - d) > dist a b"
 proof (cases "inner a d - inner b d > 0")
   case True
   then have "0 < inner d d + (inner a d * 2 - inner b d * 2)"
     apply (rule_tac add_pos_pos)
     using assms
     apply auto
     done
   then show ?thesis
     apply (rule_tac disjI2)
     unfolding dist_norm and norm_eq_sqrt_inner and real_sqrt_less_iff
     apply  (simp add: algebra_simps inner_commute)
     done
 next
   case False
   then have "0 < inner d d + (inner b d * 2 - inner a d * 2)"
     apply (rule_tac add_pos_nonneg)
     using assms
     apply auto
     done
   then show ?thesis
     apply (rule_tac disjI1)
     unfolding dist_norm and norm_eq_sqrt_inner and real_sqrt_less_iff
     apply (simp add: algebra_simps inner_commute)
     done
 qed
 
 lemma norm_increases_online:
   fixes d :: "'a::real_inner"
   shows "d \<noteq> 0 \<Longrightarrow> norm (a + d) > norm a \<or> norm(a - d) > norm a"
   using dist_increases_online[of d a 0] unfolding dist_norm by auto
 
 lemma simplex_furthest_lt:
   fixes S :: "'a::real_inner set"
   assumes "finite S"
   shows "\<forall>x \<in> convex hull S.  x \<notin> S \<longrightarrow> (\<exists>y \<in> convex hull S. norm (x - a) < norm(y - a))"
   using assms
 proof induct
   fix x S
   assume as: "finite S" "x\<notin>S" "\<forall>x\<in>convex hull S. x \<notin> S \<longrightarrow> (\<exists>y\<in>convex hull S. norm (x - a) < norm (y - a))"
   show "\<forall>xa\<in>convex hull insert x S. xa \<notin> insert x S \<longrightarrow>
     (\<exists>y\<in>convex hull insert x S. norm (xa - a) < norm (y - a))"
   proof (intro impI ballI, cases "S = {}")
     case False
     fix y
     assume y: "y \<in> convex hull insert x S" "y \<notin> insert x S"
     obtain u v b where obt: "u\<ge>0" "v\<ge>0" "u + v = 1" "b \<in> convex hull S" "y = u *\<^sub>R x + v *\<^sub>R b"
       using y(1)[unfolded convex_hull_insert[OF False]] by auto
     show "\<exists>z\<in>convex hull insert x S. norm (y - a) < norm (z - a)"
     proof (cases "y \<in> convex hull S")
       case True
       then obtain z where "z \<in> convex hull S" "norm (y - a) < norm (z - a)"
         using as(3)[THEN bspec[where x=y]] and y(2) by auto
       then show ?thesis
         apply (rule_tac x=z in bexI)
         unfolding convex_hull_insert[OF False]
         apply auto
         done
     next
       case False
       show ?thesis
         using obt(3)
       proof (cases "u = 0", case_tac[!] "v = 0")
         assume "u = 0" "v \<noteq> 0"
         then have "y = b" using obt by auto
         then show ?thesis using False and obt(4) by auto
       next
         assume "u \<noteq> 0" "v = 0"
         then have "y = x" using obt by auto
         then show ?thesis using y(2) by auto
       next
         assume "u \<noteq> 0" "v \<noteq> 0"
         then obtain w where w: "w>0" "w<u" "w<v"
           using field_lbound_gt_zero[of u v] and obt(1,2) by auto
         have "x \<noteq> b"
         proof
           assume "x = b"
           then have "y = b" unfolding obt(5)
             using obt(3) by (auto simp: scaleR_left_distrib[symmetric])
           then show False using obt(4) and False by simp
         qed
         then have *: "w *\<^sub>R (x - b) \<noteq> 0" using w(1) by auto
         show ?thesis
           using dist_increases_online[OF *, of a y]
         proof (elim disjE)
           assume "dist a y < dist a (y + w *\<^sub>R (x - b))"
           then have "norm (y - a) < norm ((u + w) *\<^sub>R x + (v - w) *\<^sub>R b - a)"
             unfolding dist_commute[of a]
             unfolding dist_norm obt(5)
             by (simp add: algebra_simps)
           moreover have "(u + w) *\<^sub>R x + (v - w) *\<^sub>R b \<in> convex hull insert x S"
             unfolding convex_hull_insert[OF \<open>S\<noteq>{}\<close>]
           proof (intro CollectI conjI exI)
             show "u + w \<ge> 0" "v - w \<ge> 0"
               using obt(1) w by auto
           qed (use obt in auto)
           ultimately show ?thesis by auto
         next
           assume "dist a y < dist a (y - w *\<^sub>R (x - b))"
           then have "norm (y - a) < norm ((u - w) *\<^sub>R x + (v + w) *\<^sub>R b - a)"
             unfolding dist_commute[of a]
             unfolding dist_norm obt(5)
             by (simp add: algebra_simps)
           moreover have "(u - w) *\<^sub>R x + (v + w) *\<^sub>R b \<in> convex hull insert x S"
             unfolding convex_hull_insert[OF \<open>S\<noteq>{}\<close>]
           proof (intro CollectI conjI exI)
             show "u - w \<ge> 0" "v + w \<ge> 0"
               using obt(1) w by auto
           qed (use obt in auto)
           ultimately show ?thesis by auto
         qed
       qed auto
     qed
   qed auto
 qed (auto simp: assms)
 
 lemma simplex_furthest_le:
   fixes S :: "'a::real_inner set"
   assumes "finite S"
     and "S \<noteq> {}"
   shows "\<exists>y\<in>S. \<forall>x\<in> convex hull S. norm (x - a) \<le> norm (y - a)"
 proof -
   have "convex hull S \<noteq> {}"
     using hull_subset[of S convex] and assms(2) by auto
   then obtain x where x: "x \<in> convex hull S" "\<forall>y\<in>convex hull S. norm (y - a) \<le> norm (x - a)"
     using distance_attains_sup[OF finite_imp_compact_convex_hull[OF \<open>finite S\<close>], of a]
     unfolding dist_commute[of a]
     unfolding dist_norm
     by auto
   show ?thesis
   proof (cases "x \<in> S")
     case False
     then obtain y where "y \<in> convex hull S" "norm (x - a) < norm (y - a)"
       using simplex_furthest_lt[OF assms(1), THEN bspec[where x=x]] and x(1)
       by auto
     then show ?thesis
       using x(2)[THEN bspec[where x=y]] by auto
   next
     case True
     with x show ?thesis by auto
   qed
 qed
 
 lemma simplex_furthest_le_exists:
   fixes S :: "('a::real_inner) set"
   shows "finite S \<Longrightarrow> \<forall>x\<in>(convex hull S). \<exists>y\<in>S. norm (x - a) \<le> norm (y - a)"
   using simplex_furthest_le[of S] by (cases "S = {}") auto
 
 lemma simplex_extremal_le:
   fixes S :: "'a::real_inner set"
   assumes "finite S"
     and "S \<noteq> {}"
   shows "\<exists>u\<in>S. \<exists>v\<in>S. \<forall>x\<in>convex hull S. \<forall>y \<in> convex hull S. norm (x - y) \<le> norm (u - v)"
 proof -
   have "convex hull S \<noteq> {}"
     using hull_subset[of S convex] and assms(2) by auto
   then obtain u v where obt: "u \<in> convex hull S" "v \<in> convex hull S"
     "\<forall>x\<in>convex hull S. \<forall>y\<in>convex hull S. norm (x - y) \<le> norm (u - v)"
     using compact_sup_maxdistance[OF finite_imp_compact_convex_hull[OF assms(1)]]
     by (auto simp: dist_norm)
   then show ?thesis
   proof (cases "u\<notin>S \<or> v\<notin>S", elim disjE)
     assume "u \<notin> S"
     then obtain y where "y \<in> convex hull S" "norm (u - v) < norm (y - v)"
       using simplex_furthest_lt[OF assms(1), THEN bspec[where x=u]] and obt(1)
       by auto
     then show ?thesis
       using obt(3)[THEN bspec[where x=y], THEN bspec[where x=v]] and obt(2)
       by auto
   next
     assume "v \<notin> S"
     then obtain y where "y \<in> convex hull S" "norm (v - u) < norm (y - u)"
       using simplex_furthest_lt[OF assms(1), THEN bspec[where x=v]] and obt(2)
       by auto
     then show ?thesis
       using obt(3)[THEN bspec[where x=u], THEN bspec[where x=y]] and obt(1)
       by (auto simp: norm_minus_commute)
   qed auto
 qed
 
 lemma simplex_extremal_le_exists:
   fixes S :: "'a::real_inner set"
   shows "finite S \<Longrightarrow> x \<in> convex hull S \<Longrightarrow> y \<in> convex hull S \<Longrightarrow>
     \<exists>u\<in>S. \<exists>v\<in>S. norm (x - y) \<le> norm (u - v)"
   using convex_hull_empty simplex_extremal_le[of S]
   by(cases "S = {}") auto
 
 
 subsection \<open>Closest point of a convex set is unique, with a continuous projection\<close>
 
 definition\<^marker>\<open>tag important\<close> closest_point :: "'a::{real_inner,heine_borel} set \<Rightarrow> 'a \<Rightarrow> 'a"
   where "closest_point S a = (SOME x. x \<in> S \<and> (\<forall>y\<in>S. dist a x \<le> dist a y))"
 
 lemma closest_point_exists:
   assumes "closed S"
     and "S \<noteq> {}"
   shows "closest_point S a \<in> S"
     and "\<forall>y\<in>S. dist a (closest_point S a) \<le> dist a y"
   unfolding closest_point_def
   apply(rule_tac[!] someI2_ex)
   apply (auto intro: distance_attains_inf[OF assms(1,2), of a])
   done
 
 lemma closest_point_in_set: "closed S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> closest_point S a \<in> S"
   by (meson closest_point_exists)
 
 lemma closest_point_le: "closed S \<Longrightarrow> x \<in> S \<Longrightarrow> dist a (closest_point S a) \<le> dist a x"
   using closest_point_exists[of S] by auto
 
 lemma closest_point_self:
   assumes "x \<in> S"
   shows "closest_point S x = x"
   unfolding closest_point_def
   apply (rule some1_equality, rule ex1I[of _ x])
   using assms
   apply auto
   done
 
 lemma closest_point_refl: "closed S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> closest_point S x = x \<longleftrightarrow> x \<in> S"
   using closest_point_in_set[of S x] closest_point_self[of x S]
   by auto
 
 lemma closer_points_lemma:
   assumes "inner y z > 0"
   shows "\<exists>u>0. \<forall>v>0. v \<le> u \<longrightarrow> norm(v *\<^sub>R z - y) < norm y"
 proof -
   have z: "inner z z > 0"
     unfolding inner_gt_zero_iff using assms by auto
   have "norm (v *\<^sub>R z - y) < norm y"
     if "0 < v" and "v \<le> inner y z / inner z z" for v
     unfolding norm_lt using z assms that
     by (simp add: field_simps inner_diff inner_commute mult_strict_left_mono[OF _ \<open>0<v\<close>])
   then show ?thesis
     using assms z
     by (rule_tac x = "inner y z / inner z z" in exI) auto
 qed
 
 lemma closer_point_lemma:
   assumes "inner (y - x) (z - x) > 0"
   shows "\<exists>u>0. u \<le> 1 \<and> dist (x + u *\<^sub>R (z - x)) y < dist x y"
 proof -
   obtain u where "u > 0"
     and u: "\<forall>v>0. v \<le> u \<longrightarrow> norm (v *\<^sub>R (z - x) - (y - x)) < norm (y - x)"
     using closer_points_lemma[OF assms] by auto
   show ?thesis
     apply (rule_tac x="min u 1" in exI)
     using u[THEN spec[where x="min u 1"]] and \<open>u > 0\<close>
     unfolding dist_norm by (auto simp: norm_minus_commute field_simps)
 qed
 
 lemma any_closest_point_dot:
   assumes "convex S" "closed S" "x \<in> S" "y \<in> S" "\<forall>z\<in>S. dist a x \<le> dist a z"
   shows "inner (a - x) (y - x) \<le> 0"
 proof (rule ccontr)
   assume "\<not> ?thesis"
   then obtain u where u: "u>0" "u\<le>1" "dist (x + u *\<^sub>R (y - x)) a < dist x a"
     using closer_point_lemma[of a x y] by auto
   let ?z = "(1 - u) *\<^sub>R x + u *\<^sub>R y"
   have "?z \<in> S"
     using convexD_alt[OF assms(1,3,4), of u] using u by auto
   then show False
     using assms(5)[THEN bspec[where x="?z"]] and u(3)
     by (auto simp: dist_commute algebra_simps)
 qed
 
 lemma any_closest_point_unique:
   fixes x :: "'a::real_inner"
   assumes "convex S" "closed S" "x \<in> S" "y \<in> S"
     "\<forall>z\<in>S. dist a x \<le> dist a z" "\<forall>z\<in>S. dist a y \<le> dist a z"
   shows "x = y"
   using any_closest_point_dot[OF assms(1-4,5)] and any_closest_point_dot[OF assms(1-2,4,3,6)]
   unfolding norm_pths(1) and norm_le_square
   by (auto simp: algebra_simps)
 
 lemma closest_point_unique:
   assumes "convex S" "closed S" "x \<in> S" "\<forall>z\<in>S. dist a x \<le> dist a z"
   shows "x = closest_point S a"
   using any_closest_point_unique[OF assms(1-3) _ assms(4), of "closest_point S a"]
   using closest_point_exists[OF assms(2)] and assms(3) by auto
 
 lemma closest_point_dot:
   assumes "convex S" "closed S" "x \<in> S"
   shows "inner (a - closest_point S a) (x - closest_point S a) \<le> 0"
   apply (rule any_closest_point_dot[OF assms(1,2) _ assms(3)])
   using closest_point_exists[OF assms(2)] and assms(3)
   apply auto
   done
 
 lemma closest_point_lt:
   assumes "convex S" "closed S" "x \<in> S" "x \<noteq> closest_point S a"
   shows "dist a (closest_point S a) < dist a x"
   apply (rule ccontr)
   apply (rule_tac notE[OF assms(4)])
   apply (rule closest_point_unique[OF assms(1-3), of a])
   using closest_point_le[OF assms(2), of _ a]
   apply fastforce
   done
 
 lemma setdist_closest_point:
     "\<lbrakk>closed S; S \<noteq> {}\<rbrakk> \<Longrightarrow> setdist {a} S = dist a (closest_point S a)"
   apply (rule setdist_unique)
   using closest_point_le
   apply (auto simp: closest_point_in_set)
   done
 
 lemma closest_point_lipschitz:
   assumes "convex S"
     and "closed S" "S \<noteq> {}"
   shows "dist (closest_point S x) (closest_point S y) \<le> dist x y"
 proof -
   have "inner (x - closest_point S x) (closest_point S y - closest_point S x) \<le> 0"
     and "inner (y - closest_point S y) (closest_point S x - closest_point S y) \<le> 0"
     apply (rule_tac[!] any_closest_point_dot[OF assms(1-2)])
     using closest_point_exists[OF assms(2-3)]
     apply auto
     done
   then show ?thesis unfolding dist_norm and norm_le
     using inner_ge_zero[of "(x - closest_point S x) - (y - closest_point S y)"]
     by (simp add: inner_add inner_diff inner_commute)
 qed
 
 lemma continuous_at_closest_point:
   assumes "convex S"
     and "closed S"
     and "S \<noteq> {}"
   shows "continuous (at x) (closest_point S)"
   unfolding continuous_at_eps_delta
   using le_less_trans[OF closest_point_lipschitz[OF assms]] by auto
 
 lemma continuous_on_closest_point:
   assumes "convex S"
     and "closed S"
     and "S \<noteq> {}"
   shows "continuous_on t (closest_point S)"
   by (metis continuous_at_imp_continuous_on continuous_at_closest_point[OF assms])
 
 proposition closest_point_in_rel_interior:
   assumes "closed S" "S \<noteq> {}" and x: "x \<in> affine hull S"
     shows "closest_point S x \<in> rel_interior S \<longleftrightarrow> x \<in> rel_interior S"
 proof (cases "x \<in> S")
   case True
   then show ?thesis
     by (simp add: closest_point_self)
 next
   case False
   then have "False" if asm: "closest_point S x \<in> rel_interior S"
   proof -
     obtain e where "e > 0" and clox: "closest_point S x \<in> S"
                and e: "cball (closest_point S x) e \<inter> affine hull S \<subseteq> S"
       using asm mem_rel_interior_cball by blast
     then have clo_notx: "closest_point S x \<noteq> x"
       using \<open>x \<notin> S\<close> by auto
     define y where "y \<equiv> closest_point S x -
                         (min 1 (e / norm(closest_point S x - x))) *\<^sub>R (closest_point S x - x)"
     have "x - y = (1 - min 1 (e / norm (closest_point S x - x))) *\<^sub>R (x - closest_point S x)"
       by (simp add: y_def algebra_simps)
     then have "norm (x - y) = abs ((1 - min 1 (e / norm (closest_point S x - x)))) * norm(x - closest_point S x)"
       by simp
     also have "\<dots> < norm(x - closest_point S x)"
       using clo_notx \<open>e > 0\<close>
       by (auto simp: mult_less_cancel_right2 field_split_simps)
     finally have no_less: "norm (x - y) < norm (x - closest_point S x)" .
     have "y \<in> affine hull S"
       unfolding y_def
       by (meson affine_affine_hull clox hull_subset mem_affine_3_minus2 subsetD x)
     moreover have "dist (closest_point S x) y \<le> e"
       using \<open>e > 0\<close> by (auto simp: y_def min_mult_distrib_right)
     ultimately have "y \<in> S"
       using subsetD [OF e] by simp
     then have "dist x (closest_point S x) \<le> dist x y"
       by (simp add: closest_point_le \<open>closed S\<close>)
     with no_less show False
       by (simp add: dist_norm)
   qed
   moreover have "x \<notin> rel_interior S"
     using rel_interior_subset False by blast
   ultimately show ?thesis by blast
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Various point-to-set separating/supporting hyperplane theorems\<close>
 
 lemma supporting_hyperplane_closed_point:
   fixes z :: "'a::{real_inner,heine_borel}"
   assumes "convex S"
     and "closed S"
     and "S \<noteq> {}"
     and "z \<notin> S"
   shows "\<exists>a b. \<exists>y\<in>S. inner a z < b \<and> inner a y = b \<and> (\<forall>x\<in>S. inner a x \<ge> b)"
 proof -
   obtain y where "y \<in> S" and y: "\<forall>x\<in>S. dist z y \<le> dist z x"
     by (metis distance_attains_inf[OF assms(2-3)])
   show ?thesis
   proof (intro exI bexI conjI ballI)
     show "(y - z) \<bullet> z < (y - z) \<bullet> y"
       by (metis \<open>y \<in> S\<close> assms(4) diff_gt_0_iff_gt inner_commute inner_diff_left inner_gt_zero_iff right_minus_eq)
     show "(y - z) \<bullet> y \<le> (y - z) \<bullet> x" if "x \<in> S" for x
     proof (rule ccontr)
       have *: "\<And>u. 0 \<le> u \<and> u \<le> 1 \<longrightarrow> dist z y \<le> dist z ((1 - u) *\<^sub>R y + u *\<^sub>R x)"
         using assms(1)[unfolded convex_alt] and y and \<open>x\<in>S\<close> and \<open>y\<in>S\<close> by auto
       assume "\<not> (y - z) \<bullet> y \<le> (y - z) \<bullet> x"
       then obtain v where "v > 0" "v \<le> 1" "dist (y + v *\<^sub>R (x - y)) z < dist y z"
         using closer_point_lemma[of z y x] by (auto simp: inner_diff)
       then show False
         using *[of v] by (auto simp: dist_commute algebra_simps)
     qed
   qed (use \<open>y \<in> S\<close> in auto)
 qed
 
 lemma separating_hyperplane_closed_point:
   fixes z :: "'a::{real_inner,heine_borel}"
   assumes "convex S"
     and "closed S"
     and "z \<notin> S"
   shows "\<exists>a b. inner a z < b \<and> (\<forall>x\<in>S. inner a x > b)"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by (simp add: gt_ex)
 next
   case False
   obtain y where "y \<in> S" and y: "\<And>x. x \<in> S \<Longrightarrow> dist z y \<le> dist z x"
     by (metis distance_attains_inf[OF assms(2) False])
   show ?thesis
   proof (intro exI conjI ballI)
     show "(y - z) \<bullet> z < inner (y - z) z + (norm (y - z))\<^sup>2 / 2"
       using \<open>y\<in>S\<close> \<open>z\<notin>S\<close> by auto
   next
     fix x
     assume "x \<in> S"
     have "False" if *: "0 < inner (z - y) (x - y)"
     proof -
       obtain u where "u > 0" "u \<le> 1" "dist (y + u *\<^sub>R (x - y)) z < dist y z"
         using * closer_point_lemma by blast
       then show False using y[of "y + u *\<^sub>R (x - y)"] convexD_alt [OF \<open>convex S\<close>]
         using \<open>x\<in>S\<close> \<open>y\<in>S\<close> by (auto simp: dist_commute algebra_simps)
     qed
     moreover have "0 < (norm (y - z))\<^sup>2"
       using \<open>y\<in>S\<close> \<open>z\<notin>S\<close> by auto
     then have "0 < inner (y - z) (y - z)"
       unfolding power2_norm_eq_inner by simp
     ultimately show "(y - z) \<bullet> z + (norm (y - z))\<^sup>2 / 2 < (y - z) \<bullet> x"
       by (force simp: field_simps power2_norm_eq_inner inner_commute inner_diff)
   qed 
 qed
 
 lemma separating_hyperplane_closed_0:
   assumes "convex (S::('a::euclidean_space) set)"
     and "closed S"
     and "0 \<notin> S"
   shows "\<exists>a b. a \<noteq> 0 \<and> 0 < b \<and> (\<forall>x\<in>S. inner a x > b)"
 proof (cases "S = {}")
   case True
   have "(SOME i. i\<in>Basis) \<noteq> (0::'a)"
     by (metis Basis_zero SOME_Basis)
   then show ?thesis
     using True zero_less_one by blast
 next
   case False
   then show ?thesis
     using False using separating_hyperplane_closed_point[OF assms]
     by (metis all_not_in_conv inner_zero_left inner_zero_right less_eq_real_def not_le)
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Now set-to-set for closed/compact sets\<close>
 
 lemma separating_hyperplane_closed_compact:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S"
     and "closed S"
     and "convex T"
     and "compact T"
     and "T \<noteq> {}"
     and "S \<inter> T = {}"
   shows "\<exists>a b. (\<forall>x\<in>S. inner a x < b) \<and> (\<forall>x\<in>T. inner a x > b)"
 proof (cases "S = {}")
   case True
   obtain b where b: "b > 0" "\<forall>x\<in>T. norm x \<le> b"
     using compact_imp_bounded[OF assms(4)] unfolding bounded_pos by auto
   obtain z :: 'a where z: "norm z = b + 1"
     using vector_choose_size[of "b + 1"] and b(1) by auto
   then have "z \<notin> T" using b(2)[THEN bspec[where x=z]] by auto
   then obtain a b where ab: "inner a z < b" "\<forall>x\<in>T. b < inner a x"
     using separating_hyperplane_closed_point[OF assms(3) compact_imp_closed[OF assms(4)], of z]
     by auto
   then show ?thesis
     using True by auto
 next
   case False
   then obtain y where "y \<in> S" by auto
   obtain a b where "0 < b" "\<forall>x \<in> (\<Union>x\<in> S. \<Union>y \<in> T. {x - y}). b < inner a x"
     using separating_hyperplane_closed_point[OF convex_differences[OF assms(1,3)], of 0]
     using closed_compact_differences[OF assms(2,4)]
     using assms(6) by auto 
   then have ab: "\<forall>x\<in>S. \<forall>y\<in>T. b + inner a y < inner a x"
     apply -
     apply rule
     apply rule
     apply (erule_tac x="x - y" in ballE)
     apply (auto simp: inner_diff)
     done
   define k where "k = (SUP x\<in>T. a \<bullet> x)"
   show ?thesis
     apply (rule_tac x="-a" in exI)
     apply (rule_tac x="-(k + b / 2)" in exI)
     apply (intro conjI ballI)
     unfolding inner_minus_left and neg_less_iff_less
   proof -
     fix x assume "x \<in> T"
     then have "inner a x - b / 2 < k"
       unfolding k_def
     proof (subst less_cSUP_iff)
       show "T \<noteq> {}" by fact
       show "bdd_above ((\<bullet>) a ` T)"
         using ab[rule_format, of y] \<open>y \<in> S\<close>
         by (intro bdd_aboveI2[where M="inner a y - b"]) (auto simp: field_simps intro: less_imp_le)
     qed (auto intro!: bexI[of _ x] \<open>0<b\<close>)
     then show "inner a x < k + b / 2"
       by auto
   next
     fix x
     assume "x \<in> S"
     then have "k \<le> inner a x - b"
       unfolding k_def
       apply (rule_tac cSUP_least)
       using assms(5)
       using ab[THEN bspec[where x=x]]
       apply auto
       done
     then show "k + b / 2 < inner a x"
       using \<open>0 < b\<close> by auto
   qed
 qed
 
 lemma separating_hyperplane_compact_closed:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S"
     and "compact S"
     and "S \<noteq> {}"
     and "convex T"
     and "closed T"
     and "S \<inter> T = {}"
   shows "\<exists>a b. (\<forall>x\<in>S. inner a x < b) \<and> (\<forall>x\<in>T. inner a x > b)"
 proof -
   obtain a b where "(\<forall>x\<in>T. inner a x < b) \<and> (\<forall>x\<in>S. b < inner a x)"
     using separating_hyperplane_closed_compact[OF assms(4-5,1-2,3)] and assms(6)
     by auto
   then show ?thesis
     apply (rule_tac x="-a" in exI)
     apply (rule_tac x="-b" in exI, auto)
     done
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>General case without assuming closure and getting non-strict separation\<close>
 
 lemma separating_hyperplane_set_0:
   assumes "convex S" "(0::'a::euclidean_space) \<notin> S"
   shows "\<exists>a. a \<noteq> 0 \<and> (\<forall>x\<in>S. 0 \<le> inner a x)"
 proof -
   let ?k = "\<lambda>c. {x::'a. 0 \<le> inner c x}"
   have *: "frontier (cball 0 1) \<inter> \<Inter>f \<noteq> {}" if as: "f \<subseteq> ?k ` S" "finite f" for f
   proof -
     obtain c where c: "f = ?k ` c" "c \<subseteq> S" "finite c"
       using finite_subset_image[OF as(2,1)] by auto
     then obtain a b where ab: "a \<noteq> 0" "0 < b" "\<forall>x\<in>convex hull c. b < inner a x"
       using separating_hyperplane_closed_0[OF convex_convex_hull, of c]
       using finite_imp_compact_convex_hull[OF c(3), THEN compact_imp_closed] and assms(2)
       using subset_hull[of convex, OF assms(1), symmetric, of c]
       by force
     then have "\<exists>x. norm x = 1 \<and> (\<forall>y\<in>c. 0 \<le> inner y x)"
       apply (rule_tac x = "inverse(norm a) *\<^sub>R a" in exI)
       using hull_subset[of c convex]
       unfolding subset_eq and inner_scaleR
       by (auto simp: inner_commute del: ballE elim!: ballE)
     then show "frontier (cball 0 1) \<inter> \<Inter>f \<noteq> {}"
       unfolding c(1) frontier_cball sphere_def dist_norm by auto
   qed
   have "frontier (cball 0 1) \<inter> (\<Inter>(?k ` S)) \<noteq> {}"
     apply (rule compact_imp_fip)
     apply (rule compact_frontier[OF compact_cball])
     using * closed_halfspace_ge
     by auto
   then obtain x where "norm x = 1" "\<forall>y\<in>S. x\<in>?k y"
     unfolding frontier_cball dist_norm sphere_def by auto
   then show ?thesis
     by (metis inner_commute mem_Collect_eq norm_eq_zero zero_neq_one)
 qed
 
 lemma separating_hyperplane_sets:
   fixes S T :: "'a::euclidean_space set"
   assumes "convex S"
     and "convex T"
     and "S \<noteq> {}"
     and "T \<noteq> {}"
     and "S \<inter> T = {}"
   shows "\<exists>a b. a \<noteq> 0 \<and> (\<forall>x\<in>S. inner a x \<le> b) \<and> (\<forall>x\<in>T. inner a x \<ge> b)"
 proof -
   from separating_hyperplane_set_0[OF convex_differences[OF assms(2,1)]]
   obtain a where "a \<noteq> 0" "\<forall>x\<in>{x - y |x y. x \<in> T \<and> y \<in> S}. 0 \<le> inner a x"
     using assms(3-5) by force
   then have *: "\<And>x y. x \<in> T \<Longrightarrow> y \<in> S \<Longrightarrow> inner a y \<le> inner a x"
     by (force simp: inner_diff)
   then have bdd: "bdd_above (((\<bullet>) a)`S)"
     using \<open>T \<noteq> {}\<close> by (auto intro: bdd_aboveI2[OF *])
   show ?thesis
     using \<open>a\<noteq>0\<close>
     by (intro exI[of _ a] exI[of _ "SUP x\<in>S. a \<bullet> x"])
        (auto intro!: cSUP_upper bdd cSUP_least \<open>a \<noteq> 0\<close> \<open>S \<noteq> {}\<close> *)
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>More convexity generalities\<close>
 
 lemma convex_closure [intro,simp]:
   fixes S :: "'a::real_normed_vector set"
   assumes "convex S"
   shows "convex (closure S)"
   apply (rule convexI)
   apply (unfold closure_sequential, elim exE)
   apply (rule_tac x="\<lambda>n. u *\<^sub>R xa n + v *\<^sub>R xb n" in exI)
   apply (rule,rule)
   apply (rule convexD [OF assms])
   apply (auto del: tendsto_const intro!: tendsto_intros)
   done
 
 lemma convex_interior [intro,simp]:
   fixes S :: "'a::real_normed_vector set"
   assumes "convex S"
   shows "convex (interior S)"
   unfolding convex_alt Ball_def mem_interior
 proof clarify
   fix x y u
   assume u: "0 \<le> u" "u \<le> (1::real)"
   fix e d
   assume ed: "ball x e \<subseteq> S" "ball y d \<subseteq> S" "0<d" "0<e"
   show "\<exists>e>0. ball ((1 - u) *\<^sub>R x + u *\<^sub>R y) e \<subseteq> S"
   proof (intro exI conjI subsetI)
     fix z
     assume "z \<in> ball ((1 - u) *\<^sub>R x + u *\<^sub>R y) (min d e)"
     then have "(1- u) *\<^sub>R (z - u *\<^sub>R (y - x)) + u *\<^sub>R (z + (1 - u) *\<^sub>R (y - x)) \<in> S"
       apply (rule_tac assms[unfolded convex_alt, rule_format])
       using ed(1,2) and u
       unfolding subset_eq mem_ball Ball_def dist_norm
       apply (auto simp: algebra_simps)
       done
     then show "z \<in> S"
       using u by (auto simp: algebra_simps)
   qed(insert u ed(3-4), auto)
 qed
 
 lemma convex_hull_eq_empty[simp]: "convex hull S = {} \<longleftrightarrow> S = {}"
   using hull_subset[of S convex] convex_hull_empty by auto
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Convex set as intersection of halfspaces\<close>
 
 lemma convex_halfspace_intersection:
   fixes s :: "('a::euclidean_space) set"
   assumes "closed s" "convex s"
   shows "s = \<Inter>{h. s \<subseteq> h \<and> (\<exists>a b. h = {x. inner a x \<le> b})}"
   apply (rule set_eqI, rule)
   unfolding Inter_iff Ball_def mem_Collect_eq
   apply (rule,rule,erule conjE)
 proof -
   fix x
   assume "\<forall>xa. s \<subseteq> xa \<and> (\<exists>a b. xa = {x. inner a x \<le> b}) \<longrightarrow> x \<in> xa"
   then have "\<forall>a b. s \<subseteq> {x. inner a x \<le> b} \<longrightarrow> x \<in> {x. inner a x \<le> b}"
     by blast
   then show "x \<in> s"
     apply (rule_tac ccontr)
     apply (drule separating_hyperplane_closed_point[OF assms(2,1)])
     apply (erule exE)+
     apply (erule_tac x="-a" in allE)
     apply (erule_tac x="-b" in allE, auto)
     done
 qed auto
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Convexity of general and special intervals\<close>
 
 lemma is_interval_convex:
   fixes S :: "'a::euclidean_space set"
   assumes "is_interval S"
   shows "convex S"
 proof (rule convexI)
   fix x y and u v :: real
   assume as: "x \<in> S" "y \<in> S" "0 \<le> u" "0 \<le> v" "u + v = 1"
   then have *: "u = 1 - v" "1 - v \<ge> 0" and **: "v = 1 - u" "1 - u \<ge> 0"
     by auto
   {
     fix a b
     assume "\<not> b \<le> u * a + v * b"
     then have "u * a < (1 - v) * b"
       unfolding not_le using as(4) by (auto simp: field_simps)
     then have "a < b"
       unfolding * using as(4) *(2)
       apply (rule_tac mult_left_less_imp_less[of "1 - v"])
       apply (auto simp: field_simps)
       done
     then have "a \<le> u * a + v * b"
       unfolding * using as(4)
       by (auto simp: field_simps intro!:mult_right_mono)
   }
   moreover
   {
     fix a b
     assume "\<not> u * a + v * b \<le> a"
     then have "v * b > (1 - u) * a"
       unfolding not_le using as(4) by (auto simp: field_simps)
     then have "a < b"
       unfolding * using as(4)
       apply (rule_tac mult_left_less_imp_less)
       apply (auto simp: field_simps)
       done
     then have "u * a + v * b \<le> b"
       unfolding **
       using **(2) as(3)
       by (auto simp: field_simps intro!:mult_right_mono)
   }
   ultimately show "u *\<^sub>R x + v *\<^sub>R y \<in> S"
     apply -
     apply (rule assms[unfolded is_interval_def, rule_format, OF as(1,2)])
     using as(3-) DIM_positive[where 'a='a]
     apply (auto simp: inner_simps)
     done
 qed
 
 lemma is_interval_connected:
   fixes S :: "'a::euclidean_space set"
   shows "is_interval S \<Longrightarrow> connected S"
   using is_interval_convex convex_connected by auto
 
 lemma convex_box [simp]: "convex (cbox a b)" "convex (box a (b::'a::euclidean_space))"
   apply (rule_tac[!] is_interval_convex)+
   using is_interval_box is_interval_cbox
   apply auto
   done
 
 text\<open>A non-singleton connected set is perfect (i.e. has no isolated points). \<close>
 lemma connected_imp_perfect:
   fixes a :: "'a::metric_space"
   assumes "connected S" "a \<in> S" and S: "\<And>x. S \<noteq> {x}"
   shows "a islimpt S"
 proof -
   have False if "a \<in> T" "open T" "\<And>y. \<lbrakk>y \<in> S; y \<in> T\<rbrakk> \<Longrightarrow> y = a" for T
   proof -
     obtain e where "e > 0" and e: "cball a e \<subseteq> T"
       using \<open>open T\<close> \<open>a \<in> T\<close> by (auto simp: open_contains_cball)
     have "openin (top_of_set S) {a}"
       unfolding openin_open using that \<open>a \<in> S\<close> by blast
     moreover have "closedin (top_of_set S) {a}"
       by (simp add: assms)
     ultimately show "False"
       using \<open>connected S\<close> connected_clopen S by blast
   qed
   then show ?thesis
     unfolding islimpt_def by blast
 qed
 
 lemma connected_imp_perfect_aff_dim:
      "\<lbrakk>connected S; aff_dim S \<noteq> 0; a \<in> S\<rbrakk> \<Longrightarrow> a islimpt S"
   using aff_dim_sing connected_imp_perfect by blast
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>On \<open>real\<close>, \<open>is_interval\<close>, \<open>convex\<close> and \<open>connected\<close> are all equivalent\<close>
 
 lemma mem_is_interval_1_I:
   fixes a b c::real
   assumes "is_interval S"
   assumes "a \<in> S" "c \<in> S"
   assumes "a \<le> b" "b \<le> c"
   shows "b \<in> S"
   using assms is_interval_1 by blast
 
 lemma is_interval_connected_1:
   fixes s :: "real set"
   shows "is_interval s \<longleftrightarrow> connected s"
   apply rule
   apply (rule is_interval_connected, assumption)
   unfolding is_interval_1
   apply rule
   apply rule
   apply rule
   apply rule
   apply (erule conjE)
   apply (rule ccontr)       
 proof -
   fix a b x
   assume as: "connected s" "a \<in> s" "b \<in> s" "a \<le> x" "x \<le> b" "x \<notin> s"
   then have *: "a < x" "x < b"
     unfolding not_le [symmetric] by auto
   let ?halfl = "{..<x} "
   let ?halfr = "{x<..}"
   {
     fix y
     assume "y \<in> s"
     with \<open>x \<notin> s\<close> have "x \<noteq> y" by auto
     then have "y \<in> ?halfr \<union> ?halfl" by auto
   }
   moreover have "a \<in> ?halfl" "b \<in> ?halfr" using * by auto
   then have "?halfl \<inter> s \<noteq> {}" "?halfr \<inter> s \<noteq> {}"
     using as(2-3) by auto
   ultimately show False
     apply (rule_tac notE[OF as(1)[unfolded connected_def]])
     apply (rule_tac x = ?halfl in exI)
     apply (rule_tac x = ?halfr in exI, rule)
     apply (rule open_lessThan, rule)
     apply (rule open_greaterThan, auto)
     done
 qed
 
 lemma is_interval_convex_1:
   fixes s :: "real set"
   shows "is_interval s \<longleftrightarrow> convex s"
   by (metis is_interval_convex convex_connected is_interval_connected_1)
 
 lemma is_interval_ball_real: "is_interval (ball a b)" for a b::real
   by (metis connected_ball is_interval_connected_1)
 
 lemma connected_compact_interval_1:
      "connected S \<and> compact S \<longleftrightarrow> (\<exists>a b. S = {a..b::real})"
   by (auto simp: is_interval_connected_1 [symmetric] is_interval_compact)
 
 lemma connected_convex_1:
   fixes s :: "real set"
   shows "connected s \<longleftrightarrow> convex s"
   by (metis is_interval_convex convex_connected is_interval_connected_1)
 
 lemma connected_convex_1_gen:
   fixes s :: "'a :: euclidean_space set"
   assumes "DIM('a) = 1"
   shows "connected s \<longleftrightarrow> convex s"
 proof -
   obtain f:: "'a \<Rightarrow> real" where linf: "linear f" and "inj f"
     using subspace_isomorphism[OF subspace_UNIV subspace_UNIV,
         where 'a='a and 'b=real]
     unfolding Euclidean_Space.dim_UNIV
     by (auto simp: assms)
   then have "f -` (f ` s) = s"
     by (simp add: inj_vimage_image_eq)
   then show ?thesis
     by (metis connected_convex_1 convex_linear_vimage linf convex_connected connected_linear_image)
 qed
 
 lemma is_interval_cball_1[intro, simp]: "is_interval (cball a b)" for a b::real
   by (simp add: is_interval_convex_1)
 
 lemma [simp]:
   fixes r s::real
   shows is_interval_io: "is_interval {..<r}"
     and is_interval_oi: "is_interval {r<..}"
     and is_interval_oo: "is_interval {r<..<s}"
     and is_interval_oc: "is_interval {r<..s}"
     and is_interval_co: "is_interval {r..<s}"
   by (simp_all add: is_interval_convex_1)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Another intermediate value theorem formulation\<close>
 
 lemma ivt_increasing_component_on_1:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "a \<le> b"
     and "continuous_on {a..b} f"
     and "(f a)\<bullet>k \<le> y" "y \<le> (f b)\<bullet>k"
   shows "\<exists>x\<in>{a..b}. (f x)\<bullet>k = y"
 proof -
   have "f a \<in> f ` cbox a b" "f b \<in> f ` cbox a b"
     apply (rule_tac[!] imageI)
     using assms(1)
     apply auto
     done
   then show ?thesis
     using connected_ivt_component[of "f ` cbox a b" "f a" "f b" k y]
     by (simp add: connected_continuous_image assms)
 qed
 
 lemma ivt_increasing_component_1:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
   shows "a \<le> b \<Longrightarrow> \<forall>x\<in>{a..b}. continuous (at x) f \<Longrightarrow>
     f a\<bullet>k \<le> y \<Longrightarrow> y \<le> f b\<bullet>k \<Longrightarrow> \<exists>x\<in>{a..b}. (f x)\<bullet>k = y"
   by (rule ivt_increasing_component_on_1) (auto simp: continuous_at_imp_continuous_on)
 
 lemma ivt_decreasing_component_on_1:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
   assumes "a \<le> b"
     and "continuous_on {a..b} f"
     and "(f b)\<bullet>k \<le> y"
     and "y \<le> (f a)\<bullet>k"
   shows "\<exists>x\<in>{a..b}. (f x)\<bullet>k = y"
   apply (subst neg_equal_iff_equal[symmetric])
   using ivt_increasing_component_on_1[of a b "\<lambda>x. - f x" k "- y"]
   using assms using continuous_on_minus
   apply auto
   done
 
 lemma ivt_decreasing_component_1:
   fixes f :: "real \<Rightarrow> 'a::euclidean_space"
   shows "a \<le> b \<Longrightarrow> \<forall>x\<in>{a..b}. continuous (at x) f \<Longrightarrow>
     f b\<bullet>k \<le> y \<Longrightarrow> y \<le> f a\<bullet>k \<Longrightarrow> \<exists>x\<in>{a..b}. (f x)\<bullet>k = y"
   by (rule ivt_decreasing_component_on_1) (auto simp: continuous_at_imp_continuous_on)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>A bound within an interval\<close>
 
 lemma convex_hull_eq_real_cbox:
   fixes x y :: real assumes "x \<le> y"
   shows "convex hull {x, y} = cbox x y"
 proof (rule hull_unique)
   show "{x, y} \<subseteq> cbox x y" using \<open>x \<le> y\<close> by auto
   show "convex (cbox x y)"
     by (rule convex_box)
 next
   fix S assume "{x, y} \<subseteq> S" and "convex S"
   then show "cbox x y \<subseteq> S"
     unfolding is_interval_convex_1 [symmetric] is_interval_def Basis_real_def
     by - (clarify, simp (no_asm_use), fast)
 qed
 
 lemma unit_interval_convex_hull:
   "cbox (0::'a::euclidean_space) One = convex hull {x. \<forall>i\<in>Basis. (x\<bullet>i = 0) \<or> (x\<bullet>i = 1)}"
   (is "?int = convex hull ?points")
 proof -
   have One[simp]: "\<And>i. i \<in> Basis \<Longrightarrow> One \<bullet> i = 1"
     by (simp add: inner_sum_left sum.If_cases inner_Basis)
   have "?int = {x. \<forall>i\<in>Basis. x \<bullet> i \<in> cbox 0 1}"
     by (auto simp: cbox_def)
   also have "\<dots> = (\<Sum>i\<in>Basis. (\<lambda>x. x *\<^sub>R i) ` cbox 0 1)"
     by (simp only: box_eq_set_sum_Basis)
   also have "\<dots> = (\<Sum>i\<in>Basis. (\<lambda>x. x *\<^sub>R i) ` (convex hull {0, 1}))"
     by (simp only: convex_hull_eq_real_cbox zero_le_one)
   also have "\<dots> = (\<Sum>i\<in>Basis. convex hull ((\<lambda>x. x *\<^sub>R i) ` {0, 1}))"
     by (simp add: convex_hull_linear_image)
   also have "\<dots> = convex hull (\<Sum>i\<in>Basis. (\<lambda>x. x *\<^sub>R i) ` {0, 1})"
     by (simp only: convex_hull_set_sum)
   also have "\<dots> = convex hull {x. \<forall>i\<in>Basis. x\<bullet>i \<in> {0, 1}}"
     by (simp only: box_eq_set_sum_Basis)
   also have "convex hull {x. \<forall>i\<in>Basis. x\<bullet>i \<in> {0, 1}} = convex hull ?points"
     by simp
   finally show ?thesis .
 qed
 
 text \<open>And this is a finite set of vertices.\<close>
 
 lemma unit_cube_convex_hull:
   obtains S :: "'a::euclidean_space set"
   where "finite S" and "cbox 0 (\<Sum>Basis) = convex hull S"
 proof
   show "finite {x::'a. \<forall>i\<in>Basis. x \<bullet> i = 0 \<or> x \<bullet> i = 1}"
   proof (rule finite_subset, clarify)
     show "finite ((\<lambda>S. \<Sum>i\<in>Basis. (if i \<in> S then 1 else 0) *\<^sub>R i) ` Pow Basis)"
       using finite_Basis by blast
     fix x :: 'a
     assume as: "\<forall>i\<in>Basis. x \<bullet> i = 0 \<or> x \<bullet> i = 1"
     show "x \<in> (\<lambda>S. \<Sum>i\<in>Basis. (if i\<in>S then 1 else 0) *\<^sub>R i) ` Pow Basis"
       apply (rule image_eqI[where x="{i. i\<in>Basis \<and> x\<bullet>i = 1}"])
       using as
        apply (subst euclidean_eq_iff, auto)
       done
   qed
   show "cbox 0 One = convex hull {x. \<forall>i\<in>Basis. x \<bullet> i = 0 \<or> x \<bullet> i = 1}"
     using unit_interval_convex_hull by blast
 qed 
 
 text \<open>Hence any cube (could do any nonempty interval).\<close>
 
 lemma cube_convex_hull:
   assumes "d > 0"
   obtains S :: "'a::euclidean_space set" where
     "finite S" and "cbox (x - (\<Sum>i\<in>Basis. d*\<^sub>Ri)) (x + (\<Sum>i\<in>Basis. d*\<^sub>Ri)) = convex hull S"
 proof -
   let ?d = "(\<Sum>i\<in>Basis. d *\<^sub>R i)::'a"
   have *: "cbox (x - ?d) (x + ?d) = (\<lambda>y. x - ?d + (2 * d) *\<^sub>R y) ` cbox 0 (\<Sum>Basis)"
   proof (intro set_eqI iffI)
     fix y
     assume "y \<in> cbox (x - ?d) (x + ?d)"
     then have "inverse (2 * d) *\<^sub>R (y - (x - ?d)) \<in> cbox 0 (\<Sum>Basis)"
       using assms by (simp add: mem_box inner_simps) (simp add: field_simps)
     with \<open>0 < d\<close> show "y \<in> (\<lambda>y. x - sum ((*\<^sub>R) d) Basis + (2 * d) *\<^sub>R y) ` cbox 0 One"
       by (auto intro: image_eqI[where x= "inverse (2 * d) *\<^sub>R (y - (x - ?d))"])
   next
     fix y
     assume "y \<in> (\<lambda>y. x - ?d + (2 * d) *\<^sub>R y) ` cbox 0 One"
     then obtain z where z: "z \<in> cbox 0 One" "y = x - ?d + (2*d) *\<^sub>R z"
       by auto
     then show "y \<in> cbox (x - ?d) (x + ?d)"
       using z assms by (auto simp: mem_box inner_simps)
   qed
   obtain S where "finite S" "cbox 0 (\<Sum>Basis::'a) = convex hull S"
     using unit_cube_convex_hull by auto
   then show ?thesis
     by (rule_tac that[of "(\<lambda>y. x - ?d + (2 * d) *\<^sub>R y)` S"]) (auto simp: convex_hull_affinity *)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Representation of any interval as a finite convex hull\<close>
 
 lemma image_stretch_interval:
   "(\<lambda>x. \<Sum>k\<in>Basis. (m k * (x\<bullet>k)) *\<^sub>R k) ` cbox a (b::'a::euclidean_space) =
   (if (cbox a b) = {} then {} else
     cbox (\<Sum>k\<in>Basis. (min (m k * (a\<bullet>k)) (m k * (b\<bullet>k))) *\<^sub>R k::'a)
      (\<Sum>k\<in>Basis. (max (m k * (a\<bullet>k)) (m k * (b\<bullet>k))) *\<^sub>R k))"
 proof cases
   assume *: "cbox a b \<noteq> {}"
   show ?thesis
     unfolding box_ne_empty if_not_P[OF *]
     apply (simp add: cbox_def image_Collect set_eq_iff euclidean_eq_iff[where 'a='a] ball_conj_distrib[symmetric])
     apply (subst choice_Basis_iff[symmetric])
   proof (intro allI ball_cong refl)
     fix x i :: 'a assume "i \<in> Basis"
     with * have a_le_b: "a \<bullet> i \<le> b \<bullet> i"
       unfolding box_ne_empty by auto
     show "(\<exists>xa. x \<bullet> i = m i * xa \<and> a \<bullet> i \<le> xa \<and> xa \<le> b \<bullet> i) \<longleftrightarrow>
         min (m i * (a \<bullet> i)) (m i * (b \<bullet> i)) \<le> x \<bullet> i \<and> x \<bullet> i \<le> max (m i * (a \<bullet> i)) (m i * (b \<bullet> i))"
     proof (cases "m i = 0")
       case True
       with a_le_b show ?thesis by auto
     next
       case False
       then have *: "\<And>a b. a = m i * b \<longleftrightarrow> b = a / m i"
         by (auto simp: field_simps)
       from False have
           "min (m i * (a \<bullet> i)) (m i * (b \<bullet> i)) = (if 0 < m i then m i * (a \<bullet> i) else m i * (b \<bullet> i))"
           "max (m i * (a \<bullet> i)) (m i * (b \<bullet> i)) = (if 0 < m i then m i * (b \<bullet> i) else m i * (a \<bullet> i))"
         using a_le_b by (auto simp: min_def max_def mult_le_cancel_left)
       with False show ?thesis using a_le_b
         unfolding * by (auto simp: le_divide_eq divide_le_eq ac_simps)
     qed
   qed
 qed simp
 
 lemma interval_image_stretch_interval:
   "\<exists>u v. (\<lambda>x. \<Sum>k\<in>Basis. (m k * (x\<bullet>k))*\<^sub>R k) ` cbox a (b::'a::euclidean_space) = cbox u (v::'a::euclidean_space)"
   unfolding image_stretch_interval by auto
 
 lemma cbox_translation: "cbox (c + a) (c + b) = image (\<lambda>x. c + x) (cbox a b)"
   using image_affinity_cbox [of 1 c a b]
   using box_ne_empty [of "a+c" "b+c"]  box_ne_empty [of a b]
   by (auto simp: inner_left_distrib add.commute)
 
 lemma cbox_image_unit_interval:
   fixes a :: "'a::euclidean_space"
   assumes "cbox a b \<noteq> {}"
     shows "cbox a b =
            (+) a ` (\<lambda>x. \<Sum>k\<in>Basis. ((b \<bullet> k - a \<bullet> k) * (x \<bullet> k)) *\<^sub>R k) ` cbox 0 One"
 using assms
 apply (simp add: box_ne_empty image_stretch_interval cbox_translation [symmetric])
 apply (simp add: min_def max_def algebra_simps sum_subtractf euclidean_representation)
 done
 
 lemma closed_interval_as_convex_hull:
   fixes a :: "'a::euclidean_space"
   obtains S where "finite S" "cbox a b = convex hull S"
 proof (cases "cbox a b = {}")
   case True with convex_hull_empty that show ?thesis
     by blast
 next
   case False
   obtain S::"'a set" where "finite S" and eq: "cbox 0 One = convex hull S"
     by (blast intro: unit_cube_convex_hull)
   have lin: "linear (\<lambda>x. \<Sum>k\<in>Basis. ((b \<bullet> k - a \<bullet> k) * (x \<bullet> k)) *\<^sub>R k)"
     by (rule linear_compose_sum) (auto simp: algebra_simps linearI)
   have "finite ((+) a ` (\<lambda>x. \<Sum>k\<in>Basis. ((b \<bullet> k - a \<bullet> k) * (x \<bullet> k)) *\<^sub>R k) ` S)"
     by (rule finite_imageI \<open>finite S\<close>)+
   then show ?thesis
     apply (rule that)
     apply (simp add: convex_hull_translation convex_hull_linear_image [OF lin, symmetric])
     apply (simp add: eq [symmetric] cbox_image_unit_interval [OF False])
     done
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Bounded convex function on open set is continuous\<close>
 
 lemma convex_on_bounded_continuous:
   fixes S :: "('a::real_normed_vector) set"
   assumes "open S"
     and "convex_on S f"
     and "\<forall>x\<in>S. \<bar>f x\<bar> \<le> b"
   shows "continuous_on S f"
   apply (rule continuous_at_imp_continuous_on)
   unfolding continuous_at_real_range
 proof (rule,rule,rule)
   fix x and e :: real
   assume "x \<in> S" "e > 0"
   define B where "B = \<bar>b\<bar> + 1"
   then have B:  "0 < B""\<And>x. x\<in>S \<Longrightarrow> \<bar>f x\<bar> \<le> B"
     using assms(3) by auto 
   obtain k where "k > 0" and k: "cball x k \<subseteq> S"
     using \<open>x \<in> S\<close> assms(1) open_contains_cball_eq by blast
   show "\<exists>d>0. \<forall>x'. norm (x' - x) < d \<longrightarrow> \<bar>f x' - f x\<bar> < e"
   proof (intro exI conjI allI impI)
     fix y
     assume as: "norm (y - x) < min (k / 2) (e / (2 * B) * k)"
     show "\<bar>f y - f x\<bar> < e"
     proof (cases "y = x")
       case False
       define t where "t = k / norm (y - x)"
       have "2 < t" "0<t"
         unfolding t_def using as False and \<open>k>0\<close>
         by (auto simp:field_simps)
       have "y \<in> S"
         apply (rule k[THEN subsetD])
         unfolding mem_cball dist_norm
         apply (rule order_trans[of _ "2 * norm (x - y)"])
         using as
         by (auto simp: field_simps norm_minus_commute)
       {
         define w where "w = x + t *\<^sub>R (y - x)"
         have "w \<in> S"
           using \<open>k>0\<close> by (auto simp: dist_norm t_def w_def k[THEN subsetD])
         have "(1 / t) *\<^sub>R x + - x + ((t - 1) / t) *\<^sub>R x = (1 / t - 1 + (t - 1) / t) *\<^sub>R x"
           by (auto simp: algebra_simps)
         also have "\<dots> = 0"
           using \<open>t > 0\<close> by (auto simp:field_simps)
         finally have w: "(1 / t) *\<^sub>R w + ((t - 1) / t) *\<^sub>R x = y"
           unfolding w_def using False and \<open>t > 0\<close>
           by (auto simp: algebra_simps)
         have 2: "2 * B < e * t"
           unfolding t_def using \<open>0 < e\<close> \<open>0 < k\<close> \<open>B > 0\<close> and as and False
           by (auto simp:field_simps)
         have "f y - f x \<le> (f w - f x) / t"
           using assms(2)[unfolded convex_on_def,rule_format,of w x "1/t" "(t - 1)/t", unfolded w]
           using \<open>0 < t\<close> \<open>2 < t\<close> and \<open>x \<in> S\<close> \<open>w \<in> S\<close>
           by (auto simp:field_simps)
         also have "... < e"
           using B(2)[OF \<open>w\<in>S\<close>] and B(2)[OF \<open>x\<in>S\<close>] 2 \<open>t > 0\<close> by (auto simp: field_simps)
         finally have th1: "f y - f x < e" .
       }
       moreover
       {
         define w where "w = x - t *\<^sub>R (y - x)"
         have "w \<in> S"
           using \<open>k > 0\<close> by (auto simp: dist_norm t_def w_def k[THEN subsetD])
         have "(1 / (1 + t)) *\<^sub>R x + (t / (1 + t)) *\<^sub>R x = (1 / (1 + t) + t / (1 + t)) *\<^sub>R x"
           by (auto simp: algebra_simps)
         also have "\<dots> = x"
           using \<open>t > 0\<close> by (auto simp:field_simps)
         finally have w: "(1 / (1+t)) *\<^sub>R w + (t / (1 + t)) *\<^sub>R y = x"
           unfolding w_def using False and \<open>t > 0\<close>
           by (auto simp: algebra_simps)
         have "2 * B < e * t"
           unfolding t_def
           using \<open>0 < e\<close> \<open>0 < k\<close> \<open>B > 0\<close> and as and False
           by (auto simp:field_simps)
         then have *: "(f w - f y) / t < e"
           using B(2)[OF \<open>w\<in>S\<close>] and B(2)[OF \<open>y\<in>S\<close>]
           using \<open>t > 0\<close>
           by (auto simp:field_simps)
         have "f x \<le> 1 / (1 + t) * f w + (t / (1 + t)) * f y"
           using assms(2)[unfolded convex_on_def,rule_format,of w y "1/(1+t)" "t / (1+t)",unfolded w]
           using \<open>0 < t\<close> \<open>2 < t\<close> and \<open>y \<in> S\<close> \<open>w \<in> S\<close>
           by (auto simp:field_simps)
         also have "\<dots> = (f w + t * f y) / (1 + t)"
           using \<open>t > 0\<close> by (simp add: add_divide_distrib) 
         also have "\<dots> < e + f y"
           using \<open>t > 0\<close> * \<open>e > 0\<close> by (auto simp: field_simps)
         finally have "f x - f y < e" by auto
       }
       ultimately show ?thesis by auto
     qed (insert \<open>0<e\<close>, auto)
   qed (insert \<open>0<e\<close> \<open>0<k\<close> \<open>0<B\<close>, auto simp: field_simps)
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Upper bound on a ball implies upper and lower bounds\<close>
 
 lemma convex_bounds_lemma:
   fixes x :: "'a::real_normed_vector"
   assumes "convex_on (cball x e) f"
     and "\<forall>y \<in> cball x e. f y \<le> b"
   shows "\<forall>y \<in> cball x e. \<bar>f y\<bar> \<le> b + 2 * \<bar>f x\<bar>"
   apply rule
 proof (cases "0 \<le> e")
   case True
   fix y
   assume y: "y \<in> cball x e"
   define z where "z = 2 *\<^sub>R x - y"
   have *: "x - (2 *\<^sub>R x - y) = y - x"
     by (simp add: scaleR_2)
   have z: "z \<in> cball x e"
     using y unfolding z_def mem_cball dist_norm * by (auto simp: norm_minus_commute)
   have "(1 / 2) *\<^sub>R y + (1 / 2) *\<^sub>R z = x"
     unfolding z_def by (auto simp: algebra_simps)
   then show "\<bar>f y\<bar> \<le> b + 2 * \<bar>f x\<bar>"
     using assms(1)[unfolded convex_on_def,rule_format, OF y z, of "1/2" "1/2"]
     using assms(2)[rule_format,OF y] assms(2)[rule_format,OF z]
     by (auto simp:field_simps)
 next
   case False
   fix y
   assume "y \<in> cball x e"
   then have "dist x y < 0"
     using False unfolding mem_cball not_le by (auto simp del: dist_not_less_zero)
   then show "\<bar>f y\<bar> \<le> b + 2 * \<bar>f x\<bar>"
     using zero_le_dist[of x y] by auto
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Hence a convex function on an open set is continuous\<close>
 
 lemma real_of_nat_ge_one_iff: "1 \<le> real (n::nat) \<longleftrightarrow> 1 \<le> n"
   by auto
 
 lemma convex_on_continuous:
   assumes "open (s::('a::euclidean_space) set)" "convex_on s f"
   shows "continuous_on s f"
   unfolding continuous_on_eq_continuous_at[OF assms(1)]
 proof
   note dimge1 = DIM_positive[where 'a='a]
   fix x
   assume "x \<in> s"
   then obtain e where e: "cball x e \<subseteq> s" "e > 0"
     using assms(1) unfolding open_contains_cball by auto
   define d where "d = e / real DIM('a)"
   have "0 < d"
     unfolding d_def using \<open>e > 0\<close> dimge1 by auto
   let ?d = "(\<Sum>i\<in>Basis. d *\<^sub>R i)::'a"
   obtain c
     where c: "finite c"
     and c1: "convex hull c \<subseteq> cball x e"
     and c2: "cball x d \<subseteq> convex hull c"
   proof
     define c where "c = (\<Sum>i\<in>Basis. (\<lambda>a. a *\<^sub>R i) ` {x\<bullet>i - d, x\<bullet>i + d})"
     show "finite c"
       unfolding c_def by (simp add: finite_set_sum)
     have 1: "convex hull c = {a. \<forall>i\<in>Basis. a \<bullet> i \<in> cbox (x \<bullet> i - d) (x \<bullet> i + d)}"
       unfolding box_eq_set_sum_Basis
       unfolding c_def convex_hull_set_sum
       apply (subst convex_hull_linear_image [symmetric])
       apply (simp add: linear_iff scaleR_add_left)
       apply (rule sum.cong [OF refl])
       apply (rule image_cong [OF _ refl])
       apply (rule convex_hull_eq_real_cbox)
       apply (cut_tac \<open>0 < d\<close>, simp)
       done
     then have 2: "convex hull c = {a. \<forall>i\<in>Basis. a \<bullet> i \<in> cball (x \<bullet> i) d}"
       by (simp add: dist_norm abs_le_iff algebra_simps)
     show "cball x d \<subseteq> convex hull c"
       unfolding 2
       by (clarsimp simp: dist_norm) (metis inner_commute inner_diff_right norm_bound_Basis_le)
     have e': "e = (\<Sum>(i::'a)\<in>Basis. d)"
       by (simp add: d_def DIM_positive)
     show "convex hull c \<subseteq> cball x e"
       unfolding 2
       apply clarsimp
       apply (subst euclidean_dist_l2)
       apply (rule order_trans [OF L2_set_le_sum])
       apply (rule zero_le_dist)
       unfolding e'
       apply (rule sum_mono, simp)
       done
   qed
   define k where "k = Max (f ` c)"
   have "convex_on (convex hull c) f"
     apply(rule convex_on_subset[OF assms(2)])
     apply(rule subset_trans[OF c1 e(1)])
     done
   then have k: "\<forall>y\<in>convex hull c. f y \<le> k"
     apply (rule_tac convex_on_convex_hull_bound, assumption)
     by (simp add: k_def c)
   have "e \<le> e * real DIM('a)"
     using e(2) real_of_nat_ge_one_iff by auto
   then have "d \<le> e"
     by (simp add: d_def field_split_simps)
   then have dsube: "cball x d \<subseteq> cball x e"
     by (rule subset_cball)
   have conv: "convex_on (cball x d) f"
     using \<open>convex_on (convex hull c) f\<close> c2 convex_on_subset by blast
   then have "\<forall>y\<in>cball x d. \<bar>f y\<bar> \<le> k + 2 * \<bar>f x\<bar>"
     by (rule convex_bounds_lemma) (use c2 k in blast)
   then have "continuous_on (ball x d) f"
     apply (rule_tac convex_on_bounded_continuous)
     apply (rule open_ball, rule convex_on_subset[OF conv])
     apply (rule ball_subset_cball, force)
     done
   then show "continuous (at x) f"
     unfolding continuous_on_eq_continuous_at[OF open_ball]
     using \<open>d > 0\<close> by auto
 qed
 
+
+section \<open>Line Segments\<close>
+
+subsection \<open>Midpoint\<close>
+
+definition\<^marker>\<open>tag important\<close> midpoint :: "'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a"
+  where "midpoint a b = (inverse (2::real)) *\<^sub>R (a + b)"
+
+lemma midpoint_idem [simp]: "midpoint x x = x"
+  unfolding midpoint_def  by simp
+
+lemma midpoint_sym: "midpoint a b = midpoint b a"
+  unfolding midpoint_def by (auto simp add: scaleR_right_distrib)
+
+lemma midpoint_eq_iff: "midpoint a b = c \<longleftrightarrow> a + b = c + c"
+proof -
+  have "midpoint a b = c \<longleftrightarrow> scaleR 2 (midpoint a b) = scaleR 2 c"
+    by simp
+  then show ?thesis
+    unfolding midpoint_def scaleR_2 [symmetric] by simp
+qed
+
+lemma
+  fixes a::real
+  assumes "a \<le> b" shows ge_midpoint_1: "a \<le> midpoint a b"
+                    and le_midpoint_1: "midpoint a b \<le> b"
+  by (simp_all add: midpoint_def assms)
+
+lemma dist_midpoint:
+  fixes a b :: "'a::real_normed_vector" shows
+  "dist a (midpoint a b) = (dist a b) / 2" (is ?t1)
+  "dist b (midpoint a b) = (dist a b) / 2" (is ?t2)
+  "dist (midpoint a b) a = (dist a b) / 2" (is ?t3)
+  "dist (midpoint a b) b = (dist a b) / 2" (is ?t4)
+proof -
+  have *: "\<And>x y::'a. 2 *\<^sub>R x = - y \<Longrightarrow> norm x = (norm y) / 2"
+    unfolding equation_minus_iff by auto
+  have **: "\<And>x y::'a. 2 *\<^sub>R x =   y \<Longrightarrow> norm x = (norm y) / 2"
+    by auto
+  note scaleR_right_distrib [simp]
+  show ?t1
+    unfolding midpoint_def dist_norm
+    apply (rule **)
+    apply (simp add: scaleR_right_diff_distrib)
+    apply (simp add: scaleR_2)
+    done
+  show ?t2
+    unfolding midpoint_def dist_norm
+    apply (rule *)
+    apply (simp add: scaleR_right_diff_distrib)
+    apply (simp add: scaleR_2)
+    done
+  show ?t3
+    unfolding midpoint_def dist_norm
+    apply (rule *)
+    apply (simp add: scaleR_right_diff_distrib)
+    apply (simp add: scaleR_2)
+    done
+  show ?t4
+    unfolding midpoint_def dist_norm
+    apply (rule **)
+    apply (simp add: scaleR_right_diff_distrib)
+    apply (simp add: scaleR_2)
+    done
+qed
+
+lemma midpoint_eq_endpoint [simp]:
+  "midpoint a b = a \<longleftrightarrow> a = b"
+  "midpoint a b = b \<longleftrightarrow> a = b"
+  unfolding midpoint_eq_iff by auto
+
+lemma midpoint_plus_self [simp]: "midpoint a b + midpoint a b = a + b"
+  using midpoint_eq_iff by metis
+
+lemma midpoint_linear_image:
+   "linear f \<Longrightarrow> midpoint(f a)(f b) = f(midpoint a b)"
+by (simp add: linear_iff midpoint_def)
+
+
+subsection \<open>Line segments\<close>
+
+definition\<^marker>\<open>tag important\<close> closed_segment :: "'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a set"
+  where "closed_segment a b = {(1 - u) *\<^sub>R a + u *\<^sub>R b | u::real. 0 \<le> u \<and> u \<le> 1}"
+
+definition\<^marker>\<open>tag important\<close> open_segment :: "'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a set" where
+  "open_segment a b \<equiv> closed_segment a b - {a,b}"
+
+lemmas segment = open_segment_def closed_segment_def
+
+lemma in_segment:
+    "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)"
+    "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)"
+  using less_eq_real_def by (auto simp: segment algebra_simps)
+
+lemma closed_segment_linear_image:
+  "closed_segment (f a) (f b) = f ` (closed_segment a b)" if "linear f"
+proof -
+  interpret linear f by fact
+  show ?thesis
+    by (force simp add: in_segment add scale)
+qed
+
+lemma open_segment_linear_image:
+    "\<lbrakk>linear f; inj f\<rbrakk> \<Longrightarrow> open_segment (f a) (f b) = f ` (open_segment a b)"
+  by (force simp: open_segment_def closed_segment_linear_image inj_on_def)
+
+lemma closed_segment_translation:
+    "closed_segment (c + a) (c + b) = image (\<lambda>x. c + x) (closed_segment a b)"
+apply safe
+apply (rule_tac x="x-c" in image_eqI)
+apply (auto simp: in_segment algebra_simps)
+done
+
+lemma open_segment_translation:
+    "open_segment (c + a) (c + b) = image (\<lambda>x. c + x) (open_segment a b)"
+by (simp add: open_segment_def closed_segment_translation translation_diff)
+
+lemma closed_segment_of_real:
+    "closed_segment (of_real x) (of_real y) = of_real ` closed_segment x y"
+  apply (auto simp: image_iff in_segment scaleR_conv_of_real)
+    apply (rule_tac x="(1-u)*x + u*y" in bexI)
+  apply (auto simp: in_segment)
+  done
+
+lemma open_segment_of_real:
+    "open_segment (of_real x) (of_real y) = of_real ` open_segment x y"
+  apply (auto simp: image_iff in_segment scaleR_conv_of_real)
+    apply (rule_tac x="(1-u)*x + u*y" in bexI)
+  apply (auto simp: in_segment)
+  done
+
+lemma closed_segment_Reals:
+    "\<lbrakk>x \<in> Reals; y \<in> Reals\<rbrakk> \<Longrightarrow> closed_segment x y = of_real ` closed_segment (Re x) (Re y)"
+  by (metis closed_segment_of_real of_real_Re)
+
+lemma open_segment_Reals:
+    "\<lbrakk>x \<in> Reals; y \<in> Reals\<rbrakk> \<Longrightarrow> open_segment x y = of_real ` open_segment (Re x) (Re y)"
+  by (metis open_segment_of_real of_real_Re)
+
+lemma open_segment_PairD:
+    "(x, x') \<in> open_segment (a, a') (b, b')
+     \<Longrightarrow> (x \<in> open_segment a b \<or> a = b) \<and> (x' \<in> open_segment a' b' \<or> a' = b')"
+  by (auto simp: in_segment)
+
+lemma closed_segment_PairD:
+  "(x, x') \<in> closed_segment (a, a') (b, b') \<Longrightarrow> x \<in> closed_segment a b \<and> x' \<in> closed_segment a' b'"
+  by (auto simp: closed_segment_def)
+
+lemma closed_segment_translation_eq [simp]:
+    "d + x \<in> closed_segment (d + a) (d + b) \<longleftrightarrow> x \<in> closed_segment a b"
+proof -
+  have *: "\<And>d x a b. x \<in> closed_segment a b \<Longrightarrow> d + x \<in> closed_segment (d + a) (d + b)"
+    apply (simp add: closed_segment_def)
+    apply (erule ex_forward)
+    apply (simp add: algebra_simps)
+    done
+  show ?thesis
+  using * [where d = "-d"] *
+  by (fastforce simp add:)
+qed
+
+lemma open_segment_translation_eq [simp]:
+    "d + x \<in> open_segment (d + a) (d + b) \<longleftrightarrow> x \<in> open_segment a b"
+  by (simp add: open_segment_def)
+
+lemma of_real_closed_segment [simp]:
+  "of_real x \<in> closed_segment (of_real a) (of_real b) \<longleftrightarrow> x \<in> closed_segment a b"
+  apply (auto simp: in_segment scaleR_conv_of_real elim!: ex_forward)
+  using of_real_eq_iff by fastforce
+
+lemma of_real_open_segment [simp]:
+  "of_real x \<in> open_segment (of_real a) (of_real b) \<longleftrightarrow> x \<in> open_segment a b"
+  apply (auto simp: in_segment scaleR_conv_of_real elim!: ex_forward del: exE)
+  using of_real_eq_iff by fastforce
+
+lemma convex_contains_segment:
+  "convex S \<longleftrightarrow> (\<forall>a\<in>S. \<forall>b\<in>S. closed_segment a b \<subseteq> S)"
+  unfolding convex_alt closed_segment_def by auto
+
+lemma closed_segment_in_Reals:
+   "\<lbrakk>x \<in> closed_segment a b; a \<in> Reals; b \<in> Reals\<rbrakk> \<Longrightarrow> x \<in> Reals"
+  by (meson subsetD convex_Reals convex_contains_segment)
+
+lemma open_segment_in_Reals:
+   "\<lbrakk>x \<in> open_segment a b; a \<in> Reals; b \<in> Reals\<rbrakk> \<Longrightarrow> x \<in> Reals"
+  by (metis Diff_iff closed_segment_in_Reals open_segment_def)
+
+lemma closed_segment_subset: "\<lbrakk>x \<in> S; y \<in> S; convex S\<rbrakk> \<Longrightarrow> closed_segment x y \<subseteq> S"
+  by (simp add: convex_contains_segment)
+
+lemma closed_segment_subset_convex_hull:
+    "\<lbrakk>x \<in> convex hull S; y \<in> convex hull S\<rbrakk> \<Longrightarrow> closed_segment x y \<subseteq> convex hull S"
+  using convex_contains_segment by blast
+
+lemma segment_convex_hull:
+  "closed_segment a b = convex hull {a,b}"
+proof -
+  have *: "\<And>x. {x} \<noteq> {}" by auto
+  show ?thesis
+    unfolding segment convex_hull_insert[OF *] convex_hull_singleton
+    by (safe; rule_tac x="1 - u" in exI; force)
+qed
+
+lemma open_closed_segment: "u \<in> open_segment w z \<Longrightarrow> u \<in> closed_segment w z"
+  by (auto simp add: closed_segment_def open_segment_def)
+
+lemma segment_open_subset_closed:
+   "open_segment a b \<subseteq> closed_segment a b"
+  by (auto simp: closed_segment_def open_segment_def)
+
+lemma bounded_closed_segment:
+    fixes a :: "'a::euclidean_space" shows "bounded (closed_segment a b)"
+  by (simp add: segment_convex_hull compact_convex_hull compact_imp_bounded)
+
+lemma bounded_open_segment:
+    fixes a :: "'a::euclidean_space" shows "bounded (open_segment a b)"
+  by (rule bounded_subset [OF bounded_closed_segment segment_open_subset_closed])
+
+lemmas bounded_segment = bounded_closed_segment open_closed_segment
+
+lemma ends_in_segment [iff]: "a \<in> closed_segment a b" "b \<in> closed_segment a b"
+  unfolding segment_convex_hull
+  by (auto intro!: hull_subset[unfolded subset_eq, rule_format])
+
+lemma eventually_closed_segment:
+  fixes x0::"'a::real_normed_vector"
+  assumes "open X0" "x0 \<in> X0"
+  shows "\<forall>\<^sub>F x in at x0 within U. closed_segment x0 x \<subseteq> X0"
+proof -
+  from openE[OF assms]
+  obtain e where e: "0 < e" "ball x0 e \<subseteq> X0" .
+  then have "\<forall>\<^sub>F x in at x0 within U. x \<in> ball x0 e"
+    by (auto simp: dist_commute eventually_at)
+  then show ?thesis
+  proof eventually_elim
+    case (elim x)
+    have "x0 \<in> ball x0 e" using \<open>e > 0\<close> by simp
+    from convex_ball[unfolded convex_contains_segment, rule_format, OF this elim]
+    have "closed_segment x0 x \<subseteq> ball x0 e" .
+    also note \<open>\<dots> \<subseteq> X0\<close>
+    finally show ?case .
+  qed
+qed
+
+lemma segment_furthest_le:
+  fixes a b x y :: "'a::euclidean_space"
+  assumes "x \<in> closed_segment a b"
+  shows "norm (y - x) \<le> norm (y - a) \<or>  norm (y - x) \<le> norm (y - b)"
+proof -
+  obtain z where "z \<in> {a, b}" "norm (x - y) \<le> norm (z - y)"
+    using simplex_furthest_le[of "{a, b}" y]
+    using assms[unfolded segment_convex_hull]
+    by auto
+  then show ?thesis
+    by (auto simp add:norm_minus_commute)
+qed
+
+lemma closed_segment_commute: "closed_segment a b = closed_segment b a"
+proof -
+  have "{a, b} = {b, a}" by auto
+  thus ?thesis
+    by (simp add: segment_convex_hull)
+qed
+
+lemma segment_bound1:
+  assumes "x \<in> closed_segment a b"
+  shows "norm (x - a) \<le> norm (b - a)"
+proof -
+  obtain u where "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" "0 \<le> u" "u \<le> 1"
+    using assms by (auto simp add: closed_segment_def)
+  then show "norm (x - a) \<le> norm (b - a)"
+    apply clarify
+    apply (auto simp: algebra_simps)
+    apply (simp add: scaleR_diff_right [symmetric] mult_left_le_one_le)
+    done
+qed
+
+lemma segment_bound:
+  assumes "x \<in> closed_segment a b"
+  shows "norm (x - a) \<le> norm (b - a)" "norm (x - b) \<le> norm (b - a)"
+apply (simp add: assms segment_bound1)
+by (metis assms closed_segment_commute dist_commute dist_norm segment_bound1)
+
+lemma open_segment_commute: "open_segment a b = open_segment b a"
+proof -
+  have "{a, b} = {b, a}" by auto
+  thus ?thesis
+    by (simp add: closed_segment_commute open_segment_def)
+qed
+
+lemma closed_segment_idem [simp]: "closed_segment a a = {a}"
+  unfolding segment by (auto simp add: algebra_simps)
+
+lemma open_segment_idem [simp]: "open_segment a a = {}"
+  by (simp add: open_segment_def)
+
+lemma closed_segment_eq_open: "closed_segment a b = open_segment a b \<union> {a,b}"
+  using open_segment_def by auto
+
+lemma convex_contains_open_segment:
+  "convex s \<longleftrightarrow> (\<forall>a\<in>s. \<forall>b\<in>s. open_segment a b \<subseteq> s)"
+  by (simp add: convex_contains_segment closed_segment_eq_open)
+
+lemma closed_segment_eq_real_ivl:
+  fixes a b::real
+  shows "closed_segment a b = (if a \<le> b then {a .. b} else {b .. a})"
+proof -
+  have "b \<le> a \<Longrightarrow> closed_segment b a = {b .. a}"
+    and "a \<le> b \<Longrightarrow> closed_segment a b = {a .. b}"
+    by (auto simp: convex_hull_eq_real_cbox segment_convex_hull)
+  thus ?thesis
+    by (auto simp: closed_segment_commute)
+qed
+
+lemma open_segment_eq_real_ivl:
+  fixes a b::real
+  shows "open_segment a b = (if a \<le> b then {a<..<b} else {b<..<a})"
+by (auto simp: closed_segment_eq_real_ivl open_segment_def split: if_split_asm)
+
+lemma closed_segment_real_eq:
+  fixes u::real shows "closed_segment u v = (\<lambda>x. (v - u) * x + u) ` {0..1}"
+  by (simp add: add.commute [of u] image_affinity_atLeastAtMost [where c=u] closed_segment_eq_real_ivl)
+
+lemma dist_in_closed_segment:
+  fixes a :: "'a :: euclidean_space"
+  assumes "x \<in> closed_segment a b"
+    shows "dist x a \<le> dist a b \<and> dist x b \<le> dist a b"
+proof (intro conjI)
+  obtain u where u: "0 \<le> u" "u \<le> 1" and x: "x = (1 - u) *\<^sub>R a + u *\<^sub>R b"
+    using assms by (force simp: in_segment algebra_simps)
+  have "dist x a = u * dist a b"
+    apply (simp add: dist_norm algebra_simps x)
+    by (metis \<open>0 \<le> u\<close> abs_of_nonneg norm_minus_commute norm_scaleR real_vector.scale_right_diff_distrib)
+  also have "...  \<le> dist a b"
+    by (simp add: mult_left_le_one_le u)
+  finally show "dist x a \<le> dist a b" .
+  have "dist x b = norm ((1-u) *\<^sub>R a - (1-u) *\<^sub>R b)"
+    by (simp add: dist_norm algebra_simps x)
+  also have "... = (1-u) * dist a b"
+  proof -
+    have "norm ((1 - 1 * u) *\<^sub>R (a - b)) = (1 - 1 * u) * norm (a - b)"
+      using \<open>u \<le> 1\<close> by force
+    then show ?thesis
+      by (simp add: dist_norm real_vector.scale_right_diff_distrib)
+  qed
+  also have "... \<le> dist a b"
+    by (simp add: mult_left_le_one_le u)
+  finally show "dist x b \<le> dist a b" .
+qed
+
+lemma dist_in_open_segment:
+  fixes a :: "'a :: euclidean_space"
+  assumes "x \<in> open_segment a b"
+    shows "dist x a < dist a b \<and> dist x b < dist a b"
+proof (intro conjI)
+  obtain u where u: "0 < u" "u < 1" and x: "x = (1 - u) *\<^sub>R a + u *\<^sub>R b"
+    using assms by (force simp: in_segment algebra_simps)
+  have "dist x a = u * dist a b"
+    apply (simp add: dist_norm algebra_simps x)
+    by (metis abs_of_nonneg less_eq_real_def norm_minus_commute norm_scaleR real_vector.scale_right_diff_distrib \<open>0 < u\<close>)
+  also have *: "...  < dist a b"
+    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>)
+  finally show "dist x a < dist a b" .
+  have ab_ne0: "dist a b \<noteq> 0"
+    using * by fastforce
+  have "dist x b = norm ((1-u) *\<^sub>R a - (1-u) *\<^sub>R b)"
+    by (simp add: dist_norm algebra_simps x)
+  also have "... = (1-u) * dist a b"
+  proof -
+    have "norm ((1 - 1 * u) *\<^sub>R (a - b)) = (1 - 1 * u) * norm (a - b)"
+      using \<open>u < 1\<close> by force
+    then show ?thesis
+      by (simp add: dist_norm real_vector.scale_right_diff_distrib)
+  qed
+  also have "... < dist a b"
+    using ab_ne0 \<open>0 < u\<close> by simp
+  finally show "dist x b < dist a b" .
+qed
+
+lemma dist_decreases_open_segment_0:
+  fixes x :: "'a :: euclidean_space"
+  assumes "x \<in> open_segment 0 b"
+    shows "dist c x < dist c 0 \<or> dist c x < dist c b"
+proof (rule ccontr, clarsimp simp: not_less)
+  obtain u where u: "0 \<noteq> b" "0 < u" "u < 1" and x: "x = u *\<^sub>R b"
+    using assms by (auto simp: in_segment)
+  have xb: "x \<bullet> b < b \<bullet> b"
+    using u x by auto
+  assume "norm c \<le> dist c x"
+  then have "c \<bullet> c \<le> (c - x) \<bullet> (c - x)"
+    by (simp add: dist_norm norm_le)
+  moreover have "0 < x \<bullet> b"
+    using u x by auto
+  ultimately have less: "c \<bullet> b < x \<bullet> b"
+    by (simp add: x algebra_simps inner_commute u)
+  assume "dist c b \<le> dist c x"
+  then have "(c - b) \<bullet> (c - b) \<le> (c - x) \<bullet> (c - x)"
+    by (simp add: dist_norm norm_le)
+  then have "(b \<bullet> b) * (1 - u*u) \<le> 2 * (b \<bullet> c) * (1-u)"
+    by (simp add: x algebra_simps inner_commute)
+  then have "(1+u) * (b \<bullet> b) * (1-u) \<le> 2 * (b \<bullet> c) * (1-u)"
+    by (simp add: algebra_simps)
+  then have "(1+u) * (b \<bullet> b) \<le> 2 * (b \<bullet> c)"
+    using \<open>u < 1\<close> by auto
+  with xb have "c \<bullet> b \<ge> x \<bullet> b"
+    by (auto simp: x algebra_simps inner_commute)
+  with less show False by auto
+qed
+
+proposition dist_decreases_open_segment:
+  fixes a :: "'a :: euclidean_space"
+  assumes "x \<in> open_segment a b"
+    shows "dist c x < dist c a \<or> dist c x < dist c b"
+proof -
+  have *: "x - a \<in> open_segment 0 (b - a)" using assms
+    by (metis diff_self open_segment_translation_eq uminus_add_conv_diff)
+  show ?thesis
+    using dist_decreases_open_segment_0 [OF *, of "c-a"] assms
+    by (simp add: dist_norm)
+qed
+
+corollary open_segment_furthest_le:
+  fixes a b x y :: "'a::euclidean_space"
+  assumes "x \<in> open_segment a b"
+  shows "norm (y - x) < norm (y - a) \<or>  norm (y - x) < norm (y - b)"
+  by (metis assms dist_decreases_open_segment dist_norm)
+
+corollary dist_decreases_closed_segment:
+  fixes a :: "'a :: euclidean_space"
+  assumes "x \<in> closed_segment a b"
+    shows "dist c x \<le> dist c a \<or> dist c x \<le> dist c b"
+apply (cases "x \<in> open_segment a b")
+ using dist_decreases_open_segment less_eq_real_def apply blast
+by (metis DiffI assms empty_iff insertE open_segment_def order_refl)
+
+lemma convex_intermediate_ball:
+  fixes a :: "'a :: euclidean_space"
+  shows "\<lbrakk>ball a r \<subseteq> T; T \<subseteq> cball a r\<rbrakk> \<Longrightarrow> convex T"
+apply (simp add: convex_contains_open_segment, clarify)
+by (metis (no_types, hide_lams) less_le_trans mem_ball mem_cball subsetCE dist_decreases_open_segment)
+
+lemma csegment_midpoint_subset: "closed_segment (midpoint a b) b \<subseteq> closed_segment a b"
+  apply (clarsimp simp: midpoint_def in_segment)
+  apply (rule_tac x="(1 + u) / 2" in exI)
+  apply (auto simp: algebra_simps add_divide_distrib diff_divide_distrib)
+  by (metis field_sum_of_halves scaleR_left.add)
+
+lemma notin_segment_midpoint:
+  fixes a :: "'a :: euclidean_space"
+  shows "a \<noteq> b \<Longrightarrow> a \<notin> closed_segment (midpoint a b) b"
+by (auto simp: dist_midpoint dest!: dist_in_closed_segment)
+
+lemma segment_to_closest_point:
+  fixes S :: "'a :: euclidean_space set"
+  shows "\<lbrakk>closed S; S \<noteq> {}\<rbrakk> \<Longrightarrow> open_segment a (closest_point S a) \<inter> S = {}"
+  apply (subst disjoint_iff_not_equal)
+  apply (clarify dest!: dist_in_open_segment)
+  by (metis closest_point_le dist_commute le_less_trans less_irrefl)
+
+lemma segment_to_point_exists:
+  fixes S :: "'a :: euclidean_space set"
+    assumes "closed S" "S \<noteq> {}"
+    obtains b where "b \<in> S" "open_segment a b \<inter> S = {}"
+  by (metis assms segment_to_closest_point closest_point_exists that)
+
+subsubsection\<open>More lemmas, especially for working with the underlying formula\<close>
+
+lemma segment_eq_compose:
+  fixes a :: "'a :: real_vector"
+  shows "(\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) = (\<lambda>x. a + x) o (\<lambda>u. u *\<^sub>R (b - a))"
+    by (simp add: o_def algebra_simps)
+
+lemma segment_degen_1:
+  fixes a :: "'a :: real_vector"
+  shows "(1 - u) *\<^sub>R a + u *\<^sub>R b = b \<longleftrightarrow> a=b \<or> u=1"
+proof -
+  { assume "(1 - u) *\<^sub>R a + u *\<^sub>R b = b"
+    then have "(1 - u) *\<^sub>R a = (1 - u) *\<^sub>R b"
+      by (simp add: algebra_simps)
+    then have "a=b \<or> u=1"
+      by simp
+  } then show ?thesis
+      by (auto simp: algebra_simps)
+qed
+
+lemma segment_degen_0:
+    fixes a :: "'a :: real_vector"
+    shows "(1 - u) *\<^sub>R a + u *\<^sub>R b = a \<longleftrightarrow> a=b \<or> u=0"
+  using segment_degen_1 [of "1-u" b a]
+  by (auto simp: algebra_simps)
+
+lemma add_scaleR_degen:
+  fixes a b ::"'a::real_vector"
+  assumes  "(u *\<^sub>R b + v *\<^sub>R a) = (u *\<^sub>R a + v *\<^sub>R b)"  "u \<noteq> v"
+  shows "a=b"
+  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)
+  
+lemma closed_segment_image_interval:
+     "closed_segment a b = (\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) ` {0..1}"
+  by (auto simp: set_eq_iff image_iff closed_segment_def)
+
+lemma open_segment_image_interval:
+     "open_segment a b = (if a=b then {} else (\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) ` {0<..<1})"
+  by (auto simp:  open_segment_def closed_segment_def segment_degen_0 segment_degen_1)
+
+lemmas segment_image_interval = closed_segment_image_interval open_segment_image_interval
+
+lemma open_segment_bound1:
+  assumes "x \<in> open_segment a b"
+  shows "norm (x - a) < norm (b - a)"
+proof -
+  obtain u where "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" "0 < u" "u < 1" "a \<noteq> b"
+    using assms by (auto simp add: open_segment_image_interval split: if_split_asm)
+  then show "norm (x - a) < norm (b - a)"
+    apply clarify
+    apply (auto simp: algebra_simps)
+    apply (simp add: scaleR_diff_right [symmetric])
+    done
+qed
+
+lemma compact_segment [simp]:
+  fixes a :: "'a::real_normed_vector"
+  shows "compact (closed_segment a b)"
+  by (auto simp: segment_image_interval intro!: compact_continuous_image continuous_intros)
+
+lemma closed_segment [simp]:
+  fixes a :: "'a::real_normed_vector"
+  shows "closed (closed_segment a b)"
+  by (simp add: compact_imp_closed)
+
+lemma closure_closed_segment [simp]:
+  fixes a :: "'a::real_normed_vector"
+  shows "closure(closed_segment a b) = closed_segment a b"
+  by simp
+
+lemma open_segment_bound:
+  assumes "x \<in> open_segment a b"
+  shows "norm (x - a) < norm (b - a)" "norm (x - b) < norm (b - a)"
+apply (simp add: assms open_segment_bound1)
+by (metis assms norm_minus_commute open_segment_bound1 open_segment_commute)
+
+lemma closure_open_segment [simp]:
+  "closure (open_segment a b) = (if a = b then {} else closed_segment a b)"
+    for a :: "'a::euclidean_space"
+proof (cases "a = b")
+  case True
+  then show ?thesis
+    by simp
+next
+  case False
+  have "closure ((\<lambda>u. u *\<^sub>R (b - a)) ` {0<..<1}) = (\<lambda>u. u *\<^sub>R (b - a)) ` closure {0<..<1}"
+    apply (rule closure_injective_linear_image [symmetric])
+     apply (use False in \<open>auto intro!: injI\<close>)
+    done
+  then have "closure
+     ((\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) ` {0<..<1}) =
+    (\<lambda>x. (1 - x) *\<^sub>R a + x *\<^sub>R b) ` closure {0<..<1}"
+    using closure_translation [of a "((\<lambda>x. x *\<^sub>R b - x *\<^sub>R a) ` {0<..<1})"]
+    by (simp add: segment_eq_compose field_simps scaleR_diff_left scaleR_diff_right image_image)
+  then show ?thesis
+    by (simp add: segment_image_interval closure_greaterThanLessThan [symmetric] del: closure_greaterThanLessThan)
+qed
+
+lemma closed_open_segment_iff [simp]:
+    fixes a :: "'a::euclidean_space"  shows "closed(open_segment a b) \<longleftrightarrow> a = b"
+  by (metis open_segment_def DiffE closure_eq closure_open_segment ends_in_segment(1) insert_iff segment_image_interval(2))
+
+lemma compact_open_segment_iff [simp]:
+    fixes a :: "'a::euclidean_space"  shows "compact(open_segment a b) \<longleftrightarrow> a = b"
+  by (simp add: bounded_open_segment compact_eq_bounded_closed)
+
+lemma convex_closed_segment [iff]: "convex (closed_segment a b)"
+  unfolding segment_convex_hull by(rule convex_convex_hull)
+
+lemma convex_open_segment [iff]: "convex (open_segment a b)"
+proof -
+  have "convex ((\<lambda>u. u *\<^sub>R (b - a)) ` {0<..<1})"
+    by (rule convex_linear_image) auto
+  then have "convex ((+) a ` (\<lambda>u. u *\<^sub>R (b - a)) ` {0<..<1})"
+    by (rule convex_translation)
+  then show ?thesis
+    by (simp add: image_image open_segment_image_interval segment_eq_compose field_simps scaleR_diff_left scaleR_diff_right)
+qed
+
+lemmas convex_segment = convex_closed_segment convex_open_segment
+
+lemma connected_segment [iff]:
+  fixes x :: "'a :: real_normed_vector"
+  shows "connected (closed_segment x y)"
+  by (simp add: convex_connected)
+
+lemma is_interval_closed_segment_1[intro, simp]: "is_interval (closed_segment a b)" for a b::real
+  by (auto simp: is_interval_convex_1)
+
+lemma IVT'_closed_segment_real:
+  fixes f :: "real \<Rightarrow> real"
+  assumes "y \<in> closed_segment (f a) (f b)"
+  assumes "continuous_on (closed_segment a b) f"
+  shows "\<exists>x \<in> closed_segment a b. f x = y"
+  using IVT'[of f a y b]
+    IVT'[of "-f" a "-y" b]
+    IVT'[of f b y a]
+    IVT'[of "-f" b "-y" a] assms
+  by (cases "a \<le> b"; cases "f b \<ge> f a") (auto simp: closed_segment_eq_real_ivl continuous_on_minus)
+
 end
diff --git a/src/HOL/Analysis/Derivative.thy b/src/HOL/Analysis/Derivative.thy
--- a/src/HOL/Analysis/Derivative.thy
+++ b/src/HOL/Analysis/Derivative.thy
@@ -1,2900 +1,2901 @@
 (*  Title:      HOL/Analysis/Derivative.thy
     Author:     John Harrison
     Author:     Robert Himmelmann, TU Muenchen (translation from HOL Light); tidied by LCP
 *)
 
 section \<open>Derivative\<close>
 
 theory Derivative
   imports
-    Starlike
+    Convex_Euclidean_Space 
+    Abstract_Limits
     Operator_Norm
     Uniform_Limit
     Bounded_Linear_Function
 begin
 
 declare bounded_linear_inner_left [intro]
 
 declare has_derivative_bounded_linear[dest]
 
 subsection \<open>Derivatives\<close>
 
 lemma has_derivative_add_const:
   "(f has_derivative f') net \<Longrightarrow> ((\<lambda>x. f x + c) has_derivative f') net"
   by (intro derivative_eq_intros) auto
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Derivative with composed bilinear function\<close>
 
 text \<open>More explicit epsilon-delta forms.\<close>
 
 proposition has_derivative_within':
   "(f has_derivative f')(at x within s) \<longleftrightarrow>
     bounded_linear f' \<and>
     (\<forall>e>0. \<exists>d>0. \<forall>x'\<in>s. 0 < norm (x' - x) \<and> norm (x' - x) < d \<longrightarrow>
       norm (f x' - f x - f'(x' - x)) / norm (x' - x) < e)"
   unfolding has_derivative_within Lim_within dist_norm
   by (simp add: diff_diff_eq)
 
 lemma has_derivative_at':
   "(f has_derivative f') (at x) 
    \<longleftrightarrow> bounded_linear f' \<and>
        (\<forall>e>0. \<exists>d>0. \<forall>x'. 0 < norm (x' - x) \<and> norm (x' - x) < d \<longrightarrow>
         norm (f x' - f x - f'(x' - x)) / norm (x' - x) < e)"
   using has_derivative_within' [of f f' x UNIV] by simp
 
 lemma has_derivative_componentwise_within:
    "(f has_derivative f') (at a within S) \<longleftrightarrow>
     (\<forall>i \<in> Basis. ((\<lambda>x. f x \<bullet> i) has_derivative (\<lambda>x. f' x \<bullet> i)) (at a within S))"
   apply (simp add: has_derivative_within)
   apply (subst tendsto_componentwise_iff)
   apply (simp add: bounded_linear_componentwise_iff [symmetric] ball_conj_distrib)
   apply (simp add: algebra_simps)
   done
 
 lemma has_derivative_at_withinI:
   "(f has_derivative f') (at x) \<Longrightarrow> (f has_derivative f') (at x within s)"
   unfolding has_derivative_within' has_derivative_at'
   by blast
 
 lemma has_derivative_right:
   fixes f :: "real \<Rightarrow> real"
     and y :: "real"
   shows "(f has_derivative ((*) y)) (at x within ({x <..} \<inter> I)) \<longleftrightarrow>
          ((\<lambda>t. (f x - f t) / (x - t)) \<longlongrightarrow> y) (at x within ({x <..} \<inter> I))"
 proof -
   have "((\<lambda>t. (f t - (f x + y * (t - x))) / \<bar>t - x\<bar>) \<longlongrightarrow> 0) (at x within ({x<..} \<inter> I)) \<longleftrightarrow>
     ((\<lambda>t. (f t - f x) / (t - x) - y) \<longlongrightarrow> 0) (at x within ({x<..} \<inter> I))"
     by (intro Lim_cong_within) (auto simp add: diff_divide_distrib add_divide_distrib)
   also have "\<dots> \<longleftrightarrow> ((\<lambda>t. (f t - f x) / (t - x)) \<longlongrightarrow> y) (at x within ({x<..} \<inter> I))"
     by (simp add: Lim_null[symmetric])
   also have "\<dots> \<longleftrightarrow> ((\<lambda>t. (f x - f t) / (x - t)) \<longlongrightarrow> y) (at x within ({x<..} \<inter> I))"
     by (intro Lim_cong_within) (simp_all add: field_simps)
   finally show ?thesis
     by (simp add: bounded_linear_mult_right has_derivative_within)
 qed
 
 subsubsection \<open>Caratheodory characterization\<close>
 
 lemma DERIV_caratheodory_within:
   "(f has_field_derivative l) (at x within S) \<longleftrightarrow>
    (\<exists>g. (\<forall>z. f z - f x = g z * (z - x)) \<and> continuous (at x within S) g \<and> g x = l)"
       (is "?lhs = ?rhs")
 proof
   assume ?lhs
   show ?rhs
   proof (intro exI conjI)
     let ?g = "(%z. if z = x then l else (f z - f x) / (z-x))"
     show "\<forall>z. f z - f x = ?g z * (z-x)" by simp
     show "continuous (at x within S) ?g" using \<open>?lhs\<close>
       by (auto simp add: continuous_within has_field_derivative_iff cong: Lim_cong_within)
     show "?g x = l" by simp
   qed
 next
   assume ?rhs
   then obtain g where
     "(\<forall>z. f z - f x = g z * (z-x))" and "continuous (at x within S) g" and "g x = l" by blast
   thus ?lhs
     by (auto simp add: continuous_within has_field_derivative_iff cong: Lim_cong_within)
 qed
 
 subsection \<open>Differentiability\<close>
 
 definition\<^marker>\<open>tag important\<close>
   differentiable_on :: "('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'a set \<Rightarrow> bool"
     (infix "differentiable'_on" 50)
   where "f differentiable_on s \<longleftrightarrow> (\<forall>x\<in>s. f differentiable (at x within s))"
 
 lemma differentiableI: "(f has_derivative f') net \<Longrightarrow> f differentiable net"
   unfolding differentiable_def
   by auto
 
 lemma differentiable_onD: "\<lbrakk>f differentiable_on S; x \<in> S\<rbrakk> \<Longrightarrow> f differentiable (at x within S)"
   using differentiable_on_def by blast
 
 lemma differentiable_at_withinI: "f differentiable (at x) \<Longrightarrow> f differentiable (at x within s)"
   unfolding differentiable_def
   using has_derivative_at_withinI
   by blast
 
 lemma differentiable_at_imp_differentiable_on:
   "(\<And>x. x \<in> s \<Longrightarrow> f differentiable at x) \<Longrightarrow> f differentiable_on s"
   by (metis differentiable_at_withinI differentiable_on_def)
 
 corollary\<^marker>\<open>tag unimportant\<close> differentiable_iff_scaleR:
   fixes f :: "real \<Rightarrow> 'a::real_normed_vector"
   shows "f differentiable F \<longleftrightarrow> (\<exists>d. (f has_derivative (\<lambda>x. x *\<^sub>R d)) F)"
   by (auto simp: differentiable_def dest: has_derivative_linear linear_imp_scaleR)
 
 lemma differentiable_on_eq_differentiable_at:
   "open s \<Longrightarrow> f differentiable_on s \<longleftrightarrow> (\<forall>x\<in>s. f differentiable at x)"
   unfolding differentiable_on_def
   by (metis at_within_interior interior_open)
 
 lemma differentiable_transform_within:
   assumes "f differentiable (at x within s)"
     and "0 < d"
     and "x \<in> s"
     and "\<And>x'. \<lbrakk>x'\<in>s; dist x' x < d\<rbrakk> \<Longrightarrow> f x' = g x'"
   shows "g differentiable (at x within s)"
    using assms has_derivative_transform_within unfolding differentiable_def
    by blast
 
 lemma differentiable_on_ident [simp, derivative_intros]: "(\<lambda>x. x) differentiable_on S"
   by (simp add: differentiable_at_imp_differentiable_on)
 
 lemma differentiable_on_id [simp, derivative_intros]: "id differentiable_on S"
   by (simp add: id_def)
 
 lemma differentiable_on_const [simp, derivative_intros]: "(\<lambda>z. c) differentiable_on S"
   by (simp add: differentiable_on_def)
 
 lemma differentiable_on_mult [simp, derivative_intros]:
   fixes f :: "'M::real_normed_vector \<Rightarrow> 'a::real_normed_algebra"
   shows "\<lbrakk>f differentiable_on S; g differentiable_on S\<rbrakk> \<Longrightarrow> (\<lambda>z. f z * g z) differentiable_on S"
   unfolding differentiable_on_def differentiable_def
   using differentiable_def differentiable_mult by blast
 
 lemma differentiable_on_compose:
    "\<lbrakk>g differentiable_on S; f differentiable_on (g ` S)\<rbrakk> \<Longrightarrow> (\<lambda>x. f (g x)) differentiable_on S"
 by (simp add: differentiable_in_compose differentiable_on_def)
 
 lemma bounded_linear_imp_differentiable_on: "bounded_linear f \<Longrightarrow> f differentiable_on S"
   by (simp add: differentiable_on_def bounded_linear_imp_differentiable)
 
 lemma linear_imp_differentiable_on:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   shows "linear f \<Longrightarrow> f differentiable_on S"
 by (simp add: differentiable_on_def linear_imp_differentiable)
 
 lemma differentiable_on_minus [simp, derivative_intros]:
    "f differentiable_on S \<Longrightarrow> (\<lambda>z. -(f z)) differentiable_on S"
 by (simp add: differentiable_on_def)
 
 lemma differentiable_on_add [simp, derivative_intros]:
    "\<lbrakk>f differentiable_on S; g differentiable_on S\<rbrakk> \<Longrightarrow> (\<lambda>z. f z + g z) differentiable_on S"
 by (simp add: differentiable_on_def)
 
 lemma differentiable_on_diff [simp, derivative_intros]:
    "\<lbrakk>f differentiable_on S; g differentiable_on S\<rbrakk> \<Longrightarrow> (\<lambda>z. f z - g z) differentiable_on S"
 by (simp add: differentiable_on_def)
 
 lemma differentiable_on_inverse [simp, derivative_intros]:
   fixes f :: "'a :: real_normed_vector \<Rightarrow> 'b :: real_normed_field"
   shows "f differentiable_on S \<Longrightarrow> (\<And>x. x \<in> S \<Longrightarrow> f x \<noteq> 0) \<Longrightarrow> (\<lambda>x. inverse (f x)) differentiable_on S"
 by (simp add: differentiable_on_def)
 
 lemma differentiable_on_scaleR [derivative_intros, simp]:
    "\<lbrakk>f differentiable_on S; g differentiable_on S\<rbrakk> \<Longrightarrow> (\<lambda>x. f x *\<^sub>R g x) differentiable_on S"
   unfolding differentiable_on_def
   by (blast intro: differentiable_scaleR)
 
 lemma has_derivative_sqnorm_at [derivative_intros, simp]:
   "((\<lambda>x. (norm x)\<^sup>2) has_derivative (\<lambda>x. 2 *\<^sub>R (a \<bullet> x))) (at a)"
   using bounded_bilinear.FDERIV  [of "(\<bullet>)" id id a _ id id]
   by (auto simp: inner_commute dot_square_norm bounded_bilinear_inner)
 
 lemma differentiable_sqnorm_at [derivative_intros, simp]:
   fixes a :: "'a :: {real_normed_vector,real_inner}"
   shows "(\<lambda>x. (norm x)\<^sup>2) differentiable (at a)"
 by (force simp add: differentiable_def intro: has_derivative_sqnorm_at)
 
 lemma differentiable_on_sqnorm [derivative_intros, simp]:
   fixes S :: "'a :: {real_normed_vector,real_inner} set"
   shows "(\<lambda>x. (norm x)\<^sup>2) differentiable_on S"
 by (simp add: differentiable_at_imp_differentiable_on)
 
 lemma differentiable_norm_at [derivative_intros, simp]:
   fixes a :: "'a :: {real_normed_vector,real_inner}"
   shows "a \<noteq> 0 \<Longrightarrow> norm differentiable (at a)"
 using differentiableI has_derivative_norm by blast
 
 lemma differentiable_on_norm [derivative_intros, simp]:
   fixes S :: "'a :: {real_normed_vector,real_inner} set"
   shows "0 \<notin> S \<Longrightarrow> norm differentiable_on S"
 by (metis differentiable_at_imp_differentiable_on differentiable_norm_at)
 
 
 subsection \<open>Frechet derivative and Jacobian matrix\<close>
 
 definition "frechet_derivative f net = (SOME f'. (f has_derivative f') net)"
 
 proposition frechet_derivative_works:
   "f differentiable net \<longleftrightarrow> (f has_derivative (frechet_derivative f net)) net"
   unfolding frechet_derivative_def differentiable_def
   unfolding some_eq_ex[of "\<lambda> f' . (f has_derivative f') net"] ..
 
 lemma linear_frechet_derivative: "f differentiable net \<Longrightarrow> linear (frechet_derivative f net)"
   unfolding frechet_derivative_works has_derivative_def
   by (auto intro: bounded_linear.linear)
 
 lemma frechet_derivative_const [simp]: "frechet_derivative (\<lambda>x. c) (at a) = (\<lambda>x. 0)"
   using differentiable_const frechet_derivative_works has_derivative_const has_derivative_unique by blast
 
 lemma frechet_derivative_id [simp]: "frechet_derivative id (at a) = id"
   using differentiable_def frechet_derivative_works has_derivative_id has_derivative_unique by blast
 
 lemma frechet_derivative_ident [simp]: "frechet_derivative (\<lambda>x. x) (at a) = (\<lambda>x. x)"
   by (metis eq_id_iff frechet_derivative_id)
 
 
 subsection \<open>Differentiability implies continuity\<close>
 
 proposition differentiable_imp_continuous_within:
   "f differentiable (at x within s) \<Longrightarrow> continuous (at x within s) f"
   by (auto simp: differentiable_def intro: has_derivative_continuous)
 
 lemma differentiable_imp_continuous_on:
   "f differentiable_on s \<Longrightarrow> continuous_on s f"
   unfolding differentiable_on_def continuous_on_eq_continuous_within
   using differentiable_imp_continuous_within by blast
 
 lemma differentiable_on_subset:
   "f differentiable_on t \<Longrightarrow> s \<subseteq> t \<Longrightarrow> f differentiable_on s"
   unfolding differentiable_on_def
   using differentiable_within_subset
   by blast
 
 lemma differentiable_on_empty: "f differentiable_on {}"
   unfolding differentiable_on_def
   by auto
 
 lemma has_derivative_continuous_on:
   "(\<And>x. x \<in> s \<Longrightarrow> (f has_derivative f' x) (at x within s)) \<Longrightarrow> continuous_on s f"
   by (auto intro!: differentiable_imp_continuous_on differentiableI simp: differentiable_on_def)
 
 text \<open>Results about neighborhoods filter.\<close>
 
 lemma eventually_nhds_metric_le:
   "eventually P (nhds a) = (\<exists>d>0. \<forall>x. dist x a \<le> d \<longrightarrow> P x)"
   unfolding eventually_nhds_metric by (safe, rule_tac x="d / 2" in exI, auto)
 
 lemma le_nhds: "F \<le> nhds a \<longleftrightarrow> (\<forall>S. open S \<and> a \<in> S \<longrightarrow> eventually (\<lambda>x. x \<in> S) F)"
   unfolding le_filter_def eventually_nhds by (fast elim: eventually_mono)
 
 lemma le_nhds_metric: "F \<le> nhds a \<longleftrightarrow> (\<forall>e>0. eventually (\<lambda>x. dist x a < e) F)"
   unfolding le_filter_def eventually_nhds_metric by (fast elim: eventually_mono)
 
 lemma le_nhds_metric_le: "F \<le> nhds a \<longleftrightarrow> (\<forall>e>0. eventually (\<lambda>x. dist x a \<le> e) F)"
   unfolding le_filter_def eventually_nhds_metric_le by (fast elim: eventually_mono)
 
 text \<open>Several results are easier using a "multiplied-out" variant.
 (I got this idea from Dieudonne's proof of the chain rule).\<close>
 
 lemma has_derivative_within_alt:
   "(f has_derivative f') (at x within s) \<longleftrightarrow> bounded_linear f' \<and>
     (\<forall>e>0. \<exists>d>0. \<forall>y\<in>s. norm(y - x) < d \<longrightarrow> norm (f y - f x - f' (y - x)) \<le> e * norm (y - x))"
   unfolding has_derivative_within filterlim_def le_nhds_metric_le eventually_filtermap
     eventually_at dist_norm diff_diff_eq
   by (force simp add: linear_0 bounded_linear.linear pos_divide_le_eq)
 
 lemma has_derivative_within_alt2:
   "(f has_derivative f') (at x within s) \<longleftrightarrow> bounded_linear f' \<and>
     (\<forall>e>0. eventually (\<lambda>y. norm (f y - f x - f' (y - x)) \<le> e * norm (y - x)) (at x within s))"
   unfolding has_derivative_within filterlim_def le_nhds_metric_le eventually_filtermap
     eventually_at dist_norm diff_diff_eq
   by (force simp add: linear_0 bounded_linear.linear pos_divide_le_eq)
 
 lemma has_derivative_at_alt:
   "(f has_derivative f') (at x) \<longleftrightarrow>
     bounded_linear f' \<and>
     (\<forall>e>0. \<exists>d>0. \<forall>y. norm(y - x) < d \<longrightarrow> norm (f y - f x - f'(y - x)) \<le> e * norm (y - x))"
   using has_derivative_within_alt[where s=UNIV]
   by simp
 
 
 subsection \<open>The chain rule\<close>
 
 proposition diff_chain_within[derivative_intros]:
   assumes "(f has_derivative f') (at x within s)"
     and "(g has_derivative g') (at (f x) within (f ` s))"
   shows "((g \<circ> f) has_derivative (g' \<circ> f'))(at x within s)"
   using has_derivative_in_compose[OF assms]
   by (simp add: comp_def)
 
 lemma diff_chain_at[derivative_intros]:
   "(f has_derivative f') (at x) \<Longrightarrow>
     (g has_derivative g') (at (f x)) \<Longrightarrow> ((g \<circ> f) has_derivative (g' \<circ> f')) (at x)"
   using has_derivative_compose[of f f' x UNIV g g']
   by (simp add: comp_def)
 
 lemma has_vector_derivative_within_open:
   "a \<in> S \<Longrightarrow> open S \<Longrightarrow>
     (f has_vector_derivative f') (at a within S) \<longleftrightarrow> (f has_vector_derivative f') (at a)"
   by (simp only: at_within_interior interior_open)
 
 lemma field_vector_diff_chain_within:
  assumes Df: "(f has_vector_derivative f') (at x within S)"
      and Dg: "(g has_field_derivative g') (at (f x) within f ` S)"
  shows "((g \<circ> f) has_vector_derivative (f' * g')) (at x within S)"
 using diff_chain_within[OF Df[unfolded has_vector_derivative_def]
                        Dg [unfolded has_field_derivative_def]]
  by (auto simp: o_def mult.commute has_vector_derivative_def)
 
 lemma vector_derivative_diff_chain_within:
   assumes Df: "(f has_vector_derivative f') (at x within S)"
      and Dg: "(g has_derivative g') (at (f x) within f`S)"
   shows "((g \<circ> f) has_vector_derivative (g' f')) (at x within S)"
 using diff_chain_within[OF Df[unfolded has_vector_derivative_def] Dg]
   linear.scaleR[OF has_derivative_linear[OF Dg]]
   unfolding has_vector_derivative_def o_def
   by (auto simp: o_def mult.commute has_vector_derivative_def)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Composition rules stated just for differentiability\<close>
 
 lemma differentiable_chain_at:
   "f differentiable (at x) \<Longrightarrow>
     g differentiable (at (f x)) \<Longrightarrow> (g \<circ> f) differentiable (at x)"
   unfolding differentiable_def
   by (meson diff_chain_at)
 
 lemma differentiable_chain_within:
   "f differentiable (at x within S) \<Longrightarrow>
     g differentiable (at(f x) within (f ` S)) \<Longrightarrow> (g \<circ> f) differentiable (at x within S)"
   unfolding differentiable_def
   by (meson diff_chain_within)
 
 
 subsection \<open>Uniqueness of derivative\<close>
 
 
 text\<^marker>\<open>tag important\<close> \<open>
  The general result is a bit messy because we need approachability of the
  limit point from any direction. But OK for nontrivial intervals etc.
 \<close>
 
 proposition frechet_derivative_unique_within:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes 1: "(f has_derivative f') (at x within S)"
     and 2: "(f has_derivative f'') (at x within S)"
     and S: "\<And>i e. \<lbrakk>i\<in>Basis; e>0\<rbrakk> \<Longrightarrow> \<exists>d. 0 < \<bar>d\<bar> \<and> \<bar>d\<bar> < e \<and> (x + d *\<^sub>R i) \<in> S"
   shows "f' = f''"
 proof -
   note as = assms(1,2)[unfolded has_derivative_def]
   then interpret f': bounded_linear f' by auto
   from as interpret f'': bounded_linear f'' by auto
   have "x islimpt S" unfolding islimpt_approachable
   proof (intro allI impI)
     fix e :: real
     assume "e > 0"
     obtain d where "0 < \<bar>d\<bar>" and "\<bar>d\<bar> < e" and "x + d *\<^sub>R (SOME i. i \<in> Basis) \<in> S"
       using assms(3) SOME_Basis \<open>e>0\<close> by blast
     then show "\<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e"
       by (rule_tac x="x + d *\<^sub>R (SOME i. i \<in> Basis)" in bexI) (auto simp: dist_norm SOME_Basis nonzero_Basis)  qed
   then have *: "netlimit (at x within S) = x"
     by (simp add: Lim_ident_at trivial_limit_within)
   show ?thesis
   proof (rule linear_eq_stdbasis)
     show "linear f'" "linear f''"
       unfolding linear_conv_bounded_linear using as by auto
   next
     fix i :: 'a
     assume i: "i \<in> Basis"
     define e where "e = norm (f' i - f'' i)"
     show "f' i = f'' i"
     proof (rule ccontr)
       assume "f' i \<noteq> f'' i"
       then have "e > 0"
         unfolding e_def by auto
       obtain d where d:
         "0 < d"
         "(\<And>y. y\<in>S \<longrightarrow> 0 < dist y x \<and> dist y x < d \<longrightarrow>
           dist ((f y - f x - f' (y - x)) /\<^sub>R norm (y - x) -
               (f y - f x - f'' (y - x)) /\<^sub>R norm (y - x)) (0 - 0) < e)"
         using tendsto_diff [OF as(1,2)[THEN conjunct2]]
         unfolding * Lim_within
         using \<open>e>0\<close> by blast
       obtain c where c: "0 < \<bar>c\<bar>" "\<bar>c\<bar> < d \<and> x + c *\<^sub>R i \<in> S"
         using assms(3) i d(1) by blast
       have *: "norm (- ((1 / \<bar>c\<bar>) *\<^sub>R f' (c *\<^sub>R i)) + (1 / \<bar>c\<bar>) *\<^sub>R f'' (c *\<^sub>R i)) =
         norm ((1 / \<bar>c\<bar>) *\<^sub>R (- (f' (c *\<^sub>R i)) + f'' (c *\<^sub>R i)))"
         unfolding scaleR_right_distrib by auto
       also have "\<dots> = norm ((1 / \<bar>c\<bar>) *\<^sub>R (c *\<^sub>R (- (f' i) + f'' i)))"
         unfolding f'.scaleR f''.scaleR
         unfolding scaleR_right_distrib scaleR_minus_right
         by auto
       also have "\<dots> = e"
         unfolding e_def
         using c(1)
         using norm_minus_cancel[of "f' i - f'' i"]
         by auto
       finally show False
         using c
         using d(2)[of "x + c *\<^sub>R i"]
         unfolding dist_norm
         unfolding f'.scaleR f''.scaleR f'.add f''.add f'.diff f''.diff
           scaleR_scaleR scaleR_right_diff_distrib scaleR_right_distrib
         using i
         by (auto simp: inverse_eq_divide)
     qed
   qed
 qed
 
 proposition frechet_derivative_unique_within_closed_interval:
   fixes f::"'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes ab: "\<And>i. i\<in>Basis \<Longrightarrow> a\<bullet>i < b\<bullet>i"
     and x: "x \<in> cbox a b"
     and "(f has_derivative f' ) (at x within cbox a b)"
     and "(f has_derivative f'') (at x within cbox a b)"
   shows "f' = f''"
 proof (rule frechet_derivative_unique_within)
   fix e :: real
   fix i :: 'a
   assume "e > 0" and i: "i \<in> Basis"
   then show "\<exists>d. 0 < \<bar>d\<bar> \<and> \<bar>d\<bar> < e \<and> x + d *\<^sub>R i \<in> cbox a b"
   proof (cases "x\<bullet>i = a\<bullet>i")
     case True
     with ab[of i] \<open>e>0\<close> x i show ?thesis
       by (rule_tac x="(min (b\<bullet>i - a\<bullet>i) e) / 2" in exI)
          (auto simp add: mem_box field_simps inner_simps inner_Basis)
   next
     case False
     moreover have "a \<bullet> i < x \<bullet> i"
       using False i mem_box(2) x by force
     moreover {
       have "a \<bullet> i * 2 + min (x \<bullet> i - a \<bullet> i) e \<le> a\<bullet>i *2 + x\<bullet>i - a\<bullet>i"
         by auto
       also have "\<dots> = a\<bullet>i + x\<bullet>i"
         by auto
       also have "\<dots> \<le> 2 * (x\<bullet>i)"
         using \<open>a \<bullet> i < x \<bullet> i\<close> by auto
       finally have "a \<bullet> i * 2 + min (x \<bullet> i - a \<bullet> i) e \<le> x \<bullet> i * 2"
         by auto
     }
     moreover have "min (x \<bullet> i - a \<bullet> i) e \<ge> 0"
       by (simp add: \<open>0 < e\<close> \<open>a \<bullet> i < x \<bullet> i\<close> less_eq_real_def)
     then have "x \<bullet> i * 2 \<le> b \<bullet> i * 2 + min (x \<bullet> i - a \<bullet> i) e"
       using i mem_box(2) x by force
     ultimately show ?thesis
     using ab[of i] \<open>e>0\<close> x i 
       by (rule_tac x="- (min (x\<bullet>i - a\<bullet>i) e) / 2" in exI)
          (auto simp add: mem_box field_simps inner_simps inner_Basis)
   qed
 qed (use assms in auto)
 
 lemma frechet_derivative_unique_within_open_interval:
   fixes f::"'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes x: "x \<in> box a b"
     and f: "(f has_derivative f' ) (at x within box a b)" "(f has_derivative f'') (at x within box a b)"
   shows "f' = f''"
 proof -
   have "at x within box a b = at x"
     by (metis x at_within_interior interior_open open_box)
   with f show "f' = f''"
     by (simp add: has_derivative_unique)
 qed
 
 lemma frechet_derivative_at:
   "(f has_derivative f') (at x) \<Longrightarrow> f' = frechet_derivative f (at x)"
   using differentiable_def frechet_derivative_works has_derivative_unique by blast
 
 lemma frechet_derivative_compose:
   "frechet_derivative (f o g) (at x) = frechet_derivative (f) (at (g x)) o frechet_derivative g (at x)"
   if "g differentiable at x" "f differentiable at (g x)"
   by (metis diff_chain_at frechet_derivative_at frechet_derivative_works that)
 
 lemma frechet_derivative_within_cbox:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes "\<And>i. i\<in>Basis \<Longrightarrow> a\<bullet>i < b\<bullet>i"
     and "x \<in> cbox a b"
     and "(f has_derivative f') (at x within cbox a b)"
   shows "frechet_derivative f (at x within cbox a b) = f'"
   using assms
   by (metis Derivative.differentiableI frechet_derivative_unique_within_closed_interval frechet_derivative_works)
 
 lemma frechet_derivative_transform_within_open:
   "frechet_derivative f (at x) = frechet_derivative g (at x)"
   if "f differentiable at x" "open X" "x \<in> X" "\<And>x. x \<in> X \<Longrightarrow> f x = g x"
   by (meson frechet_derivative_at frechet_derivative_works has_derivative_transform_within_open that)
 
 
 subsection \<open>Derivatives of local minima and maxima are zero\<close>
 
 lemma has_derivative_local_min:
   fixes f :: "'a::real_normed_vector \<Rightarrow> real"
   assumes deriv: "(f has_derivative f') (at x)"
   assumes min: "eventually (\<lambda>y. f x \<le> f y) (at x)"
   shows "f' = (\<lambda>h. 0)"
 proof
   fix h :: 'a
   interpret f': bounded_linear f'
     using deriv by (rule has_derivative_bounded_linear)
   show "f' h = 0"
   proof (cases "h = 0")
     case False
     from min obtain d where d1: "0 < d" and d2: "\<forall>y\<in>ball x d. f x \<le> f y"
       unfolding eventually_at by (force simp: dist_commute)
     have "FDERIV (\<lambda>r. x + r *\<^sub>R h) 0 :> (\<lambda>r. r *\<^sub>R h)"
       by (intro derivative_eq_intros) auto
     then have "FDERIV (\<lambda>r. f (x + r *\<^sub>R h)) 0 :> (\<lambda>k. f' (k *\<^sub>R h))"
       by (rule has_derivative_compose, simp add: deriv)
     then have "DERIV (\<lambda>r. f (x + r *\<^sub>R h)) 0 :> f' h"
       unfolding has_field_derivative_def by (simp add: f'.scaleR mult_commute_abs)
     moreover have "0 < d / norm h" using d1 and \<open>h \<noteq> 0\<close> by simp
     moreover have "\<forall>y. \<bar>0 - y\<bar> < d / norm h \<longrightarrow> f (x + 0 *\<^sub>R h) \<le> f (x + y *\<^sub>R h)"
       using \<open>h \<noteq> 0\<close> by (auto simp add: d2 dist_norm pos_less_divide_eq)
     ultimately show "f' h = 0"
       by (rule DERIV_local_min)
   qed simp
 qed
 
 lemma has_derivative_local_max:
   fixes f :: "'a::real_normed_vector \<Rightarrow> real"
   assumes "(f has_derivative f') (at x)"
   assumes "eventually (\<lambda>y. f y \<le> f x) (at x)"
   shows "f' = (\<lambda>h. 0)"
   using has_derivative_local_min [of "\<lambda>x. - f x" "\<lambda>h. - f' h" "x"]
   using assms unfolding fun_eq_iff by simp
 
 lemma differential_zero_maxmin:
   fixes f::"'a::real_normed_vector \<Rightarrow> real"
   assumes "x \<in> S"
     and "open S"
     and deriv: "(f has_derivative f') (at x)"
     and mono: "(\<forall>y\<in>S. f y \<le> f x) \<or> (\<forall>y\<in>S. f x \<le> f y)"
   shows "f' = (\<lambda>v. 0)"
   using mono
 proof
   assume "\<forall>y\<in>S. f y \<le> f x"
   with \<open>x \<in> S\<close> and \<open>open S\<close> have "eventually (\<lambda>y. f y \<le> f x) (at x)"
     unfolding eventually_at_topological by auto
   with deriv show ?thesis
     by (rule has_derivative_local_max)
 next
   assume "\<forall>y\<in>S. f x \<le> f y"
   with \<open>x \<in> S\<close> and \<open>open S\<close> have "eventually (\<lambda>y. f x \<le> f y) (at x)"
     unfolding eventually_at_topological by auto
   with deriv show ?thesis
     by (rule has_derivative_local_min)
 qed
 
 lemma differential_zero_maxmin_component:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes k: "k \<in> Basis"
     and ball: "0 < e" "(\<forall>y \<in> ball x e. (f y)\<bullet>k \<le> (f x)\<bullet>k) \<or> (\<forall>y\<in>ball x e. (f x)\<bullet>k \<le> (f y)\<bullet>k)"
     and diff: "f differentiable (at x)"
   shows "(\<Sum>j\<in>Basis. (frechet_derivative f (at x) j \<bullet> k) *\<^sub>R j) = (0::'a)" (is "?D k = 0")
 proof -
   let ?f' = "frechet_derivative f (at x)"
   have "x \<in> ball x e" using \<open>0 < e\<close> by simp
   moreover have "open (ball x e)" by simp
   moreover have "((\<lambda>x. f x \<bullet> k) has_derivative (\<lambda>h. ?f' h \<bullet> k)) (at x)"
     using bounded_linear_inner_left diff[unfolded frechet_derivative_works]
     by (rule bounded_linear.has_derivative)
   ultimately have "(\<lambda>h. frechet_derivative f (at x) h \<bullet> k) = (\<lambda>v. 0)"
     using ball(2) by (rule differential_zero_maxmin)
   then show ?thesis
     unfolding fun_eq_iff by simp
 qed
 
 subsection \<open>One-dimensional mean value theorem\<close>
 
 lemma mvt_simple:
   fixes f :: "real \<Rightarrow> real"
   assumes "a < b"
     and derf: "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> (f has_derivative f' x) (at x within {a..b})"
   shows "\<exists>x\<in>{a<..<b}. f b - f a = f' x (b - a)"
 proof (rule mvt)
   have "f differentiable_on {a..b}"
     using derf unfolding differentiable_on_def differentiable_def by force
   then show "continuous_on {a..b} f"
     by (rule differentiable_imp_continuous_on)
   show "(f has_derivative f' x) (at x)" if "a < x" "x < b" for x
     by (metis at_within_Icc_at derf leI order.asym that)
 qed (use assms in auto)
 
 lemma mvt_very_simple:
   fixes f :: "real \<Rightarrow> real"
   assumes "a \<le> b"
     and derf: "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> (f has_derivative f' x) (at x within {a..b})"
   shows "\<exists>x\<in>{a..b}. f b - f a = f' x (b - a)"
 proof (cases "a = b")
   interpret bounded_linear "f' b"
     using assms(2) assms(1) by auto
   case True
   then show ?thesis
     by force
 next
   case False
   then show ?thesis
     using mvt_simple[OF _ derf]
     by (metis \<open>a \<le> b\<close> atLeastAtMost_iff dual_order.order_iff_strict greaterThanLessThan_iff)
 qed
 
 text \<open>A nice generalization (see Havin's proof of 5.19 from Rudin's book).\<close>
 
 lemma mvt_general:
   fixes f :: "real \<Rightarrow> 'a::real_inner"
   assumes "a < b"
     and contf: "continuous_on {a..b} f"
     and derf: "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> (f has_derivative f' x) (at x)"
   shows "\<exists>x\<in>{a<..<b}. norm (f b - f a) \<le> norm (f' x (b - a))"
 proof -
   have "\<exists>x\<in>{a<..<b}. (f b - f a) \<bullet> f b - (f b - f a) \<bullet> f a = (f b - f a) \<bullet> f' x (b - a)"
     apply (rule mvt [OF \<open>a < b\<close>, where f = "\<lambda>x. (f b - f a) \<bullet> f x"])
     apply (intro continuous_intros contf)
     using derf apply (auto intro: has_derivative_inner_right)
     done
   then obtain x where x: "x \<in> {a<..<b}"
     "(f b - f a) \<bullet> f b - (f b - f a) \<bullet> f a = (f b - f a) \<bullet> f' x (b - a)" ..
   show ?thesis
   proof (cases "f a = f b")
     case False
     have "norm (f b - f a) * norm (f b - f a) = (norm (f b - f a))\<^sup>2"
       by (simp add: power2_eq_square)
     also have "\<dots> = (f b - f a) \<bullet> (f b - f a)"
       unfolding power2_norm_eq_inner ..
     also have "\<dots> = (f b - f a) \<bullet> f' x (b - a)"
       using x(2) by (simp only: inner_diff_right)
     also have "\<dots> \<le> norm (f b - f a) * norm (f' x (b - a))"
       by (rule norm_cauchy_schwarz)
     finally show ?thesis
       using False x(1)
       by (auto simp add: mult_left_cancel)
   next
     case True
     then show ?thesis
       using \<open>a < b\<close> by (rule_tac x="(a + b) /2" in bexI) auto
   qed
 qed
 
 
 subsection \<open>More general bound theorems\<close>
 
 proposition differentiable_bound_general:
   fixes f :: "real \<Rightarrow> 'a::real_normed_vector"
   assumes "a < b"
     and f_cont: "continuous_on {a..b} f"
     and phi_cont: "continuous_on {a..b} \<phi>"
     and f': "\<And>x. a < x \<Longrightarrow> x < b \<Longrightarrow> (f has_vector_derivative f' x) (at x)"
     and phi': "\<And>x. a < x \<Longrightarrow> x < b \<Longrightarrow> (\<phi> has_vector_derivative \<phi>' x) (at x)"
     and bnd: "\<And>x. a < x \<Longrightarrow> x < b \<Longrightarrow> norm (f' x) \<le> \<phi>' x"
   shows "norm (f b - f a) \<le> \<phi> b - \<phi> a"
 proof -
   {
     fix x assume x: "a < x" "x < b"
     have "0 \<le> norm (f' x)" by simp
     also have "\<dots> \<le> \<phi>' x" using x by (auto intro!: bnd)
     finally have "0 \<le> \<phi>' x" .
   } note phi'_nonneg = this
   note f_tendsto = assms(2)[simplified continuous_on_def, rule_format]
   note phi_tendsto = assms(3)[simplified continuous_on_def, rule_format]
   {
     fix e::real assume "e > 0"
     define e2 where "e2 = e / 2"
     with \<open>e > 0\<close> have "e2 > 0" by simp
     let ?le = "\<lambda>x1. norm (f x1 - f a) \<le> \<phi> x1 - \<phi> a + e * (x1 - a) + e"
     define A where "A = {x2. a \<le> x2 \<and> x2 \<le> b \<and> (\<forall>x1\<in>{a ..< x2}. ?le x1)}"
     have A_subset: "A \<subseteq> {a..b}" by (auto simp: A_def)
     {
       fix x2
       assume a: "a \<le> x2" "x2 \<le> b" and le: "\<forall>x1\<in>{a..<x2}. ?le x1"
       have "?le x2" using \<open>e > 0\<close>
       proof cases
         assume "x2 \<noteq> a" with a have "a < x2" by simp
         have "at x2 within {a <..<x2}\<noteq> bot"
           using \<open>a < x2\<close>
           by (auto simp: trivial_limit_within islimpt_in_closure)
         moreover
         have "((\<lambda>x1. (\<phi> x1 - \<phi> a) + e * (x1 - a) + e) \<longlongrightarrow> (\<phi> x2 - \<phi> a) + e * (x2 - a) + e) (at x2 within {a <..<x2})"
           "((\<lambda>x1. norm (f x1 - f a)) \<longlongrightarrow> norm (f x2 - f a)) (at x2 within {a <..<x2})"
           using a
           by (auto intro!: tendsto_eq_intros f_tendsto phi_tendsto
             intro: tendsto_within_subset[where S="{a..b}"])
         moreover
         have "eventually (\<lambda>x. x > a) (at x2 within {a <..<x2})"
           by (auto simp: eventually_at_filter)
         hence "eventually ?le (at x2 within {a <..<x2})"
           unfolding eventually_at_filter
           by eventually_elim (insert le, auto)
         ultimately
         show ?thesis
           by (rule tendsto_le)
       qed simp
     } note le_cont = this
     have "a \<in> A"
       using assms by (auto simp: A_def)
     hence [simp]: "A \<noteq> {}" by auto
     have A_ivl: "\<And>x1 x2. x2 \<in> A \<Longrightarrow> x1 \<in> {a ..x2} \<Longrightarrow> x1 \<in> A"
       by (simp add: A_def)
     have [simp]: "bdd_above A" by (auto simp: A_def)
     define y where "y = Sup A"
     have "y \<le> b"
       unfolding y_def
       by (simp add: cSup_le_iff) (simp add: A_def)
      have leI: "\<And>x x1. a \<le> x1 \<Longrightarrow> x \<in> A \<Longrightarrow> x1 < x \<Longrightarrow> ?le x1"
        by (auto simp: A_def intro!: le_cont)
     have y_all_le: "\<forall>x1\<in>{a..<y}. ?le x1"
       by (auto simp: y_def less_cSup_iff leI)
     have "a \<le> y"
       by (metis \<open>a \<in> A\<close> \<open>bdd_above A\<close> cSup_upper y_def)
     have "y \<in> A"
       using y_all_le \<open>a \<le> y\<close> \<open>y \<le> b\<close>
       by (auto simp: A_def)
     hence "A = {a .. y}"
       using A_subset by (auto simp: subset_iff y_def cSup_upper intro: A_ivl)
     from le_cont[OF \<open>a \<le> y\<close> \<open>y \<le> b\<close> y_all_le] have le_y: "?le y" .
     have "y = b"
     proof (cases "a = y")
       case True
       with \<open>a < b\<close> have "y < b" by simp
       with \<open>a = y\<close> f_cont phi_cont \<open>e2 > 0\<close>
       have 1: "\<forall>\<^sub>F x in at y within {y..b}. dist (f x) (f y) < e2"
        and 2: "\<forall>\<^sub>F x in at y within {y..b}. dist (\<phi> x) (\<phi> y) < e2"
         by (auto simp: continuous_on_def tendsto_iff)
       have 3: "eventually (\<lambda>x. y < x) (at y within {y..b})"
         by (auto simp: eventually_at_filter)
       have 4: "eventually (\<lambda>x::real. x < b) (at y within {y..b})"
         using _ \<open>y < b\<close>
         by (rule order_tendstoD) (auto intro!: tendsto_eq_intros)
       from 1 2 3 4
       have eventually_le: "eventually (\<lambda>x. ?le x) (at y within {y .. b})"
       proof eventually_elim
         case (elim x1)
         have "norm (f x1 - f a) = norm (f x1 - f y)"
           by (simp add: \<open>a = y\<close>)
         also have "norm (f x1 - f y) \<le> e2"
           using elim \<open>a = y\<close> by (auto simp : dist_norm intro!:  less_imp_le)
         also have "\<dots> \<le> e2 + (\<phi> x1 - \<phi> a + e2 + e * (x1 - a))"
           using \<open>0 < e\<close> elim
           by (intro add_increasing2[OF add_nonneg_nonneg order.refl])
             (auto simp: \<open>a = y\<close> dist_norm intro!: mult_nonneg_nonneg)
         also have "\<dots> = \<phi> x1 - \<phi> a + e * (x1 - a) + e"
           by (simp add: e2_def)
         finally show "?le x1" .
       qed
       from this[unfolded eventually_at_topological] \<open>?le y\<close>
       obtain S where S: "open S" "y \<in> S" "\<And>x. x\<in>S \<Longrightarrow> x \<in> {y..b} \<Longrightarrow> ?le x"
         by metis
       from \<open>open S\<close> obtain d where d: "\<And>x. dist x y < d \<Longrightarrow> x \<in> S" "d > 0"
         by (force simp: dist_commute open_dist ball_def dest!: bspec[OF _ \<open>y \<in> S\<close>])
       define d' where "d' = min b (y + (d/2))"
       have "d' \<in> A"
         unfolding A_def
       proof safe
         show "a \<le> d'" using \<open>a = y\<close> \<open>0 < d\<close> \<open>y < b\<close> by (simp add: d'_def)
         show "d' \<le> b" by (simp add: d'_def)
         fix x1
         assume "x1 \<in> {a..<d'}"
         hence "x1 \<in> S" "x1 \<in> {y..b}"
           by (auto simp: \<open>a = y\<close> d'_def dist_real_def intro!: d )
         thus "?le x1"
           by (rule S)
       qed
       hence "d' \<le> y"
         unfolding y_def
         by (rule cSup_upper) simp
       then show "y = b" using \<open>d > 0\<close> \<open>y < b\<close>
         by (simp add: d'_def)
     next
       case False
       with \<open>a \<le> y\<close> have "a < y" by simp
       show "y = b"
       proof (rule ccontr)
         assume "y \<noteq> b"
         hence "y < b" using \<open>y \<le> b\<close> by simp
         let ?F = "at y within {y..<b}"
         from f' phi'
         have "(f has_vector_derivative f' y) ?F"
           and "(\<phi> has_vector_derivative \<phi>' y) ?F"
           using \<open>a < y\<close> \<open>y < b\<close>
           by (auto simp add: at_within_open[of _ "{a<..<b}"] has_vector_derivative_def
             intro!: has_derivative_subset[where s="{a<..<b}" and t="{y..<b}"])
         hence "\<forall>\<^sub>F x1 in ?F. norm (f x1 - f y - (x1 - y) *\<^sub>R f' y) \<le> e2 * \<bar>x1 - y\<bar>"
             "\<forall>\<^sub>F x1 in ?F. norm (\<phi> x1 - \<phi> y - (x1 - y) *\<^sub>R \<phi>' y) \<le> e2 * \<bar>x1 - y\<bar>"
           using \<open>e2 > 0\<close>
           by (auto simp: has_derivative_within_alt2 has_vector_derivative_def)
         moreover
         have "\<forall>\<^sub>F x1 in ?F. y \<le> x1" "\<forall>\<^sub>F x1 in ?F. x1 < b"
           by (auto simp: eventually_at_filter)
         ultimately
         have "\<forall>\<^sub>F x1 in ?F. norm (f x1 - f y) \<le> (\<phi> x1 - \<phi> y) + e * \<bar>x1 - y\<bar>"
           (is "\<forall>\<^sub>F x1 in ?F. ?le' x1")
         proof eventually_elim
           case (elim x1)
           from norm_triangle_ineq2[THEN order_trans, OF elim(1)]
           have "norm (f x1 - f y) \<le> norm (f' y) * \<bar>x1 - y\<bar> + e2 * \<bar>x1 - y\<bar>"
             by (simp add: ac_simps)
           also have "norm (f' y) \<le> \<phi>' y" using bnd \<open>a < y\<close> \<open>y < b\<close> by simp
           also have "\<phi>' y * \<bar>x1 - y\<bar> \<le> \<phi> x1 - \<phi> y + e2 * \<bar>x1 - y\<bar>"
             using elim by (simp add: ac_simps)
           finally
           have "norm (f x1 - f y) \<le> \<phi> x1 - \<phi> y + e2 * \<bar>x1 - y\<bar> + e2 * \<bar>x1 - y\<bar>"
             by (auto simp: mult_right_mono)
           thus ?case by (simp add: e2_def)
         qed
         moreover have "?le' y" by simp
         ultimately obtain S
         where S: "open S" "y \<in> S" "\<And>x. x\<in>S \<Longrightarrow> x \<in> {y..<b} \<Longrightarrow> ?le' x"
           unfolding eventually_at_topological
           by metis
         from \<open>open S\<close> obtain d where d: "\<And>x. dist x y < d \<Longrightarrow> x \<in> S" "d > 0"
           by (force simp: dist_commute open_dist ball_def dest!: bspec[OF _ \<open>y \<in> S\<close>])
         define d' where "d' = min ((y + b)/2) (y + (d/2))"
         have "d' \<in> A"
           unfolding A_def
         proof safe
           show "a \<le> d'" using \<open>a < y\<close> \<open>0 < d\<close> \<open>y < b\<close> by (simp add: d'_def)
           show "d' \<le> b" using \<open>y < b\<close> by (simp add: d'_def min_def)
           fix x1
           assume x1: "x1 \<in> {a..<d'}"
           show "?le x1"
           proof (cases "x1 < y")
             case True
             then show ?thesis
               using \<open>y \<in> A\<close> local.leI x1 by auto
           next
             case False
             hence x1': "x1 \<in> S" "x1 \<in> {y..<b}" using x1
               by (auto simp: d'_def dist_real_def intro!: d)
             have "norm (f x1 - f a) \<le> norm (f x1 - f y) + norm (f y - f a)"
               by (rule order_trans[OF _ norm_triangle_ineq]) simp
             also note S(3)[OF x1']
             also note le_y
             finally show "?le x1"
               using False by (auto simp: algebra_simps)
           qed
         qed
         hence "d' \<le> y"
           unfolding y_def by (rule cSup_upper) simp
         thus False using \<open>d > 0\<close> \<open>y < b\<close>
           by (simp add: d'_def min_def split: if_split_asm)
       qed
     qed
     with le_y have "norm (f b - f a) \<le> \<phi> b - \<phi> a + e * (b - a + 1)"
       by (simp add: algebra_simps)
   } note * = this
   show ?thesis
   proof (rule field_le_epsilon)
     fix e::real assume "e > 0"
     then show "norm (f b - f a) \<le> \<phi> b - \<phi> a + e"
       using *[of "e / (b - a + 1)"] \<open>a < b\<close> by simp
   qed
 qed
 
 lemma differentiable_bound:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "convex S"
     and derf: "\<And>x. x\<in>S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
     and B: "\<And>x. x \<in> S \<Longrightarrow> onorm (f' x) \<le> B"
     and x: "x \<in> S"
     and y: "y \<in> S"
   shows "norm (f x - f y) \<le> B * norm (x - y)"
 proof -
   let ?p = "\<lambda>u. x + u *\<^sub>R (y - x)"
   let ?\<phi> = "\<lambda>h. h * B * norm (x - y)"
   have *: "x + u *\<^sub>R (y - x) \<in> S" if "u \<in> {0..1}" for u
   proof -
     have "u *\<^sub>R y = u *\<^sub>R (y - x) + u *\<^sub>R x"
       by (simp add: scale_right_diff_distrib)
     then show "x + u *\<^sub>R (y - x) \<in> S"
       using that \<open>convex S\<close> x y by (simp add: convex_alt)
         (metis pth_b(2) pth_c(1) scaleR_collapse)
   qed
   have "\<And>z. z \<in> (\<lambda>u. x + u *\<^sub>R (y - x)) ` {0..1} \<Longrightarrow>
           (f has_derivative f' z) (at z within (\<lambda>u. x + u *\<^sub>R (y - x)) ` {0..1})"
     by (auto intro: * has_derivative_within_subset [OF derf])
   then have "continuous_on (?p ` {0..1}) f"
     unfolding continuous_on_eq_continuous_within
     by (meson has_derivative_continuous)
   with * have 1: "continuous_on {0 .. 1} (f \<circ> ?p)"
     by (intro continuous_intros)+
   {
     fix u::real assume u: "u \<in>{0 <..< 1}"
     let ?u = "?p u"
     interpret linear "(f' ?u)"
       using u by (auto intro!: has_derivative_linear derf *)
     have "(f \<circ> ?p has_derivative (f' ?u) \<circ> (\<lambda>u. 0 + u *\<^sub>R (y - x))) (at u within box 0 1)"
       by (intro derivative_intros has_derivative_within_subset [OF derf]) (use u * in auto)
     hence "((f \<circ> ?p) has_vector_derivative f' ?u (y - x)) (at u)"
       by (simp add: at_within_open[OF u open_greaterThanLessThan] scaleR has_vector_derivative_def o_def)
   } note 2 = this
   have 3: "continuous_on {0..1} ?\<phi>"
     by (rule continuous_intros)+
   have 4: "(?\<phi> has_vector_derivative B * norm (x - y)) (at u)" for u
     by (auto simp: has_vector_derivative_def intro!: derivative_eq_intros)
   {
     fix u::real assume u: "u \<in>{0 <..< 1}"
     let ?u = "?p u"
     interpret bounded_linear "(f' ?u)"
       using u by (auto intro!: has_derivative_bounded_linear derf *)
     have "norm (f' ?u (y - x)) \<le> onorm (f' ?u) * norm (y - x)"
       by (rule onorm) (rule bounded_linear)
     also have "onorm (f' ?u) \<le> B"
       using u by (auto intro!: assms(3)[rule_format] *)
     finally have "norm ((f' ?u) (y - x)) \<le> B * norm (x - y)"
       by (simp add: mult_right_mono norm_minus_commute)
   } note 5 = this
   have "norm (f x - f y) = norm ((f \<circ> (\<lambda>u. x + u *\<^sub>R (y - x))) 1 - (f \<circ> (\<lambda>u. x + u *\<^sub>R (y - x))) 0)"
     by (auto simp add: norm_minus_commute)
   also
   from differentiable_bound_general[OF zero_less_one 1, OF 3 2 4 5]
   have "norm ((f \<circ> ?p) 1 - (f \<circ> ?p) 0) \<le> B * norm (x - y)"
     by simp
   finally show ?thesis .
 qed
 
 lemma
   differentiable_bound_segment:
   fixes f::"'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "\<And>t. t \<in> {0..1} \<Longrightarrow> x0 + t *\<^sub>R a \<in> G"
   assumes f': "\<And>x. x \<in> G \<Longrightarrow> (f has_derivative f' x) (at x within G)"
   assumes B: "\<And>x. x \<in> {0..1} \<Longrightarrow> onorm (f' (x0 + x *\<^sub>R a)) \<le> B"
   shows "norm (f (x0 + a) - f x0) \<le> norm a * B"
 proof -
   let ?G = "(\<lambda>x. x0 + x *\<^sub>R a) ` {0..1}"
   have "?G = (+) x0 ` (\<lambda>x. x *\<^sub>R a) ` {0..1}" by auto
   also have "convex \<dots>"
     by (intro convex_translation convex_scaled convex_real_interval)
   finally have "convex ?G" .
   moreover have "?G \<subseteq> G" "x0 \<in> ?G" "x0 + a \<in> ?G" using assms by (auto intro: image_eqI[where x=1])
   ultimately show ?thesis
     using has_derivative_subset[OF f' \<open>?G \<subseteq> G\<close>] B
       differentiable_bound[of "(\<lambda>x. x0 + x *\<^sub>R a) ` {0..1}" f f' B "x0 + a" x0]
     by (force simp: ac_simps)
 qed
 
 lemma differentiable_bound_linearization:
   fixes f::"'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes S: "\<And>t. t \<in> {0..1} \<Longrightarrow> a + t *\<^sub>R (b - a) \<in> S"
   assumes f'[derivative_intros]: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
   assumes B: "\<And>x. x \<in> S \<Longrightarrow> onorm (f' x - f' x0) \<le> B"
   assumes "x0 \<in> S"
   shows "norm (f b - f a - f' x0 (b - a)) \<le> norm (b - a) * B"
 proof -
   define g where [abs_def]: "g x = f x - f' x0 x" for x
   have g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative (\<lambda>i. f' x i - f' x0 i)) (at x within S)"
     unfolding g_def using assms
     by (auto intro!: derivative_eq_intros
       bounded_linear.has_derivative[OF has_derivative_bounded_linear, OF f'])
   from B have "\<forall>x\<in>{0..1}. onorm (\<lambda>i. f' (a + x *\<^sub>R (b - a)) i - f' x0 i) \<le> B"
     using assms by (auto simp: fun_diff_def)
   with differentiable_bound_segment[OF S g] \<open>x0 \<in> S\<close>
   show ?thesis
     by (simp add: g_def field_simps linear_diff[OF has_derivative_linear[OF f']])
 qed
 
 lemma vector_differentiable_bound_linearization:
   fixes f::"real \<Rightarrow> 'b::real_normed_vector"
   assumes f': "\<And>x. x \<in> S \<Longrightarrow> (f has_vector_derivative f' x) (at x within S)"
   assumes "closed_segment a b \<subseteq> S"
   assumes B: "\<And>x. x \<in> S \<Longrightarrow> norm (f' x - f' x0) \<le> B"
   assumes "x0 \<in> S"
   shows "norm (f b - f a - (b - a) *\<^sub>R f' x0) \<le> norm (b - a) * B"
   using assms
   by (intro differentiable_bound_linearization[of a b S f "\<lambda>x h. h *\<^sub>R f' x" x0 B])
     (force simp: closed_segment_real_eq has_vector_derivative_def
       scaleR_diff_right[symmetric] mult.commute[of B]
       intro!: onorm_le mult_left_mono)+
 
 
 text \<open>In particular.\<close>
 
 lemma has_derivative_zero_constant:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "convex s"
     and "\<And>x. x \<in> s \<Longrightarrow> (f has_derivative (\<lambda>h. 0)) (at x within s)"
   shows "\<exists>c. \<forall>x\<in>s. f x = c"
 proof -
   { fix x y assume "x \<in> s" "y \<in> s"
     then have "norm (f x - f y) \<le> 0 * norm (x - y)"
       using assms by (intro differentiable_bound[of s]) (auto simp: onorm_zero)
     then have "f x = f y"
       by simp }
   then show ?thesis
     by metis
 qed
 
 lemma has_field_derivative_zero_constant:
   assumes "convex s" "\<And>x. x \<in> s \<Longrightarrow> (f has_field_derivative 0) (at x within s)"
   shows   "\<exists>c. \<forall>x\<in>s. f (x) = (c :: 'a :: real_normed_field)"
 proof (rule has_derivative_zero_constant)
   have A: "(*) 0 = (\<lambda>_. 0 :: 'a)" by (intro ext) simp
   fix x assume "x \<in> s" thus "(f has_derivative (\<lambda>h. 0)) (at x within s)"
     using assms(2)[of x] by (simp add: has_field_derivative_def A)
 qed fact
 
 lemma
   has_vector_derivative_zero_constant:
   assumes "convex s"
   assumes "\<And>x. x \<in> s \<Longrightarrow> (f has_vector_derivative 0) (at x within s)"
   obtains c where "\<And>x. x \<in> s \<Longrightarrow> f x = c"
   using has_derivative_zero_constant[of s f] assms
   by (auto simp: has_vector_derivative_def)
 
 lemma has_derivative_zero_unique:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "convex s"
     and "\<And>x. x \<in> s \<Longrightarrow> (f has_derivative (\<lambda>h. 0)) (at x within s)"
     and "x \<in> s" "y \<in> s"
   shows "f x = f y"
   using has_derivative_zero_constant[OF assms(1,2)] assms(3-) by force
 
 lemma has_derivative_zero_unique_connected:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "open s" "connected s"
   assumes f: "\<And>x. x \<in> s \<Longrightarrow> (f has_derivative (\<lambda>x. 0)) (at x)"
   assumes "x \<in> s" "y \<in> s"
   shows "f x = f y"
 proof (rule connected_local_const[where f=f, OF \<open>connected s\<close> \<open>x\<in>s\<close> \<open>y\<in>s\<close>])
   show "\<forall>a\<in>s. eventually (\<lambda>b. f a = f b) (at a within s)"
   proof
     fix a assume "a \<in> s"
     with \<open>open s\<close> obtain e where "0 < e" "ball a e \<subseteq> s"
       by (rule openE)
     then have "\<exists>c. \<forall>x\<in>ball a e. f x = c"
       by (intro has_derivative_zero_constant)
          (auto simp: at_within_open[OF _ open_ball] f convex_ball)
     with \<open>0<e\<close> have "\<forall>x\<in>ball a e. f a = f x"
       by auto
     then show "eventually (\<lambda>b. f a = f b) (at a within s)"
       using \<open>0<e\<close> unfolding eventually_at_topological
       by (intro exI[of _ "ball a e"]) auto
   qed
 qed
 
 subsection \<open>Differentiability of inverse function (most basic form)\<close>
 
 lemma has_derivative_inverse_basic:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes derf: "(f has_derivative f') (at (g y))"
     and ling': "bounded_linear g'"
     and "g' \<circ> f' = id"
     and contg: "continuous (at y) g"
     and "open T"
     and "y \<in> T"
     and fg: "\<And>z. z \<in> T \<Longrightarrow> f (g z) = z"
   shows "(g has_derivative g') (at y)"
 proof -
   interpret f': bounded_linear f'
     using assms unfolding has_derivative_def by auto
   interpret g': bounded_linear g'
     using assms by auto
   obtain C where C: "0 < C" "\<And>x. norm (g' x) \<le> norm x * C"
     using bounded_linear.pos_bounded[OF assms(2)] by blast
   have lem1: "\<forall>e>0. \<exists>d>0. \<forall>z.
     norm (z - y) < d \<longrightarrow> norm (g z - g y - g'(z - y)) \<le> e * norm (g z - g y)"
   proof (intro allI impI)
     fix e :: real
     assume "e > 0"
     with C(1) have *: "e / C > 0" by auto
     obtain d0 where  "0 < d0" and d0:
         "\<And>u. norm (u - g y) < d0 \<Longrightarrow> norm (f u - f (g y) - f' (u - g y)) \<le> e / C * norm (u - g y)"
       using derf * unfolding has_derivative_at_alt by blast
     obtain d1 where "0 < d1" and d1: "\<And>x. \<lbrakk>0 < dist x y; dist x y < d1\<rbrakk> \<Longrightarrow> dist (g x) (g y) < d0"
       using contg \<open>0 < d0\<close> unfolding continuous_at Lim_at by blast
     obtain d2 where "0 < d2" and d2: "\<And>u. dist u y < d2 \<Longrightarrow> u \<in> T"
       using \<open>open T\<close> \<open>y \<in> T\<close> unfolding open_dist by blast
     obtain d where d: "0 < d" "d < d1" "d < d2"
       using field_lbound_gt_zero[OF \<open>0 < d1\<close> \<open>0 < d2\<close>] by blast
     show "\<exists>d>0. \<forall>z. norm (z - y) < d \<longrightarrow> norm (g z - g y - g' (z - y)) \<le> e * norm (g z - g y)"
     proof (intro exI allI impI conjI)
       fix z
       assume as: "norm (z - y) < d"
       then have "z \<in> T"
         using d2 d unfolding dist_norm by auto
       have "norm (g z - g y - g' (z - y)) \<le> norm (g' (f (g z) - y - f' (g z - g y)))"
         unfolding g'.diff f'.diff
         unfolding assms(3)[unfolded o_def id_def, THEN fun_cong] fg[OF \<open>z\<in>T\<close>]
         by (simp add: norm_minus_commute)
       also have "\<dots> \<le> norm (f (g z) - y - f' (g z - g y)) * C"
         by (rule C(2))
       also have "\<dots> \<le> (e / C) * norm (g z - g y) * C"
       proof -
         have "norm (g z - g y) < d0"
           by (metis as cancel_comm_monoid_add_class.diff_cancel d(2) \<open>0 < d0\<close> d1 diff_gt_0_iff_gt diff_strict_mono dist_norm dist_self zero_less_dist_iff)
         then show ?thesis
           by (metis C(1) \<open>y \<in> T\<close> d0 fg real_mult_le_cancel_iff1)
       qed
       also have "\<dots> \<le> e * norm (g z - g y)"
         using C by (auto simp add: field_simps)
       finally show "norm (g z - g y - g' (z - y)) \<le> e * norm (g z - g y)"
         by simp
     qed (use d in auto)
   qed
   have *: "(0::real) < 1 / 2"
     by auto
   obtain d where "0 < d" and d:
       "\<And>z. norm (z - y) < d \<Longrightarrow> norm (g z - g y - g' (z - y)) \<le> 1/2 * norm (g z - g y)"
     using lem1 * by blast
   define B where "B = C * 2"
   have "B > 0"
     unfolding B_def using C by auto
   have lem2: "norm (g z - g y) \<le> B * norm (z - y)" if z: "norm(z - y) < d" for z
   proof -
     have "norm (g z - g y) \<le> norm(g' (z - y)) + norm ((g z - g y) - g'(z - y))"
       by (rule norm_triangle_sub)
     also have "\<dots> \<le> norm (g' (z - y)) + 1 / 2 * norm (g z - g y)"
       by (rule add_left_mono) (use d z in auto)
     also have "\<dots> \<le> norm (z - y) * C + 1 / 2 * norm (g z - g y)"
       by (rule add_right_mono) (use C in auto)
     finally show "norm (g z - g y) \<le> B * norm (z - y)"
       unfolding B_def
       by (auto simp add: field_simps)
   qed
   show ?thesis
     unfolding has_derivative_at_alt
   proof (intro conjI assms allI impI)
     fix e :: real
     assume "e > 0"
     then have *: "e / B > 0" by (metis \<open>B > 0\<close> divide_pos_pos)
     obtain d' where "0 < d'" and d':
         "\<And>z. norm (z - y) < d' \<Longrightarrow> norm (g z - g y - g' (z - y)) \<le> e / B * norm (g z - g y)"
       using lem1 * by blast
     obtain k where k: "0 < k" "k < d" "k < d'"
       using field_lbound_gt_zero[OF \<open>0 < d\<close> \<open>0 < d'\<close>] by blast
     show "\<exists>d>0. \<forall>ya. norm (ya - y) < d \<longrightarrow> norm (g ya - g y - g' (ya - y)) \<le> e * norm (ya - y)"
     proof (intro exI allI impI conjI)
       fix z
       assume as: "norm (z - y) < k"
       then have "norm (g z - g y - g' (z - y)) \<le> e / B * norm(g z - g y)"
         using d' k by auto
       also have "\<dots> \<le> e * norm (z - y)"
         unfolding times_divide_eq_left pos_divide_le_eq[OF \<open>B>0\<close>]
         using lem2[of z] k as \<open>e > 0\<close>
         by (auto simp add: field_simps)
       finally show "norm (g z - g y - g' (z - y)) \<le> e * norm (z - y)"
         by simp
     qed (use k in auto)
   qed
 qed
 
 text \<open>Simply rewrite that based on the domain point x.\<close>
 
 lemma has_derivative_inverse_basic_x:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "(f has_derivative f') (at x)"
     and "bounded_linear g'"
     and "g' \<circ> f' = id"
     and "continuous (at (f x)) g"
     and "g (f x) = x"
     and "open T"
     and "f x \<in> T"
     and "\<And>y. y \<in> T \<Longrightarrow> f (g y) = y"
   shows "(g has_derivative g') (at (f x))"
   by (rule has_derivative_inverse_basic) (use assms in auto)
 
 text \<open>This is the version in Dieudonne', assuming continuity of f and g.\<close>
 
 lemma has_derivative_inverse_dieudonne:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "open S"
     and "open (f ` S)"
     and "continuous_on S f"
     and "continuous_on (f ` S) g"
     and "\<And>x. x \<in> S \<Longrightarrow> g (f x) = x"
     and "x \<in> S"
     and "(f has_derivative f') (at x)"
     and "bounded_linear g'"
     and "g' \<circ> f' = id"
   shows "(g has_derivative g') (at (f x))"
   apply (rule has_derivative_inverse_basic_x[OF assms(7-9) _ _ assms(2)])
   using assms(3-6)
   unfolding continuous_on_eq_continuous_at[OF assms(1)] continuous_on_eq_continuous_at[OF assms(2)]
   apply auto
   done
 
 text \<open>Here's the simplest way of not assuming much about g.\<close>
 
 proposition has_derivative_inverse:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "compact S"
     and "x \<in> S"
     and fx: "f x \<in> interior (f ` S)"
     and "continuous_on S f"
     and gf: "\<And>y. y \<in> S \<Longrightarrow> g (f y) = y"
     and "(f has_derivative f') (at x)"
     and "bounded_linear g'"
     and "g' \<circ> f' = id"
   shows "(g has_derivative g') (at (f x))"
 proof -
   have *: "\<And>y. y \<in> interior (f ` S) \<Longrightarrow> f (g y) = y"
     by (metis gf image_iff interior_subset subsetCE)
   show ?thesis
     apply (rule has_derivative_inverse_basic_x[OF assms(6-8), where T = "interior (f ` S)"])
     apply (rule continuous_on_interior[OF _ fx])
     apply (rule continuous_on_inv)
     apply (simp_all add: assms *)
     done
 qed
 
 
 text \<open>Invertible derivative continuous at a point implies local
 injectivity. It's only for this we need continuity of the derivative,
 except of course if we want the fact that the inverse derivative is
 also continuous. So if we know for some other reason that the inverse
 function exists, it's OK.\<close>
 
 proposition has_derivative_locally_injective:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes "a \<in> S"
       and "open S"
       and bling: "bounded_linear g'"
       and "g' \<circ> f' a = id"
       and derf: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x)"
       and "\<And>e. e > 0 \<Longrightarrow> \<exists>d>0. \<forall>x. dist a x < d \<longrightarrow> onorm (\<lambda>v. f' x v - f' a v) < e"
   obtains r where "r > 0" "ball a r \<subseteq> S" "inj_on f (ball a r)"
 proof -
   interpret bounded_linear g'
     using assms by auto
   note f'g' = assms(4)[unfolded id_def o_def,THEN cong]
   have "g' (f' a (\<Sum>Basis)) = (\<Sum>Basis)" "(\<Sum>Basis) \<noteq> (0::'n)"
     using f'g' by auto
   then have *: "0 < onorm g'"
     unfolding onorm_pos_lt[OF assms(3)]
     by fastforce
   define k where "k = 1 / onorm g' / 2"
   have *: "k > 0"
     unfolding k_def using * by auto
   obtain d1 where d1:
       "0 < d1"
       "\<And>x. dist a x < d1 \<Longrightarrow> onorm (\<lambda>v. f' x v - f' a v) < k"
     using assms(6) * by blast
   from \<open>open S\<close> obtain d2 where "d2 > 0" "ball a d2 \<subseteq> S"
     using \<open>a\<in>S\<close> ..
   obtain d2 where d2: "0 < d2" "ball a d2 \<subseteq> S"
     using \<open>0 < d2\<close> \<open>ball a d2 \<subseteq> S\<close> by blast
   obtain d where d: "0 < d" "d < d1" "d < d2"
     using field_lbound_gt_zero[OF d1(1) d2(1)] by blast
   show ?thesis
   proof
     show "0 < d" by (fact d)
     show "ball a d \<subseteq> S"
       using \<open>d < d2\<close> \<open>ball a d2 \<subseteq> S\<close> by auto
     show "inj_on f (ball a d)"
     unfolding inj_on_def
     proof (intro strip)
       fix x y
       assume as: "x \<in> ball a d" "y \<in> ball a d" "f x = f y"
       define ph where [abs_def]: "ph w = w - g' (f w - f x)" for w
       have ph':"ph = g' \<circ> (\<lambda>w. f' a w - (f w - f x))"
         unfolding ph_def o_def  by (simp add: diff f'g')
       have "norm (ph x - ph y) \<le> (1 / 2) * norm (x - y)"
       proof (rule differentiable_bound[OF convex_ball _ _ as(1-2)])
         fix u
         assume u: "u \<in> ball a d"
         then have "u \<in> S"
           using d d2 by auto
         have *: "(\<lambda>v. v - g' (f' u v)) = g' \<circ> (\<lambda>w. f' a w - f' u w)"
           unfolding o_def and diff
           using f'g' by auto
         have blin: "bounded_linear (f' a)"
           using \<open>a \<in> S\<close> derf by blast
         show "(ph has_derivative (\<lambda>v. v - g' (f' u v))) (at u within ball a d)"
           unfolding ph' * comp_def
           by (rule \<open>u \<in> S\<close> derivative_eq_intros has_derivative_at_withinI [OF derf] bounded_linear.has_derivative [OF blin]  bounded_linear.has_derivative [OF bling] |simp)+
         have **: "bounded_linear (\<lambda>x. f' u x - f' a x)" "bounded_linear (\<lambda>x. f' a x - f' u x)"
           using \<open>u \<in> S\<close> blin bounded_linear_sub derf by auto
         then have "onorm (\<lambda>v. v - g' (f' u v)) \<le> onorm g' * onorm (\<lambda>w. f' a w - f' u w)"
           by (simp add: "*" bounded_linear_axioms onorm_compose)
         also have "\<dots> \<le> onorm g' * k"
           apply (rule mult_left_mono)
           using d1(2)[of u]
           using onorm_neg[where f="\<lambda>x. f' u x - f' a x"] d u onorm_pos_le[OF bling] apply (auto simp: algebra_simps)
           done
         also have "\<dots> \<le> 1 / 2"
           unfolding k_def by auto
         finally show "onorm (\<lambda>v. v - g' (f' u v)) \<le> 1 / 2" .
       qed
       moreover have "norm (ph y - ph x) = norm (y - x)"
         by (simp add: as(3) ph_def)
       ultimately show "x = y"
         unfolding norm_minus_commute by auto
     qed
   qed
 qed
 
 
 subsection \<open>Uniformly convergent sequence of derivatives\<close>
 
 lemma has_derivative_sequence_lipschitz_lemma:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "convex S"
     and derf: "\<And>n x. x \<in> S \<Longrightarrow> ((f n) has_derivative (f' n x)) (at x within S)"
     and nle: "\<And>n x h. \<lbrakk>n\<ge>N; x \<in> S\<rbrakk> \<Longrightarrow> norm (f' n x h - g' x h) \<le> e * norm h"
     and "0 \<le> e"
   shows "\<forall>m\<ge>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S. norm ((f m x - f n x) - (f m y - f n y)) \<le> 2 * e * norm (x - y)"
 proof clarify
   fix m n x y
   assume as: "N \<le> m" "N \<le> n" "x \<in> S" "y \<in> S"
   show "norm ((f m x - f n x) - (f m y - f n y)) \<le> 2 * e * norm (x - y)"
   proof (rule differentiable_bound[where f'="\<lambda>x h. f' m x h - f' n x h", OF \<open>convex S\<close> _ _ as(3-4)])
     fix x
     assume "x \<in> S"
     show "((\<lambda>a. f m a - f n a) has_derivative (\<lambda>h. f' m x h - f' n x h)) (at x within S)"
       by (rule derivative_intros derf \<open>x\<in>S\<close>)+
     show "onorm (\<lambda>h. f' m x h - f' n x h) \<le> 2 * e"
     proof (rule onorm_bound)
       fix h
       have "norm (f' m x h - f' n x h) \<le> norm (f' m x h - g' x h) + norm (f' n x h - g' x h)"
         using norm_triangle_ineq[of "f' m x h - g' x h" "- f' n x h + g' x h"]
         by (auto simp add: algebra_simps norm_minus_commute)
       also have "\<dots> \<le> e * norm h + e * norm h"
         using nle[OF \<open>N \<le> m\<close> \<open>x \<in> S\<close>, of h] nle[OF \<open>N \<le> n\<close> \<open>x \<in> S\<close>, of h]
         by (auto simp add: field_simps)
       finally show "norm (f' m x h - f' n x h) \<le> 2 * e * norm h"
         by auto
     qed (simp add: \<open>0 \<le> e\<close>)
   qed
 qed
 
 lemma has_derivative_sequence_Lipschitz:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "convex S"
     and "\<And>n x. x \<in> S \<Longrightarrow> ((f n) has_derivative (f' n x)) (at x within S)"
     and nle: "\<And>e. e > 0 \<Longrightarrow> \<forall>\<^sub>F n in sequentially. \<forall>x\<in>S. \<forall>h. norm (f' n x h - g' x h) \<le> e * norm h"
     and "e > 0"
   shows "\<exists>N. \<forall>m\<ge>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S.
     norm ((f m x - f n x) - (f m y - f n y)) \<le> e * norm (x - y)"
 proof -
   have *: "2 * (e/2) = e"
     using \<open>e > 0\<close> by auto
   obtain N where "\<forall>n\<ge>N. \<forall>x\<in>S. \<forall>h. norm (f' n x h - g' x h) \<le> (e/2) * norm h"
     using nle \<open>e > 0\<close>
     unfolding eventually_sequentially
     by (metis less_divide_eq_numeral1(1) mult_zero_left)
   then show "\<exists>N. \<forall>m\<ge>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S. norm (f m x - f n x - (f m y - f n y)) \<le> e * norm (x - y)"
     apply (rule_tac x=N in exI)
     apply (rule has_derivative_sequence_lipschitz_lemma[where e="e/2", unfolded *])
     using assms \<open>e > 0\<close>
     apply auto
     done
 qed
 
 proposition has_derivative_sequence:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::banach"
   assumes "convex S"
     and derf: "\<And>n x. x \<in> S \<Longrightarrow> ((f n) has_derivative (f' n x)) (at x within S)"
     and nle: "\<And>e. e > 0 \<Longrightarrow> \<forall>\<^sub>F n in sequentially. \<forall>x\<in>S. \<forall>h. norm (f' n x h - g' x h) \<le> e * norm h"
     and "x0 \<in> S"
     and lim: "((\<lambda>n. f n x0) \<longlongrightarrow> l) sequentially"
   shows "\<exists>g. \<forall>x\<in>S. (\<lambda>n. f n x) \<longlonglongrightarrow> g x \<and> (g has_derivative g'(x)) (at x within S)"
 proof -
   have lem1: "\<And>e. e > 0 \<Longrightarrow> \<exists>N. \<forall>m\<ge>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S.
       norm ((f m x - f n x) - (f m y - f n y)) \<le> e * norm (x - y)"
     using assms(1,2,3) by (rule has_derivative_sequence_Lipschitz)
   have "\<exists>g. \<forall>x\<in>S. ((\<lambda>n. f n x) \<longlongrightarrow> g x) sequentially"
   proof (intro ballI bchoice)
     fix x
     assume "x \<in> S"
     show "\<exists>y. (\<lambda>n. f n x) \<longlonglongrightarrow> y"
     unfolding convergent_eq_Cauchy
     proof (cases "x = x0")
       case True
       then show "Cauchy (\<lambda>n. f n x)"
         using LIMSEQ_imp_Cauchy[OF lim] by auto
     next
       case False
       show "Cauchy (\<lambda>n. f n x)"
         unfolding Cauchy_def
       proof (intro allI impI)
         fix e :: real
         assume "e > 0"
         hence *: "e / 2 > 0" "e / 2 / norm (x - x0) > 0" using False by auto
         obtain M where M: "\<forall>m\<ge>M. \<forall>n\<ge>M. dist (f m x0) (f n x0) < e / 2"
           using LIMSEQ_imp_Cauchy[OF lim] * unfolding Cauchy_def by blast
         obtain N where N:
           "\<forall>m\<ge>N. \<forall>n\<ge>N.
             \<forall>u\<in>S. \<forall>y\<in>S. norm (f m u - f n u - (f m y - f n y)) \<le>
               e / 2 / norm (x - x0) * norm (u - y)"
         using lem1 *(2) by blast
         show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (f m x) (f n x) < e"
         proof (intro exI allI impI)
           fix m n
           assume as: "max M N \<le>m" "max M N\<le>n"
           have "dist (f m x) (f n x) \<le> norm (f m x0 - f n x0) + norm (f m x - f n x - (f m x0 - f n x0))"
             unfolding dist_norm
             by (rule norm_triangle_sub)
           also have "\<dots> \<le> norm (f m x0 - f n x0) + e / 2"
             using N \<open>x\<in>S\<close> \<open>x0\<in>S\<close> as False by fastforce
           also have "\<dots> < e / 2 + e / 2"
             by (rule add_strict_right_mono) (use as M in \<open>auto simp: dist_norm\<close>)
           finally show "dist (f m x) (f n x) < e"
             by auto
         qed
       qed
     qed
   qed
   then obtain g where g: "\<forall>x\<in>S. (\<lambda>n. f n x) \<longlonglongrightarrow> g x" ..
   have lem2: "\<exists>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S. norm ((f n x - f n y) - (g x - g y)) \<le> e * norm (x - y)" if "e > 0" for e
   proof -
     obtain N where
       N: "\<forall>m\<ge>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S. norm (f m x - f n x - (f m y - f n y)) \<le> e * norm (x - y)"
       using lem1 \<open>e > 0\<close> by blast
     show "\<exists>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S. norm (f n x - f n y - (g x - g y)) \<le> e * norm (x - y)"
     proof (intro exI ballI allI impI)
       fix n x y
       assume as: "N \<le> n" "x \<in> S" "y \<in> S"
       have "((\<lambda>m. norm (f n x - f n y - (f m x - f m y))) \<longlongrightarrow> norm (f n x - f n y - (g x - g y))) sequentially"
         by (intro tendsto_intros g[rule_format] as)
       moreover have "eventually (\<lambda>m. norm (f n x - f n y - (f m x - f m y)) \<le> e * norm (x - y)) sequentially"
         unfolding eventually_sequentially
       proof (intro exI allI impI)
         fix m
         assume "N \<le> m"
         then show "norm (f n x - f n y - (f m x - f m y)) \<le> e * norm (x - y)"
           using N as by (auto simp add: algebra_simps)
       qed
       ultimately show "norm (f n x - f n y - (g x - g y)) \<le> e * norm (x - y)"
         by (simp add: tendsto_upperbound)
     qed
   qed
   have "\<forall>x\<in>S. ((\<lambda>n. f n x) \<longlongrightarrow> g x) sequentially \<and> (g has_derivative g' x) (at x within S)"
     unfolding has_derivative_within_alt2
   proof (intro ballI conjI allI impI)
     fix x
     assume "x \<in> S"
     then show "(\<lambda>n. f n x) \<longlonglongrightarrow> g x"
       by (simp add: g)
     have tog': "(\<lambda>n. f' n x u) \<longlonglongrightarrow> g' x u" for u
       unfolding filterlim_def le_nhds_metric_le eventually_filtermap dist_norm
     proof (intro allI impI)
       fix e :: real
       assume "e > 0"
       show "eventually (\<lambda>n. norm (f' n x u - g' x u) \<le> e) sequentially"
       proof (cases "u = 0")
         case True
         have "eventually (\<lambda>n. norm (f' n x u - g' x u) \<le> e * norm u) sequentially"
           using nle \<open>0 < e\<close> \<open>x \<in> S\<close> by (fast elim: eventually_mono)
         then show ?thesis
           using \<open>u = 0\<close> \<open>0 < e\<close> by (auto elim: eventually_mono)
       next
         case False
         with \<open>0 < e\<close> have "0 < e / norm u" by simp
         then have "eventually (\<lambda>n. norm (f' n x u - g' x u) \<le> e / norm u * norm u) sequentially"
           using nle \<open>x \<in> S\<close> by (fast elim: eventually_mono)
         then show ?thesis
           using \<open>u \<noteq> 0\<close> by simp
       qed
     qed
     show "bounded_linear (g' x)"
     proof
       fix x' y z :: 'a
       fix c :: real
       note lin = assms(2)[rule_format,OF \<open>x\<in>S\<close>,THEN has_derivative_bounded_linear]
       show "g' x (c *\<^sub>R x') = c *\<^sub>R g' x x'"
         apply (rule tendsto_unique[OF trivial_limit_sequentially tog'])
         unfolding lin[THEN bounded_linear.linear, THEN linear_cmul]
         apply (intro tendsto_intros tog')
         done
       show "g' x (y + z) = g' x y + g' x z"
         apply (rule tendsto_unique[OF trivial_limit_sequentially tog'])
         unfolding lin[THEN bounded_linear.linear, THEN linear_add]
         apply (rule tendsto_add)
         apply (rule tog')+
         done
       obtain N where N: "\<forall>h. norm (f' N x h - g' x h) \<le> 1 * norm h"
         using nle \<open>x \<in> S\<close> unfolding eventually_sequentially by (fast intro: zero_less_one)
       have "bounded_linear (f' N x)"
         using derf \<open>x \<in> S\<close> by fast
       from bounded_linear.bounded [OF this]
       obtain K where K: "\<forall>h. norm (f' N x h) \<le> norm h * K" ..
       {
         fix h
         have "norm (g' x h) = norm (f' N x h - (f' N x h - g' x h))"
           by simp
         also have "\<dots> \<le> norm (f' N x h) + norm (f' N x h - g' x h)"
           by (rule norm_triangle_ineq4)
         also have "\<dots> \<le> norm h * K + 1 * norm h"
           using N K by (fast intro: add_mono)
         finally have "norm (g' x h) \<le> norm h * (K + 1)"
           by (simp add: ring_distribs)
       }
       then show "\<exists>K. \<forall>h. norm (g' x h) \<le> norm h * K" by fast
     qed
     show "eventually (\<lambda>y. norm (g y - g x - g' x (y - x)) \<le> e * norm (y - x)) (at x within S)"
       if "e > 0" for e
     proof -
       have *: "e / 3 > 0"
         using that by auto
       obtain N1 where N1: "\<forall>n\<ge>N1. \<forall>x\<in>S. \<forall>h. norm (f' n x h - g' x h) \<le> e / 3 * norm h"
         using nle * unfolding eventually_sequentially by blast
       obtain N2 where
           N2[rule_format]: "\<forall>n\<ge>N2. \<forall>x\<in>S. \<forall>y\<in>S. norm (f n x - f n y - (g x - g y)) \<le> e / 3 * norm (x - y)"
         using lem2 * by blast
       let ?N = "max N1 N2"
       have "eventually (\<lambda>y. norm (f ?N y - f ?N x - f' ?N x (y - x)) \<le> e / 3 * norm (y - x)) (at x within S)"
         using derf[unfolded has_derivative_within_alt2] and \<open>x \<in> S\<close> and * by fast
       moreover have "eventually (\<lambda>y. y \<in> S) (at x within S)"
         unfolding eventually_at by (fast intro: zero_less_one)
       ultimately show "\<forall>\<^sub>F y in at x within S. norm (g y - g x - g' x (y - x)) \<le> e * norm (y - x)"
       proof (rule eventually_elim2)
         fix y
         assume "y \<in> S"
         assume "norm (f ?N y - f ?N x - f' ?N x (y - x)) \<le> e / 3 * norm (y - x)"
         moreover have "norm (g y - g x - (f ?N y - f ?N x)) \<le> e / 3 * norm (y - x)"
           using N2[OF _ \<open>y \<in> S\<close> \<open>x \<in> S\<close>]
           by (simp add: norm_minus_commute)
         ultimately have "norm (g y - g x - f' ?N x (y - x)) \<le> 2 * e / 3 * norm (y - x)"
           using norm_triangle_le[of "g y - g x - (f ?N y - f ?N x)" "f ?N y - f ?N x - f' ?N x (y - x)" "2 * e / 3 * norm (y - x)"]
           by (auto simp add: algebra_simps)
         moreover
         have " norm (f' ?N x (y - x) - g' x (y - x)) \<le> e / 3 * norm (y - x)"
           using N1 \<open>x \<in> S\<close> by auto
         ultimately show "norm (g y - g x - g' x (y - x)) \<le> e * norm (y - x)"
           using norm_triangle_le[of "g y - g x - f' (max N1 N2) x (y - x)" "f' (max N1 N2) x (y - x) - g' x (y - x)"]
           by (auto simp add: algebra_simps)
       qed
     qed
   qed
   then show ?thesis by fast
 qed
 
 text \<open>Can choose to line up antiderivatives if we want.\<close>
 
 lemma has_antiderivative_sequence:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::banach"
   assumes "convex S"
     and der: "\<And>n x. x \<in> S \<Longrightarrow> ((f n) has_derivative (f' n x)) (at x within S)"
     and no: "\<And>e. e > 0 \<Longrightarrow> \<forall>\<^sub>F n in sequentially.
        \<forall>x\<in>S. \<forall>h. norm (f' n x h - g' x h) \<le> e * norm h"
   shows "\<exists>g. \<forall>x\<in>S. (g has_derivative g' x) (at x within S)"
 proof (cases "S = {}")
   case False
   then obtain a where "a \<in> S"
     by auto
   have *: "\<And>P Q. \<exists>g. \<forall>x\<in>S. P g x \<and> Q g x \<Longrightarrow> \<exists>g. \<forall>x\<in>S. Q g x"
     by auto
   show ?thesis
     apply (rule *)
     apply (rule has_derivative_sequence [OF \<open>convex S\<close> _ no, of "\<lambda>n x. f n x + (f 0 a - f n a)"])
        apply (metis assms(2) has_derivative_add_const)
     using \<open>a \<in> S\<close> 
       apply auto
     done
 qed auto
 
 lemma has_antiderivative_limit:
   fixes g' :: "'a::real_normed_vector \<Rightarrow> 'a \<Rightarrow> 'b::banach"
   assumes "convex S"
     and "\<And>e. e>0 \<Longrightarrow> \<exists>f f'. \<forall>x\<in>S.
            (f has_derivative (f' x)) (at x within S) \<and> (\<forall>h. norm (f' x h - g' x h) \<le> e * norm h)"
   shows "\<exists>g. \<forall>x\<in>S. (g has_derivative g' x) (at x within S)"
 proof -
   have *: "\<forall>n. \<exists>f f'. \<forall>x\<in>S.
     (f has_derivative (f' x)) (at x within S) \<and>
     (\<forall>h. norm(f' x h - g' x h) \<le> inverse (real (Suc n)) * norm h)"
     by (simp add: assms(2))
   obtain f where
     *: "\<And>x. \<exists>f'. \<forall>xa\<in>S. (f x has_derivative f' xa) (at xa within S) \<and>
         (\<forall>h. norm (f' xa h - g' xa h) \<le> inverse (real (Suc x)) * norm h)"
     using * by metis
   obtain f' where
     f': "\<And>x. \<forall>z\<in>S. (f x has_derivative f' x z) (at z within S) \<and>
             (\<forall>h. norm (f' x z h - g' z h) \<le> inverse (real (Suc x)) * norm h)"
     using * by metis
   show ?thesis
   proof (rule has_antiderivative_sequence[OF \<open>convex S\<close>, of f f'])
     fix e :: real
     assume "e > 0"
     obtain N where N: "inverse (real (Suc N)) < e"
       using reals_Archimedean[OF \<open>e>0\<close>] ..
     show "\<forall>\<^sub>F n in sequentially. \<forall>x\<in>S.  \<forall>h. norm (f' n x h - g' x h) \<le> e * norm h"
         unfolding eventually_sequentially
     proof (intro exI allI ballI impI)
       fix n x h
       assume n: "N \<le> n" and x: "x \<in> S"
       have *: "inverse (real (Suc n)) \<le> e"
         apply (rule order_trans[OF _ N[THEN less_imp_le]])
         using n apply (auto simp add: field_simps)
         done
       show "norm (f' n x h - g' x h) \<le> e * norm h"
         by (meson "*" mult_right_mono norm_ge_zero order.trans x f')
     qed
   qed (use f' in auto)
 qed
 
 
 subsection \<open>Differentiation of a series\<close>
 
 proposition has_derivative_series:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::banach"
   assumes "convex S"
     and "\<And>n x. x \<in> S \<Longrightarrow> ((f n) has_derivative (f' n x)) (at x within S)"
     and "\<And>e. e>0 \<Longrightarrow> \<forall>\<^sub>F n in sequentially. \<forall>x\<in>S. \<forall>h. norm (sum (\<lambda>i. f' i x h) {..<n} - g' x h) \<le> e * norm h"
     and "x \<in> S"
     and "(\<lambda>n. f n x) sums l"
   shows "\<exists>g. \<forall>x\<in>S. (\<lambda>n. f n x) sums (g x) \<and> (g has_derivative g' x) (at x within S)"
   unfolding sums_def
   apply (rule has_derivative_sequence[OF assms(1) _ assms(3)])
   apply (metis assms(2) has_derivative_sum)
   using assms(4-5)
   unfolding sums_def
   apply auto
   done
 
 lemma has_field_derivative_series:
   fixes f :: "nat \<Rightarrow> ('a :: {real_normed_field,banach}) \<Rightarrow> 'a"
   assumes "convex S"
   assumes "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x within S)"
   assumes "uniform_limit S (\<lambda>n x. \<Sum>i<n. f' i x) g' sequentially"
   assumes "x0 \<in> S" "summable (\<lambda>n. f n x0)"
   shows   "\<exists>g. \<forall>x\<in>S. (\<lambda>n. f n x) sums g x \<and> (g has_field_derivative g' x) (at x within S)"
 unfolding has_field_derivative_def
 proof (rule has_derivative_series)
   show "\<forall>\<^sub>F n in sequentially.
        \<forall>x\<in>S. \<forall>h. norm ((\<Sum>i<n. f' i x * h) - g' x * h) \<le> e * norm h" if "e > 0" for e
     unfolding eventually_sequentially
   proof -
     from that assms(3) obtain N where N: "\<And>n x. n \<ge> N \<Longrightarrow> x \<in> S \<Longrightarrow> norm ((\<Sum>i<n. f' i x) - g' x) < e"
       unfolding uniform_limit_iff eventually_at_top_linorder dist_norm by blast
     {
       fix n :: nat and x h :: 'a assume nx: "n \<ge> N" "x \<in> S"
       have "norm ((\<Sum>i<n. f' i x * h) - g' x * h) = norm ((\<Sum>i<n. f' i x) - g' x) * norm h"
         by (simp add: norm_mult [symmetric] ring_distribs sum_distrib_right)
       also from N[OF nx] have "norm ((\<Sum>i<n. f' i x) - g' x) \<le> e" by simp
       hence "norm ((\<Sum>i<n. f' i x) - g' x) * norm h \<le> e * norm h"
         by (intro mult_right_mono) simp_all
       finally have "norm ((\<Sum>i<n. f' i x * h) - g' x * h) \<le> e * norm h" .
     }
     thus "\<exists>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>h. norm ((\<Sum>i<n. f' i x * h) - g' x * h) \<le> e * norm h" by blast
   qed
 qed (use assms in \<open>auto simp: has_field_derivative_def\<close>)
 
 lemma has_field_derivative_series':
   fixes f :: "nat \<Rightarrow> ('a :: {real_normed_field,banach}) \<Rightarrow> 'a"
   assumes "convex S"
   assumes "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x within S)"
   assumes "uniformly_convergent_on S (\<lambda>n x. \<Sum>i<n. f' i x)"
   assumes "x0 \<in> S" "summable (\<lambda>n. f n x0)" "x \<in> interior S"
   shows   "summable (\<lambda>n. f n x)" "((\<lambda>x. \<Sum>n. f n x) has_field_derivative (\<Sum>n. f' n x)) (at x)"
 proof -
   from \<open>x \<in> interior S\<close> have "x \<in> S" using interior_subset by blast
   define g' where [abs_def]: "g' x = (\<Sum>i. f' i x)" for x
   from assms(3) have "uniform_limit S (\<lambda>n x. \<Sum>i<n. f' i x) g' sequentially"
     by (simp add: uniformly_convergent_uniform_limit_iff suminf_eq_lim g'_def)
   from has_field_derivative_series[OF assms(1,2) this assms(4,5)] obtain g where g:
     "\<And>x. x \<in> S \<Longrightarrow> (\<lambda>n. f n x) sums g x"
     "\<And>x. x \<in> S \<Longrightarrow> (g has_field_derivative g' x) (at x within S)" by blast
   from g(1)[OF \<open>x \<in> S\<close>] show "summable (\<lambda>n. f n x)" by (simp add: sums_iff)
   from g(2)[OF \<open>x \<in> S\<close>] \<open>x \<in> interior S\<close> have "(g has_field_derivative g' x) (at x)"
     by (simp add: at_within_interior[of x S])
   also have "(g has_field_derivative g' x) (at x) \<longleftrightarrow>
                 ((\<lambda>x. \<Sum>n. f n x) has_field_derivative g' x) (at x)"
     using eventually_nhds_in_nhd[OF \<open>x \<in> interior S\<close>] interior_subset[of S] g(1)
     by (intro DERIV_cong_ev) (auto elim!: eventually_mono simp: sums_iff)
   finally show "((\<lambda>x. \<Sum>n. f n x) has_field_derivative g' x) (at x)" .
 qed
 
 lemma differentiable_series:
   fixes f :: "nat \<Rightarrow> ('a :: {real_normed_field,banach}) \<Rightarrow> 'a"
   assumes "convex S" "open S"
   assumes "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x)"
   assumes "uniformly_convergent_on S (\<lambda>n x. \<Sum>i<n. f' i x)"
   assumes "x0 \<in> S" "summable (\<lambda>n. f n x0)" and x: "x \<in> S"
   shows   "summable (\<lambda>n. f n x)" and "(\<lambda>x. \<Sum>n. f n x) differentiable (at x)"
 proof -
   from assms(4) obtain g' where A: "uniform_limit S (\<lambda>n x. \<Sum>i<n. f' i x) g' sequentially"
     unfolding uniformly_convergent_on_def by blast
   from x and \<open>open S\<close> have S: "at x within S = at x" by (rule at_within_open)
   have "\<exists>g. \<forall>x\<in>S. (\<lambda>n. f n x) sums g x \<and> (g has_field_derivative g' x) (at x within S)"
     by (intro has_field_derivative_series[of S f f' g' x0] assms A has_field_derivative_at_within)
   then obtain g where g: "\<And>x. x \<in> S \<Longrightarrow> (\<lambda>n. f n x) sums g x"
     "\<And>x. x \<in> S \<Longrightarrow> (g has_field_derivative g' x) (at x within S)" by blast
   from g[OF x] show "summable (\<lambda>n. f n x)" by (auto simp: summable_def)
   from g(2)[OF x] have g': "(g has_derivative (*) (g' x)) (at x)"
     by (simp add: has_field_derivative_def S)
   have "((\<lambda>x. \<Sum>n. f n x) has_derivative (*) (g' x)) (at x)"
     by (rule has_derivative_transform_within_open[OF g' \<open>open S\<close> x])
        (insert g, auto simp: sums_iff)
   thus "(\<lambda>x. \<Sum>n. f n x) differentiable (at x)" unfolding differentiable_def
     by (auto simp: summable_def differentiable_def has_field_derivative_def)
 qed
 
 lemma differentiable_series':
   fixes f :: "nat \<Rightarrow> ('a :: {real_normed_field,banach}) \<Rightarrow> 'a"
   assumes "convex S" "open S"
   assumes "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x)"
   assumes "uniformly_convergent_on S (\<lambda>n x. \<Sum>i<n. f' i x)"
   assumes "x0 \<in> S" "summable (\<lambda>n. f n x0)"
   shows   "(\<lambda>x. \<Sum>n. f n x) differentiable (at x0)"
   using differentiable_series[OF assms, of x0] \<open>x0 \<in> S\<close> by blast+
 
 subsection \<open>Derivative as a vector\<close>
 
 text \<open>Considering derivative \<^typ>\<open>real \<Rightarrow> 'b::real_normed_vector\<close> as a vector.\<close>
 
 definition "vector_derivative f net = (SOME f'. (f has_vector_derivative f') net)"
 
 lemma vector_derivative_unique_within:
   assumes not_bot: "at x within S \<noteq> bot"
     and f': "(f has_vector_derivative f') (at x within S)"
     and f'': "(f has_vector_derivative f'') (at x within S)"
   shows "f' = f''"
 proof -
   have "(\<lambda>x. x *\<^sub>R f') = (\<lambda>x. x *\<^sub>R f'')"
   proof (rule frechet_derivative_unique_within, simp_all)
     show "\<exists>d. d \<noteq> 0 \<and> \<bar>d\<bar> < e \<and> x + d \<in> S" if "0 < e"  for e
     proof -
       from that
       obtain x' where "x' \<in> S" "x' \<noteq> x" "\<bar>x' - x\<bar> < e"
         using islimpt_approachable_real[of x S] not_bot
         by (auto simp add: trivial_limit_within)
       then show ?thesis
         using eq_iff_diff_eq_0 by fastforce
     qed
   qed (use f' f'' in \<open>auto simp: has_vector_derivative_def\<close>)
   then show ?thesis
     unfolding fun_eq_iff by (metis scaleR_one)
 qed
 
 lemma vector_derivative_unique_at:
   "(f has_vector_derivative f') (at x) \<Longrightarrow> (f has_vector_derivative f'') (at x) \<Longrightarrow> f' = f''"
   by (rule vector_derivative_unique_within) auto
 
 lemma differentiableI_vector: "(f has_vector_derivative y) F \<Longrightarrow> f differentiable F"
   by (auto simp: differentiable_def has_vector_derivative_def)
 
 proposition vector_derivative_works:
   "f differentiable net \<longleftrightarrow> (f has_vector_derivative (vector_derivative f net)) net"
     (is "?l = ?r")
 proof
   assume ?l
   obtain f' where f': "(f has_derivative f') net"
     using \<open>?l\<close> unfolding differentiable_def ..
   then interpret bounded_linear f'
     by auto
   show ?r
     unfolding vector_derivative_def has_vector_derivative_def
     by (rule someI[of _ "f' 1"]) (simp add: scaleR[symmetric] f')
 qed (auto simp: vector_derivative_def has_vector_derivative_def differentiable_def)
 
 lemma vector_derivative_within:
   assumes not_bot: "at x within S \<noteq> bot" and y: "(f has_vector_derivative y) (at x within S)"
   shows "vector_derivative f (at x within S) = y"
   using y
   by (intro vector_derivative_unique_within[OF not_bot vector_derivative_works[THEN iffD1] y])
      (auto simp: differentiable_def has_vector_derivative_def)
 
 lemma frechet_derivative_eq_vector_derivative:
   assumes "f differentiable (at x)"
     shows  "(frechet_derivative f (at x)) = (\<lambda>r. r *\<^sub>R vector_derivative f (at x))"
 using assms
 by (auto simp: differentiable_iff_scaleR vector_derivative_def has_vector_derivative_def
          intro: someI frechet_derivative_at [symmetric])
 
 lemma has_real_derivative:
   fixes f :: "real \<Rightarrow> real"
   assumes "(f has_derivative f') F"
   obtains c where "(f has_real_derivative c) F"
 proof -
   obtain c where "f' = (\<lambda>x. x * c)"
     by (metis assms has_derivative_bounded_linear real_bounded_linear)
   then show ?thesis
     by (metis assms that has_field_derivative_def mult_commute_abs)
 qed
 
 lemma has_real_derivative_iff:
   fixes f :: "real \<Rightarrow> real"
   shows "(\<exists>c. (f has_real_derivative c) F) = (\<exists>D. (f has_derivative D) F)"
   by (metis has_field_derivative_def has_real_derivative)
 
 lemma has_vector_derivative_cong_ev:
   assumes *: "eventually (\<lambda>x. x \<in> S \<longrightarrow> f x = g x) (nhds x)" "f x = g x"
   shows "(f has_vector_derivative f') (at x within S) = (g has_vector_derivative f') (at x within S)"
   unfolding has_vector_derivative_def has_derivative_def
   using *
   apply (cases "at x within S \<noteq> bot")
   apply (intro refl conj_cong filterlim_cong)
   apply (auto simp: Lim_ident_at eventually_at_filter elim: eventually_mono)
   done
 
 lemma islimpt_closure_open:
   fixes s :: "'a::perfect_space set"
   assumes "open s" and t: "t = closure s" "x \<in> t"
   shows "x islimpt t"
 proof cases
   assume "x \<in> s"
   { fix T assume "x \<in> T" "open T"
     then have "open (s \<inter> T)"
       using \<open>open s\<close> by auto
     then have "s \<inter> T \<noteq> {x}"
       using not_open_singleton[of x] by auto
     with \<open>x \<in> T\<close> \<open>x \<in> s\<close> have "\<exists>y\<in>t. y \<in> T \<and> y \<noteq> x"
       using closure_subset[of s] by (auto simp: t) }
   then show ?thesis
     by (auto intro!: islimptI)
 next
   assume "x \<notin> s" with t show ?thesis
     unfolding t closure_def by (auto intro: islimpt_subset)
 qed
 
 lemma vector_derivative_unique_within_closed_interval:
   assumes ab: "a < b" "x \<in> cbox a b"
   assumes D: "(f has_vector_derivative f') (at x within cbox a b)" "(f has_vector_derivative f'') (at x within cbox a b)"
   shows "f' = f''"
   using ab
   by (intro vector_derivative_unique_within[OF _ D])
      (auto simp: trivial_limit_within intro!: islimpt_closure_open[where s="{a <..< b}"])
 
 lemma vector_derivative_at:
   "(f has_vector_derivative f') (at x) \<Longrightarrow> vector_derivative f (at x) = f'"
   by (intro vector_derivative_within at_neq_bot)
 
 lemma has_vector_derivative_id_at [simp]: "vector_derivative (\<lambda>x. x) (at a) = 1"
   by (simp add: vector_derivative_at)
 
 lemma vector_derivative_minus_at [simp]:
   "f differentiable at a
    \<Longrightarrow> vector_derivative (\<lambda>x. - f x) (at a) = - vector_derivative f (at a)"
   by (simp add: vector_derivative_at has_vector_derivative_minus vector_derivative_works [symmetric])
 
 lemma vector_derivative_add_at [simp]:
   "\<lbrakk>f differentiable at a; g differentiable at a\<rbrakk>
    \<Longrightarrow> vector_derivative (\<lambda>x. f x + g x) (at a) = vector_derivative f (at a) + vector_derivative g (at a)"
   by (simp add: vector_derivative_at has_vector_derivative_add vector_derivative_works [symmetric])
 
 lemma vector_derivative_diff_at [simp]:
   "\<lbrakk>f differentiable at a; g differentiable at a\<rbrakk>
    \<Longrightarrow> vector_derivative (\<lambda>x. f x - g x) (at a) = vector_derivative f (at a) - vector_derivative g (at a)"
   by (simp add: vector_derivative_at has_vector_derivative_diff vector_derivative_works [symmetric])
 
 lemma vector_derivative_mult_at [simp]:
   fixes f g :: "real \<Rightarrow> 'a :: real_normed_algebra"
   shows  "\<lbrakk>f differentiable at a; g differentiable at a\<rbrakk>
    \<Longrightarrow> vector_derivative (\<lambda>x. f x * g x) (at a) = f a * vector_derivative g (at a) + vector_derivative f (at a) * g a"
   by (simp add: vector_derivative_at has_vector_derivative_mult vector_derivative_works [symmetric])
 
 lemma vector_derivative_scaleR_at [simp]:
     "\<lbrakk>f differentiable at a; g differentiable at a\<rbrakk>
    \<Longrightarrow> vector_derivative (\<lambda>x. f x *\<^sub>R g x) (at a) = f a *\<^sub>R vector_derivative g (at a) + vector_derivative f (at a) *\<^sub>R g a"
 apply (rule vector_derivative_at)
 apply (rule has_vector_derivative_scaleR)
 apply (auto simp: vector_derivative_works has_vector_derivative_def has_field_derivative_def mult_commute_abs)
 done
 
 lemma vector_derivative_within_cbox:
   assumes ab: "a < b" "x \<in> cbox a b"
   assumes f: "(f has_vector_derivative f') (at x within cbox a b)"
   shows "vector_derivative f (at x within cbox a b) = f'"
   by (intro vector_derivative_unique_within_closed_interval[OF ab _ f]
             vector_derivative_works[THEN iffD1] differentiableI_vector)
      fact
 
 lemma vector_derivative_within_closed_interval:
   fixes f::"real \<Rightarrow> 'a::euclidean_space"
   assumes "a < b" and "x \<in> {a..b}"
   assumes "(f has_vector_derivative f') (at x within {a..b})"
   shows "vector_derivative f (at x within {a..b}) = f'"
   using assms vector_derivative_within_cbox
   by fastforce
 
 lemma has_vector_derivative_within_subset:
   "(f has_vector_derivative f') (at x within S) \<Longrightarrow> T \<subseteq> S \<Longrightarrow> (f has_vector_derivative f') (at x within T)"
   by (auto simp: has_vector_derivative_def intro: has_derivative_within_subset)
 
 lemma has_vector_derivative_at_within:
   "(f has_vector_derivative f') (at x) \<Longrightarrow> (f has_vector_derivative f') (at x within S)"
   unfolding has_vector_derivative_def
   by (rule has_derivative_at_withinI)
 
 lemma has_vector_derivative_weaken:
   fixes x D and f g S T
   assumes f: "(f has_vector_derivative D) (at x within T)"
     and "x \<in> S" "S \<subseteq> T"
     and "\<And>x. x \<in> S \<Longrightarrow> f x = g x"
   shows "(g has_vector_derivative D) (at x within S)"
 proof -
   have "(f has_vector_derivative D) (at x within S) \<longleftrightarrow> (g has_vector_derivative D) (at x within S)"
     unfolding has_vector_derivative_def has_derivative_iff_norm
     using assms by (intro conj_cong Lim_cong_within refl) auto
   then show ?thesis
     using has_vector_derivative_within_subset[OF f \<open>S \<subseteq> T\<close>] by simp
 qed
 
 lemma has_vector_derivative_transform_within:
   assumes "(f has_vector_derivative f') (at x within S)"
     and "0 < d"
     and "x \<in> S"
     and "\<And>x'. \<lbrakk>x'\<in>S; dist x' x < d\<rbrakk> \<Longrightarrow> f x' = g x'"
     shows "(g has_vector_derivative f') (at x within S)"
   using assms
   unfolding has_vector_derivative_def
   by (rule has_derivative_transform_within)
 
 lemma has_vector_derivative_transform_within_open:
   assumes "(f has_vector_derivative f') (at x)"
     and "open S"
     and "x \<in> S"
     and "\<And>y. y\<in>S \<Longrightarrow> f y = g y"
   shows "(g has_vector_derivative f') (at x)"
   using assms
   unfolding has_vector_derivative_def
   by (rule has_derivative_transform_within_open)
 
 lemma has_vector_derivative_transform:
   assumes "x \<in> S" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
   assumes f': "(f has_vector_derivative f') (at x within S)"
   shows "(g has_vector_derivative f') (at x within S)"
   using assms
   unfolding has_vector_derivative_def
   by (rule has_derivative_transform)
 
 lemma vector_diff_chain_at:
   assumes "(f has_vector_derivative f') (at x)"
     and "(g has_vector_derivative g') (at (f x))"
   shows "((g \<circ> f) has_vector_derivative (f' *\<^sub>R g')) (at x)"
   using assms has_vector_derivative_at_within has_vector_derivative_def vector_derivative_diff_chain_within by blast
 
 lemma vector_diff_chain_within:
   assumes "(f has_vector_derivative f') (at x within s)"
     and "(g has_vector_derivative g') (at (f x) within f ` s)"
   shows "((g \<circ> f) has_vector_derivative (f' *\<^sub>R g')) (at x within s)"
   using assms has_vector_derivative_def vector_derivative_diff_chain_within by blast
 
 lemma vector_derivative_const_at [simp]: "vector_derivative (\<lambda>x. c) (at a) = 0"
   by (simp add: vector_derivative_at)
 
 lemma vector_derivative_at_within_ivl:
   "(f has_vector_derivative f') (at x) \<Longrightarrow>
     a \<le> x \<Longrightarrow> x \<le> b \<Longrightarrow> a<b \<Longrightarrow> vector_derivative f (at x within {a..b}) = f'"
   using has_vector_derivative_at_within vector_derivative_within_cbox by fastforce
 
 lemma vector_derivative_chain_at:
   assumes "f differentiable at x" "(g differentiable at (f x))"
   shows "vector_derivative (g \<circ> f) (at x) =
          vector_derivative f (at x) *\<^sub>R vector_derivative g (at (f x))"
 by (metis vector_diff_chain_at vector_derivative_at vector_derivative_works assms)
 
 lemma field_vector_diff_chain_at:  (*thanks to Wenda Li*)
  assumes Df: "(f has_vector_derivative f') (at x)"
      and Dg: "(g has_field_derivative g') (at (f x))"
  shows "((g \<circ> f) has_vector_derivative (f' * g')) (at x)"
 using diff_chain_at[OF Df[unfolded has_vector_derivative_def]
                        Dg [unfolded has_field_derivative_def]]
  by (auto simp: o_def mult.commute has_vector_derivative_def)
 
 lemma vector_derivative_chain_within: 
   assumes "at x within S \<noteq> bot" "f differentiable (at x within S)" 
     "(g has_derivative g') (at (f x) within f ` S)" 
   shows "vector_derivative (g \<circ> f) (at x within S) =
         g' (vector_derivative f (at x within S)) "
   apply (rule vector_derivative_within [OF \<open>at x within S \<noteq> bot\<close>])
   apply (rule vector_derivative_diff_chain_within)
   using assms(2-3) vector_derivative_works
   by auto
 
 subsection \<open>Field differentiability\<close>
 
 definition\<^marker>\<open>tag important\<close> field_differentiable :: "['a \<Rightarrow> 'a::real_normed_field, 'a filter] \<Rightarrow> bool"
            (infixr "(field'_differentiable)" 50)
   where "f field_differentiable F \<equiv> \<exists>f'. (f has_field_derivative f') F"
 
 lemma field_differentiable_imp_differentiable:
   "f field_differentiable F \<Longrightarrow> f differentiable F"
   unfolding field_differentiable_def differentiable_def 
   using has_field_derivative_imp_has_derivative by auto
 
 lemma field_differentiable_imp_continuous_at:
     "f field_differentiable (at x within S) \<Longrightarrow> continuous (at x within S) f"
   by (metis DERIV_continuous field_differentiable_def)
 
 lemma field_differentiable_within_subset:
     "\<lbrakk>f field_differentiable (at x within S); T \<subseteq> S\<rbrakk> \<Longrightarrow> f field_differentiable (at x within T)"
   by (metis DERIV_subset field_differentiable_def)
 
 lemma field_differentiable_at_within:
     "\<lbrakk>f field_differentiable (at x)\<rbrakk>
      \<Longrightarrow> f field_differentiable (at x within S)"
   unfolding field_differentiable_def
   by (metis DERIV_subset top_greatest)
 
 lemma field_differentiable_linear [simp,derivative_intros]: "((*) c) field_differentiable F"
   unfolding field_differentiable_def has_field_derivative_def mult_commute_abs
   by (force intro: has_derivative_mult_right)
 
 lemma field_differentiable_const [simp,derivative_intros]: "(\<lambda>z. c) field_differentiable F"
   unfolding field_differentiable_def has_field_derivative_def
   using DERIV_const has_field_derivative_imp_has_derivative by blast
 
 lemma field_differentiable_ident [simp,derivative_intros]: "(\<lambda>z. z) field_differentiable F"
   unfolding field_differentiable_def has_field_derivative_def
   using DERIV_ident has_field_derivative_def by blast
 
 lemma field_differentiable_id [simp,derivative_intros]: "id field_differentiable F"
   unfolding id_def by (rule field_differentiable_ident)
 
 lemma field_differentiable_minus [derivative_intros]:
   "f field_differentiable F \<Longrightarrow> (\<lambda>z. - (f z)) field_differentiable F"
   unfolding field_differentiable_def
   by (metis field_differentiable_minus)
 
 lemma field_differentiable_add [derivative_intros]:
   assumes "f field_differentiable F" "g field_differentiable F"
     shows "(\<lambda>z. f z + g z) field_differentiable F"
   using assms unfolding field_differentiable_def
   by (metis field_differentiable_add)
 
 lemma field_differentiable_add_const [simp,derivative_intros]:
      "(+) c field_differentiable F"
   by (simp add: field_differentiable_add)
 
 lemma field_differentiable_sum [derivative_intros]:
   "(\<And>i. i \<in> I \<Longrightarrow> (f i) field_differentiable F) \<Longrightarrow> (\<lambda>z. \<Sum>i\<in>I. f i z) field_differentiable F"
   by (induct I rule: infinite_finite_induct)
      (auto intro: field_differentiable_add field_differentiable_const)
 
 lemma field_differentiable_diff [derivative_intros]:
   assumes "f field_differentiable F" "g field_differentiable F"
     shows "(\<lambda>z. f z - g z) field_differentiable F"
   using assms unfolding field_differentiable_def
   by (metis field_differentiable_diff)
 
 lemma field_differentiable_inverse [derivative_intros]:
   assumes "f field_differentiable (at a within S)" "f a \<noteq> 0"
   shows "(\<lambda>z. inverse (f z)) field_differentiable (at a within S)"
   using assms unfolding field_differentiable_def
   by (metis DERIV_inverse_fun)
 
 lemma field_differentiable_mult [derivative_intros]:
   assumes "f field_differentiable (at a within S)"
           "g field_differentiable (at a within S)"
     shows "(\<lambda>z. f z * g z) field_differentiable (at a within S)"
   using assms unfolding field_differentiable_def
   by (metis DERIV_mult [of f _ a S g])
 
 lemma field_differentiable_divide [derivative_intros]:
   assumes "f field_differentiable (at a within S)"
           "g field_differentiable (at a within S)"
           "g a \<noteq> 0"
     shows "(\<lambda>z. f z / g z) field_differentiable (at a within S)"
   using assms unfolding field_differentiable_def
   by (metis DERIV_divide [of f _ a S g])
 
 lemma field_differentiable_power [derivative_intros]:
   assumes "f field_differentiable (at a within S)"
     shows "(\<lambda>z. f z ^ n) field_differentiable (at a within S)"
   using assms unfolding field_differentiable_def
   by (metis DERIV_power)
 
 lemma field_differentiable_transform_within:
   "0 < d \<Longrightarrow>
         x \<in> S \<Longrightarrow>
         (\<And>x'. x' \<in> S \<Longrightarrow> dist x' x < d \<Longrightarrow> f x' = g x') \<Longrightarrow>
         f field_differentiable (at x within S)
         \<Longrightarrow> g field_differentiable (at x within S)"
   unfolding field_differentiable_def has_field_derivative_def
   by (blast intro: has_derivative_transform_within)
 
 lemma field_differentiable_compose_within:
   assumes "f field_differentiable (at a within S)"
           "g field_differentiable (at (f a) within f`S)"
     shows "(g o f) field_differentiable (at a within S)"
   using assms unfolding field_differentiable_def
   by (metis DERIV_image_chain)
 
 lemma field_differentiable_compose:
   "f field_differentiable at z \<Longrightarrow> g field_differentiable at (f z)
           \<Longrightarrow> (g o f) field_differentiable at z"
 by (metis field_differentiable_at_within field_differentiable_compose_within)
 
 lemma field_differentiable_within_open:
      "\<lbrakk>a \<in> S; open S\<rbrakk> \<Longrightarrow> f field_differentiable at a within S \<longleftrightarrow>
                           f field_differentiable at a"
   unfolding field_differentiable_def
   by (metis at_within_open)
 
 lemma exp_scaleR_has_vector_derivative_right:
   "((\<lambda>t. exp (t *\<^sub>R A)) has_vector_derivative exp (t *\<^sub>R A) * A) (at t within T)"
   unfolding has_vector_derivative_def
 proof (rule has_derivativeI)
   let ?F = "at t within (T \<inter> {t - 1 <..< t + 1})"
   have *: "at t within T = ?F"
     by (rule at_within_nhd[where S="{t - 1 <..< t + 1}"]) auto
   let ?e = "\<lambda>i x. (inverse (1 + real i) * inverse (fact i) * (x - t) ^ i) *\<^sub>R (A * A ^ i)"
   have "\<forall>\<^sub>F n in sequentially.
       \<forall>x\<in>T \<inter> {t - 1<..<t + 1}. norm (?e n x) \<le> norm (A ^ (n + 1) /\<^sub>R fact (n + 1))"
     apply (auto simp: algebra_split_simps intro!: eventuallyI)
     apply (rule mult_left_mono)
      apply (auto simp add: field_simps power_abs intro!: divide_right_mono power_le_one)
     done
   then have "uniform_limit (T \<inter> {t - 1<..<t + 1}) (\<lambda>n x. \<Sum>i<n. ?e i x) (\<lambda>x. \<Sum>i. ?e i x) sequentially"
     by (rule Weierstrass_m_test_ev) (intro summable_ignore_initial_segment summable_norm_exp)
   moreover
   have "\<forall>\<^sub>F x in sequentially. x > 0"
     by (metis eventually_gt_at_top)
   then have
     "\<forall>\<^sub>F n in sequentially. ((\<lambda>x. \<Sum>i<n. ?e i x) \<longlongrightarrow> A) ?F"
     by eventually_elim
       (auto intro!: tendsto_eq_intros
         simp: power_0_left if_distrib if_distribR
         cong: if_cong)
   ultimately
   have [tendsto_intros]: "((\<lambda>x. \<Sum>i. ?e i x) \<longlongrightarrow> A) ?F"
     by (auto intro!: swap_uniform_limit[where f="\<lambda>n x. \<Sum>i < n. ?e i x" and F = sequentially])
   have [tendsto_intros]: "((\<lambda>x. if x = t then 0 else 1) \<longlongrightarrow> 1) ?F"
     by (rule tendsto_eventually) (simp add: eventually_at_filter)
   have "((\<lambda>y. ((y - t) / abs (y - t)) *\<^sub>R ((\<Sum>n. ?e n y) - A)) \<longlongrightarrow> 0) (at t within T)"
     unfolding *
     by (rule tendsto_norm_zero_cancel) (auto intro!: tendsto_eq_intros)
 
   moreover have "\<forall>\<^sub>F x in at t within T. x \<noteq> t"
     by (simp add: eventually_at_filter)
   then have "\<forall>\<^sub>F x in at t within T. ((x - t) / \<bar>x - t\<bar>) *\<^sub>R ((\<Sum>n. ?e n x) - A) =
     (exp ((x - t) *\<^sub>R A) - 1 - (x - t) *\<^sub>R A) /\<^sub>R norm (x - t)"
   proof eventually_elim
     case (elim x)
     have "(exp ((x - t) *\<^sub>R A) - 1 - (x - t) *\<^sub>R A) /\<^sub>R norm (x - t) =
       ((\<Sum>n. (x - t) *\<^sub>R ?e n x) - (x - t) *\<^sub>R A) /\<^sub>R norm (x - t)"
       unfolding exp_first_term
       by (simp add: ac_simps)
     also
     have "summable (\<lambda>n. ?e n x)"
     proof -
       from elim have "?e n x = (((x - t) *\<^sub>R A) ^ (n + 1)) /\<^sub>R fact (n + 1) /\<^sub>R (x - t)" for n
         by simp
       then show ?thesis
         by (auto simp only:
           intro!: summable_scaleR_right summable_ignore_initial_segment summable_exp_generic)
     qed
     then have "(\<Sum>n. (x - t) *\<^sub>R ?e n x) = (x - t) *\<^sub>R (\<Sum>n. ?e n x)"
       by (rule suminf_scaleR_right[symmetric])
     also have "(\<dots> - (x - t) *\<^sub>R A) /\<^sub>R norm (x - t) = (x - t) *\<^sub>R ((\<Sum>n. ?e n x) - A) /\<^sub>R norm (x - t)"
       by (simp add: algebra_simps)
     finally show ?case
       by simp (simp add: field_simps)
   qed
 
   ultimately have "((\<lambda>y. (exp ((y - t) *\<^sub>R A) - 1 - (y - t) *\<^sub>R A) /\<^sub>R norm (y - t)) \<longlongrightarrow> 0) (at t within T)"
     by (rule Lim_transform_eventually)
   from tendsto_mult_right_zero[OF this, where c="exp (t *\<^sub>R A)"]
   show "((\<lambda>y. (exp (y *\<^sub>R A) - exp (t *\<^sub>R A) - (y - t) *\<^sub>R (exp (t *\<^sub>R A) * A)) /\<^sub>R norm (y - t)) \<longlongrightarrow> 0)
       (at t within T)"
     by (rule Lim_transform_eventually)
       (auto simp: algebra_simps field_split_simps exp_add_commuting[symmetric])
 qed (rule bounded_linear_scaleR_left)
 
 lemma exp_times_scaleR_commute: "exp (t *\<^sub>R A) * A = A * exp (t *\<^sub>R A)"
   using exp_times_arg_commute[symmetric, of "t *\<^sub>R A"]
   by (auto simp: algebra_simps)
 
 lemma exp_scaleR_has_vector_derivative_left: "((\<lambda>t. exp (t *\<^sub>R A)) has_vector_derivative A * exp (t *\<^sub>R A)) (at t)"
   using exp_scaleR_has_vector_derivative_right[of A t]
   by (simp add: exp_times_scaleR_commute)
 
 subsection \<open>Field derivative\<close>
 
 definition\<^marker>\<open>tag important\<close> deriv :: "('a \<Rightarrow> 'a::real_normed_field) \<Rightarrow> 'a \<Rightarrow> 'a" where
   "deriv f x \<equiv> SOME D. DERIV f x :> D"
 
 lemma DERIV_imp_deriv: "DERIV f x :> f' \<Longrightarrow> deriv f x = f'"
   unfolding deriv_def by (metis some_equality DERIV_unique)
 
 lemma DERIV_deriv_iff_has_field_derivative:
   "DERIV f x :> deriv f x \<longleftrightarrow> (\<exists>f'. (f has_field_derivative f') (at x))"
   by (auto simp: has_field_derivative_def DERIV_imp_deriv)
 
 lemma DERIV_deriv_iff_real_differentiable:
   fixes x :: real
   shows "DERIV f x :> deriv f x \<longleftrightarrow> f differentiable at x"
   unfolding differentiable_def by (metis DERIV_imp_deriv has_real_derivative_iff)
 
 lemma deriv_cong_ev:
   assumes "eventually (\<lambda>x. f x = g x) (nhds x)" "x = y"
   shows   "deriv f x = deriv g y"
 proof -
   have "(\<lambda>D. (f has_field_derivative D) (at x)) = (\<lambda>D. (g has_field_derivative D) (at y))"
     by (intro ext DERIV_cong_ev refl assms)
   thus ?thesis by (simp add: deriv_def assms)
 qed
 
 lemma higher_deriv_cong_ev:
   assumes "eventually (\<lambda>x. f x = g x) (nhds x)" "x = y"
   shows   "(deriv ^^ n) f x = (deriv ^^ n) g y"
 proof -
   from assms(1) have "eventually (\<lambda>x. (deriv ^^ n) f x = (deriv ^^ n) g x) (nhds x)"
   proof (induction n arbitrary: f g)
     case (Suc n)
     from Suc.prems have "eventually (\<lambda>y. eventually (\<lambda>z. f z = g z) (nhds y)) (nhds x)"
       by (simp add: eventually_eventually)
     hence "eventually (\<lambda>x. deriv f x = deriv g x) (nhds x)"
       by eventually_elim (rule deriv_cong_ev, simp_all)
     thus ?case by (auto intro!: deriv_cong_ev Suc simp: funpow_Suc_right simp del: funpow.simps)
   qed auto
   from eventually_nhds_x_imp_x[OF this] assms(2) show ?thesis by simp
 qed
 
 lemma real_derivative_chain:
   fixes x :: real
   shows "f differentiable at x \<Longrightarrow> g differentiable at (f x)
     \<Longrightarrow> deriv (g o f) x = deriv g (f x) * deriv f x"
   by (metis DERIV_deriv_iff_real_differentiable DERIV_chain DERIV_imp_deriv)
 lemma field_derivative_eq_vector_derivative:
    "(deriv f x) = vector_derivative f (at x)"
 by (simp add: mult.commute deriv_def vector_derivative_def has_vector_derivative_def has_field_derivative_def)
 
 proposition field_differentiable_derivI:
     "f field_differentiable (at x) \<Longrightarrow> (f has_field_derivative deriv f x) (at x)"
 by (simp add: field_differentiable_def DERIV_deriv_iff_has_field_derivative)
 
 lemma vector_derivative_chain_at_general:
   assumes "f differentiable at x" "g field_differentiable at (f x)"
   shows "vector_derivative (g \<circ> f) (at x) = vector_derivative f (at x) * deriv g (f x)"
   apply (rule vector_derivative_at [OF field_vector_diff_chain_at])
   using assms vector_derivative_works by (auto simp: field_differentiable_derivI)
 
 
 subsection \<open>Relation between convexity and derivative\<close>
 
 (* TODO: Generalise to real vector spaces? *)
 proposition convex_on_imp_above_tangent:
   assumes convex: "convex_on A f" and connected: "connected A"
   assumes c: "c \<in> interior A" and x : "x \<in> A"
   assumes deriv: "(f has_field_derivative f') (at c within A)"
   shows   "f x - f c \<ge> f' * (x - c)"
 proof (cases x c rule: linorder_cases)
   assume xc: "x > c"
   let ?A' = "interior A \<inter> {c<..}"
   from c have "c \<in> interior A \<inter> closure {c<..}" by auto
   also have "\<dots> \<subseteq> closure (interior A \<inter> {c<..})" by (intro open_Int_closure_subset) auto
   finally have "at c within ?A' \<noteq> bot" by (subst at_within_eq_bot_iff) auto
   moreover from deriv have "((\<lambda>y. (f y - f c) / (y - c)) \<longlongrightarrow> f') (at c within ?A')"
     unfolding has_field_derivative_iff using interior_subset[of A] by (blast intro: tendsto_mono at_le)
   moreover from eventually_at_right_real[OF xc]
     have "eventually (\<lambda>y. (f y - f c) / (y - c) \<le> (f x - f c) / (x - c)) (at_right c)"
   proof eventually_elim
     fix y assume y: "y \<in> {c<..<x}"
     with convex connected x c have "f y \<le> (f x - f c) / (x - c) * (y - c) + f c"
       using interior_subset[of A]
       by (intro convex_onD_Icc' convex_on_subset[OF convex] connected_contains_Icc) auto
     hence "f y - f c \<le> (f x - f c) / (x - c) * (y - c)" by simp
     thus "(f y - f c) / (y - c) \<le> (f x - f c) / (x - c)" using y xc by (simp add: field_split_simps)
   qed
   hence "eventually (\<lambda>y. (f y - f c) / (y - c) \<le> (f x - f c) / (x - c)) (at c within ?A')"
     by (blast intro: filter_leD at_le)
   ultimately have "f' \<le> (f x - f c) / (x - c)" by (simp add: tendsto_upperbound)
   thus ?thesis using xc by (simp add: field_simps)
 next
   assume xc: "x < c"
   let ?A' = "interior A \<inter> {..<c}"
   from c have "c \<in> interior A \<inter> closure {..<c}" by auto
   also have "\<dots> \<subseteq> closure (interior A \<inter> {..<c})" by (intro open_Int_closure_subset) auto
   finally have "at c within ?A' \<noteq> bot" by (subst at_within_eq_bot_iff) auto
   moreover from deriv have "((\<lambda>y. (f y - f c) / (y - c)) \<longlongrightarrow> f') (at c within ?A')"
     unfolding has_field_derivative_iff using interior_subset[of A] by (blast intro: tendsto_mono at_le)
   moreover from eventually_at_left_real[OF xc]
     have "eventually (\<lambda>y. (f y - f c) / (y - c) \<ge> (f x - f c) / (x - c)) (at_left c)"
   proof eventually_elim
     fix y assume y: "y \<in> {x<..<c}"
     with convex connected x c have "f y \<le> (f x - f c) / (c - x) * (c - y) + f c"
       using interior_subset[of A]
       by (intro convex_onD_Icc'' convex_on_subset[OF convex] connected_contains_Icc) auto
     hence "f y - f c \<le> (f x - f c) * ((c - y) / (c - x))" by simp
     also have "(c - y) / (c - x) = (y - c) / (x - c)" using y xc by (simp add: field_simps)
     finally show "(f y - f c) / (y - c) \<ge> (f x - f c) / (x - c)" using y xc
       by (simp add: field_split_simps)
   qed
   hence "eventually (\<lambda>y. (f y - f c) / (y - c) \<ge> (f x - f c) / (x - c)) (at c within ?A')"
     by (blast intro: filter_leD at_le)
   ultimately have "f' \<ge> (f x - f c) / (x - c)" by (simp add: tendsto_lowerbound)
   thus ?thesis using xc by (simp add: field_simps)
 qed simp_all
 
 
 subsection \<open>Partial derivatives\<close>
 
 lemma eventually_at_Pair_within_TimesI1:
   fixes x::"'a::metric_space"
   assumes "\<forall>\<^sub>F x' in at x within X. P x'"
   assumes "P x"
   shows "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. P x'"
 proof -
   from assms[unfolded eventually_at_topological]
   obtain S where S: "open S" "x \<in> S" "\<And>x'. x' \<in> X \<Longrightarrow> x' \<in> S \<Longrightarrow> P x'"
     by metis
   show "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. P x'"
     unfolding eventually_at_topological
     by (auto intro!: exI[where x="S \<times> UNIV"] S open_Times)
 qed
 
 lemma eventually_at_Pair_within_TimesI2:
   fixes x::"'a::metric_space"
   assumes "\<forall>\<^sub>F y' in at y within Y. P y'" "P y"
   shows "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. P y'"
 proof -
   from assms[unfolded eventually_at_topological]
   obtain S where S: "open S" "y \<in> S" "\<And>y'. y' \<in> Y \<Longrightarrow> y' \<in> S \<Longrightarrow> P y'"
     by metis
   show "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. P y'"
     unfolding eventually_at_topological
     by (auto intro!: exI[where x="UNIV \<times> S"] S open_Times)
 qed
 
 proposition has_derivative_partialsI:
   fixes f::"'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector \<Rightarrow> 'c::real_normed_vector"
   assumes fx: "((\<lambda>x. f x y) has_derivative fx) (at x within X)"
   assumes fy: "\<And>x y. x \<in> X \<Longrightarrow> y \<in> Y \<Longrightarrow> ((\<lambda>y. f x y) has_derivative blinfun_apply (fy x y)) (at y within Y)"
   assumes fy_cont[unfolded continuous_within]: "continuous (at (x, y) within X \<times> Y) (\<lambda>(x, y). fy x y)"
   assumes "y \<in> Y" "convex Y"
   shows "((\<lambda>(x, y). f x y) has_derivative (\<lambda>(tx, ty). fx tx + fy x y ty)) (at (x, y) within X \<times> Y)"
 proof (safe intro!: has_derivativeI tendstoI, goal_cases)
   case (2 e')
   interpret fx: bounded_linear "fx" using fx by (rule has_derivative_bounded_linear)
   define e where "e = e' / 9"
   have "e > 0" using \<open>e' > 0\<close> by (simp add: e_def)
 
   from fy_cont[THEN tendstoD, OF \<open>e > 0\<close>]
   have "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. dist (fy x' y') (fy x y) < e"
     by (auto simp: split_beta')
   from this[unfolded eventually_at] obtain d' where
     "d' > 0"
     "\<And>x' y'. x' \<in> X \<Longrightarrow> y' \<in> Y \<Longrightarrow> (x', y') \<noteq> (x, y) \<Longrightarrow> dist (x', y') (x, y) < d' \<Longrightarrow>
       dist (fy x' y') (fy x y) < e"
     by auto
   then
   have d': "x' \<in> X \<Longrightarrow> y' \<in> Y \<Longrightarrow> dist (x', y') (x, y) < d' \<Longrightarrow> dist (fy x' y') (fy x y) < e"
     for x' y'
     using \<open>0 < e\<close>
     by (cases "(x', y') = (x, y)") auto
   define d where "d = d' / sqrt 2"
   have "d > 0" using \<open>0 < d'\<close> by (simp add: d_def)
   have d: "x' \<in> X \<Longrightarrow> y' \<in> Y \<Longrightarrow> dist x' x < d \<Longrightarrow> dist y' y < d \<Longrightarrow> dist (fy x' y') (fy x y) < e"
     for x' y'
     by (auto simp: dist_prod_def d_def intro!: d' real_sqrt_sum_squares_less)
 
   let ?S = "ball y d \<inter> Y"
   have "convex ?S"
     by (auto intro!: convex_Int \<open>convex Y\<close>)
   {
     fix x'::'a and y'::'b
     assume x': "x' \<in> X" and y': "y' \<in> Y"
     assume dx': "dist x' x < d" and dy': "dist y' y < d"
     have "norm (fy x' y' - fy x' y) \<le> dist (fy x' y') (fy x y) + dist (fy x' y) (fy x y)"
       by norm
     also have "dist (fy x' y') (fy x y) < e"
       by (rule d; fact)
     also have "dist (fy x' y) (fy x y) < e"
       by (auto intro!: d simp: dist_prod_def x' \<open>d > 0\<close> \<open>y \<in> Y\<close> dx')
     finally
     have "norm (fy x' y' - fy x' y) < e + e"
       by arith
     then have "onorm (blinfun_apply (fy x' y') - blinfun_apply (fy x' y)) < e + e"
       by (auto simp: norm_blinfun.rep_eq blinfun.diff_left[abs_def] fun_diff_def)
   } note onorm = this
 
   have ev_mem: "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. (x', y') \<in> X \<times> Y"
     using \<open>y \<in> Y\<close>
     by (auto simp: eventually_at intro!: zero_less_one)
   moreover
   have ev_dist: "\<forall>\<^sub>F xy in at (x, y) within X \<times> Y. dist xy (x, y) < d" if "d > 0" for d
     using eventually_at_ball[OF that]
     by (rule eventually_elim2) (auto simp: dist_commute mem_ball intro!: eventually_True)
   note ev_dist[OF \<open>0 < d\<close>]
   ultimately
   have "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y.
     norm (f x' y' - f x' y - (fy x' y) (y' - y)) \<le> norm (y' - y) * (e + e)"
   proof (eventually_elim, safe)
     fix x' y'
     assume "x' \<in> X" and y': "y' \<in> Y"
     assume dist: "dist (x', y') (x, y) < d"
     then have dx: "dist x' x < d" and dy: "dist y' y < d"
       unfolding dist_prod_def fst_conv snd_conv atomize_conj
       by (metis le_less_trans real_sqrt_sum_squares_ge1 real_sqrt_sum_squares_ge2)
     {
       fix t::real
       assume "t \<in> {0 .. 1}"
       then have "y + t *\<^sub>R (y' - y) \<in> closed_segment y y'"
         by (auto simp: closed_segment_def algebra_simps intro!: exI[where x=t])
       also
       have "\<dots> \<subseteq> ball y d \<inter> Y"
         using \<open>y \<in> Y\<close> \<open>0 < d\<close> dy y'
         by (intro \<open>convex ?S\<close>[unfolded convex_contains_segment, rule_format, of y y'])
           (auto simp: dist_commute)
       finally have "y + t *\<^sub>R (y' - y) \<in> ?S" .
     } note seg = this
 
     have "\<And>x. x \<in> ball y d \<inter> Y \<Longrightarrow> onorm (blinfun_apply (fy x' x) - blinfun_apply (fy x' y)) \<le> e + e"
       by (safe intro!: onorm less_imp_le \<open>x' \<in> X\<close> dx) (auto simp: dist_commute \<open>0 < d\<close> \<open>y \<in> Y\<close>)
     with seg has_derivative_within_subset[OF assms(2)[OF \<open>x' \<in> X\<close>]]
     show "norm (f x' y' - f x' y - (fy x' y) (y' - y)) \<le> norm (y' - y) * (e + e)"
       by (rule differentiable_bound_linearization[where S="?S"])
         (auto intro!: \<open>0 < d\<close> \<open>y \<in> Y\<close>)
   qed
   moreover
   let ?le = "\<lambda>x'. norm (f x' y - f x y - (fx) (x' - x)) \<le> norm (x' - x) * e"
   from fx[unfolded has_derivative_within, THEN conjunct2, THEN tendstoD, OF \<open>0 < e\<close>]
   have "\<forall>\<^sub>F x' in at x within X. ?le x'"
     by eventually_elim (simp, 
       simp add: dist_norm field_split_simps split: if_split_asm)
   then have "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. ?le x'"
     by (rule eventually_at_Pair_within_TimesI1)
        (simp add: blinfun.bilinear_simps)
   moreover have "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. norm ((x', y') - (x, y)) \<noteq> 0"
     unfolding norm_eq_zero right_minus_eq
     by (auto simp: eventually_at intro!: zero_less_one)
   moreover
   from fy_cont[THEN tendstoD, OF \<open>0 < e\<close>]
   have "\<forall>\<^sub>F x' in at x within X. norm (fy x' y - fy x y) < e"
     unfolding eventually_at
     using \<open>y \<in> Y\<close>
     by (auto simp: dist_prod_def dist_norm)
   then have "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. norm (fy x' y - fy x y) < e"
     by (rule eventually_at_Pair_within_TimesI1)
        (simp add: blinfun.bilinear_simps \<open>0 < e\<close>)
   ultimately
   have "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y.
             norm ((f x' y' - f x y - (fx (x' - x) + fy x y (y' - y))) /\<^sub>R
               norm ((x', y') - (x, y)))
             < e'"
     apply eventually_elim
   proof safe
     fix x' y'
     have "norm (f x' y' - f x y - (fx (x' - x) + fy x y (y' - y))) \<le>
         norm (f x' y' - f x' y - fy x' y (y' - y)) +
         norm (fy x y (y' - y) - fy x' y (y' - y)) +
         norm (f x' y - f x y - fx (x' - x))"
       by norm
     also
     assume nz: "norm ((x', y') - (x, y)) \<noteq> 0"
       and nfy: "norm (fy x' y - fy x y) < e"
     assume "norm (f x' y' - f x' y - blinfun_apply (fy x' y) (y' - y)) \<le> norm (y' - y) * (e + e)"
     also assume "norm (f x' y - f x y - (fx) (x' - x)) \<le> norm (x' - x) * e"
     also
     have "norm ((fy x y) (y' - y) - (fy x' y) (y' - y)) \<le> norm ((fy x y) - (fy x' y)) * norm (y' - y)"
       by (auto simp: blinfun.bilinear_simps[symmetric] intro!: norm_blinfun)
     also have "\<dots> \<le> (e + e) * norm (y' - y)"
       using \<open>e > 0\<close> nfy
       by (auto simp: norm_minus_commute intro!: mult_right_mono)
     also have "norm (x' - x) * e \<le> norm (x' - x) * (e + e)"
       using \<open>0 < e\<close> by simp
     also have "norm (y' - y) * (e + e) + (e + e) * norm (y' - y) + norm (x' - x) * (e + e) \<le>
         (norm (y' - y) + norm (x' - x)) * (4 * e)"
       using \<open>e > 0\<close>
       by (simp add: algebra_simps)
     also have "\<dots> \<le> 2 * norm ((x', y') - (x, y)) * (4 * e)"
       using \<open>0 < e\<close> real_sqrt_sum_squares_ge1[of "norm (x' - x)" "norm (y' - y)"]
         real_sqrt_sum_squares_ge2[of "norm (y' - y)" "norm (x' - x)"]
       by (auto intro!: mult_right_mono simp: norm_prod_def
         simp del: real_sqrt_sum_squares_ge1 real_sqrt_sum_squares_ge2)
     also have "\<dots> \<le> norm ((x', y') - (x, y)) * (8 * e)"
       by simp
     also have "\<dots> < norm ((x', y') - (x, y)) * e'"
       using \<open>0 < e'\<close> nz
       by (auto simp: e_def)
     finally show "norm ((f x' y' - f x y - (fx (x' - x) + fy x y (y' - y))) /\<^sub>R norm ((x', y') - (x, y))) < e'"
       by (simp add: dist_norm) (auto simp add: field_split_simps)
   qed
   then show ?case
     by eventually_elim (auto simp: dist_norm field_simps)
 next
   from has_derivative_bounded_linear[OF fx]
   obtain fxb where "fx = blinfun_apply fxb"
     by (metis bounded_linear_Blinfun_apply)
   then show "bounded_linear (\<lambda>(tx, ty). fx tx + blinfun_apply (fy x y) ty)"
     by (auto intro!: bounded_linear_intros simp: split_beta')
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Differentiable case distinction\<close>
 
 lemma has_derivative_within_If_eq:
   "((\<lambda>x. if P x then f x else g x) has_derivative f') (at x within S) =
     (bounded_linear f' \<and>
      ((\<lambda>y.(if P y then (f y - ((if P x then f x else g x) + f' (y - x)))/\<^sub>R norm (y - x)
            else (g y - ((if P x then f x else g x) + f' (y - x)))/\<^sub>R norm (y - x)))
       \<longlongrightarrow> 0) (at x within S))"
   (is "_ = (_ \<and> (?if \<longlongrightarrow> 0) _)")
 proof -
   have "(\<lambda>y. (1 / norm (y - x)) *\<^sub>R
            ((if P y then f y else g y) -
             ((if P x then f x else g x) + f' (y - x)))) = ?if"
     by (auto simp: inverse_eq_divide)
   thus ?thesis by (auto simp: has_derivative_within)
 qed
 
 lemma has_derivative_If_within_closures:
   assumes f': "x \<in> S \<union> (closure S \<inter> closure T) \<Longrightarrow>
     (f has_derivative f' x) (at x within S \<union> (closure S \<inter> closure T))"
   assumes g': "x \<in> T \<union> (closure S \<inter> closure T) \<Longrightarrow>
     (g has_derivative g' x) (at x within T \<union> (closure S \<inter> closure T))"
   assumes connect: "x \<in> closure S \<Longrightarrow> x \<in> closure T \<Longrightarrow> f x = g x"
   assumes connect': "x \<in> closure S \<Longrightarrow> x \<in> closure T \<Longrightarrow> f' x = g' x"
   assumes x_in: "x \<in> S \<union> T"
   shows "((\<lambda>x. if x \<in> S then f x else g x) has_derivative
       (if x \<in> S then f' x else g' x)) (at x within (S \<union> T))"
 proof -
   from f' x_in interpret f': bounded_linear "if x \<in> S then f' x else (\<lambda>x. 0)"
     by (auto simp add: has_derivative_within)
   from g' interpret g': bounded_linear "if x \<in> T then g' x else (\<lambda>x. 0)"
     by (auto simp add: has_derivative_within)
   have bl: "bounded_linear (if x \<in> S then f' x else g' x)"
     using f'.scaleR f'.bounded f'.add g'.scaleR g'.bounded g'.add x_in
     by (unfold_locales; force)
   show ?thesis
     using f' g' closure_subset[of T] closure_subset[of S]
     unfolding has_derivative_within_If_eq
     by (intro conjI bl tendsto_If_within_closures x_in)
       (auto simp: has_derivative_within inverse_eq_divide connect connect' subsetD)
 qed
 
 lemma has_vector_derivative_If_within_closures:
   assumes x_in: "x \<in> S \<union> T"
   assumes "u = S \<union> T"
   assumes f': "x \<in> S \<union> (closure S \<inter> closure T) \<Longrightarrow>
     (f has_vector_derivative f' x) (at x within S \<union> (closure S \<inter> closure T))"
   assumes g': "x \<in> T \<union> (closure S \<inter> closure T) \<Longrightarrow>
     (g has_vector_derivative g' x) (at x within T \<union> (closure S \<inter> closure T))"
   assumes connect: "x \<in> closure S \<Longrightarrow> x \<in> closure T \<Longrightarrow> f x = g x"
   assumes connect': "x \<in> closure S \<Longrightarrow> x \<in> closure T \<Longrightarrow> f' x = g' x"
   shows "((\<lambda>x. if x \<in> S then f x else g x) has_vector_derivative
     (if x \<in> S then f' x else g' x)) (at x within u)"
   unfolding has_vector_derivative_def assms
   using x_in
   apply (intro has_derivative_If_within_closures[where ?f' = "\<lambda>x a. a *\<^sub>R f' x" and ?g' = "\<lambda>x a. a *\<^sub>R g' x",
         THEN has_derivative_eq_rhs])
   subgoal by (rule f'[unfolded has_vector_derivative_def]; assumption)
   subgoal by (rule g'[unfolded has_vector_derivative_def]; assumption)
   by (auto simp: assms)
 
 subsection\<^marker>\<open>tag important\<close>\<open>The Inverse Function Theorem\<close>
 
 lemma linear_injective_contraction:
   assumes "linear f" "c < 1" and le: "\<And>x. norm (f x - x) \<le> c * norm x"
   shows "inj f"
   unfolding linear_injective_0[OF \<open>linear f\<close>]
 proof safe
   fix x
   assume "f x = 0"
   with le [of x] have "norm x \<le> c * norm x"
     by simp
   then show "x = 0"
     using \<open>c < 1\<close> by (simp add: mult_le_cancel_right1)
 qed
 
 text\<open>From an online proof by J. Michael Boardman, Department of Mathematics, Johns Hopkins University\<close>
 lemma inverse_function_theorem_scaled:
   fixes f::"'a::euclidean_space \<Rightarrow> 'a"
     and f'::"'a \<Rightarrow> ('a \<Rightarrow>\<^sub>L 'a)"
   assumes "open U"
     and derf: "\<And>x. x \<in> U \<Longrightarrow> (f has_derivative blinfun_apply (f' x)) (at x)"
     and contf: "continuous_on U f'"
     and "0 \<in> U" and [simp]: "f 0 = 0"
     and id: "f' 0 = id_blinfun"
   obtains U' V g g' where "open U'" "U' \<subseteq> U" "0 \<in> U'" "open V" "0 \<in> V" "homeomorphism U' V f g"
                 "\<And>y. y \<in> V \<Longrightarrow> (g has_derivative (g' y)) (at y)"
                 "\<And>y. y \<in> V \<Longrightarrow> g' y = inv (blinfun_apply (f'(g y)))"
                 "\<And>y. y \<in> V \<Longrightarrow> bij (blinfun_apply (f'(g y)))"
 proof -
   obtain d1 where "cball 0 d1 \<subseteq> U" "d1 > 0"
     using \<open>open U\<close> \<open>0 \<in> U\<close> open_contains_cball by blast
   obtain d2 where d2: "\<And>x. \<lbrakk>x \<in> U; dist x 0 \<le> d2\<rbrakk> \<Longrightarrow> dist (f' x) (f' 0) < 1/2" "0 < d2"
     using continuous_onE [OF contf, of 0 "1/2"] by (metis \<open>0 \<in> U\<close> half_gt_zero_iff zero_less_one)
   obtain \<delta> where le: "\<And>x. norm x \<le> \<delta> \<Longrightarrow> dist (f' x) id_blinfun \<le> 1/2" and "0 < \<delta>"
     and subU: "cball 0 \<delta> \<subseteq> U"
   proof
     show "min d1 d2 > 0"
       by (simp add: \<open>0 < d1\<close> \<open>0 < d2\<close>)
     show "cball 0 (min d1 d2) \<subseteq> U"
       using \<open>cball 0 d1 \<subseteq> U\<close> by auto
     show "dist (f' x) id_blinfun \<le> 1/2" if "norm x \<le> min d1 d2" for x
       using \<open>cball 0 d1 \<subseteq> U\<close> d2 that id by fastforce
   qed
   let ?D = "cball 0 \<delta>"
   define V:: "'a set" where "V \<equiv> ball 0 (\<delta>/2)"
   have 4: "norm (f (x + h) - f x - h) \<le> 1/2 * norm h"
     if "x \<in> ?D" "x+h \<in> ?D" for x h
   proof -
     let ?w = "\<lambda>x. f x - x"
     have B: "\<And>x. x \<in> ?D \<Longrightarrow> onorm (blinfun_apply (f' x - id_blinfun)) \<le> 1/2"
       by (metis dist_norm le mem_cball_0 norm_blinfun.rep_eq)
     have "\<And>x. x \<in> ?D \<Longrightarrow> (?w has_derivative (blinfun_apply (f' x - id_blinfun))) (at x)"
       by (rule derivative_eq_intros derf subsetD [OF subU] | force simp: blinfun.diff_left)+
     then have Dw: "\<And>x. x \<in> ?D \<Longrightarrow> (?w has_derivative (blinfun_apply (f' x - id_blinfun))) (at x within ?D)"
       using has_derivative_at_withinI by blast
     have "norm (?w (x+h) - ?w x) \<le> (1/2) * norm h"
       using differentiable_bound [OF convex_cball Dw B] that by fastforce
     then show ?thesis
       by (auto simp: algebra_simps)
   qed
   have for_g: "\<exists>!x. norm x < \<delta> \<and> f x = y" if y: "norm y < \<delta>/2" for y
   proof -
     let ?u = "\<lambda>x. x + (y - f x)"
     have *: "norm (?u x) < \<delta>" if "x \<in> ?D" for x
     proof -
       have fxx: "norm (f x - x) \<le> \<delta>/2"
         using 4 [of 0 x] \<open>0 < \<delta>\<close> \<open>f 0 = 0\<close> that by auto
       have "norm (?u x) \<le> norm y + norm (f x - x)"
         by (metis add.commute add_diff_eq norm_minus_commute norm_triangle_ineq)
       also have "\<dots> < \<delta>/2 + \<delta>/2"
         using fxx y by auto
       finally show ?thesis
         by simp
     qed
     have "\<exists>!x \<in> ?D. ?u x = x"
     proof (rule banach_fix)
       show "cball 0 \<delta> \<noteq> {}"
         using \<open>0 < \<delta>\<close> by auto
       show "(\<lambda>x. x + (y - f x)) ` cball 0 \<delta> \<subseteq> cball 0 \<delta>"
         using * by force
       have "dist (x + (y - f x)) (xh + (y - f xh)) * 2 \<le> dist x xh"
         if "norm x \<le> \<delta>" and "norm xh \<le> \<delta>" for x xh
         using that 4 [of x "xh-x"] by (auto simp: dist_norm norm_minus_commute algebra_simps)
       then show "\<forall>x\<in>cball 0 \<delta>. \<forall>ya\<in>cball 0 \<delta>. dist (x + (y - f x)) (ya + (y - f ya)) \<le> (1/2) * dist x ya"
         by auto
     qed (auto simp: complete_eq_closed)
     then show ?thesis
       by (metis "*" add_cancel_right_right eq_iff_diff_eq_0 le_less mem_cball_0)
   qed
   define g where "g \<equiv> \<lambda>y. THE x. norm x < \<delta> \<and> f x = y"
   have g: "norm (g y) < \<delta> \<and> f (g y) = y" if "norm y < \<delta>/2" for y
     unfolding g_def using that theI' [OF for_g] by meson
   then have fg[simp]: "f (g y) = y" if "y \<in> V" for y
     using that by (auto simp: V_def)
   have 5: "norm (g y' - g y) \<le> 2 * norm (y' - y)" if "y \<in> V" "y' \<in> V" for y y'
   proof -
     have no: "norm (g y) \<le> \<delta>" "norm (g y') \<le> \<delta>" and [simp]: "f (g y) = y"
       using that g unfolding V_def by force+
     have "norm (g y' - g y) \<le> norm (g y' - g y - (y' - y)) + norm (y' - y)"
       by (simp add: add.commute norm_triangle_sub)
     also have "\<dots> \<le> (1/2) * norm (g y' - g y) + norm (y' - y)"
       using 4 [of "g y" "g y' - g y"] that no by (simp add: g norm_minus_commute V_def)
     finally show ?thesis
       by auto
   qed
   have contg: "continuous_on V g"
   proof
     fix y::'a and e::real
     assume "0 < e" and y: "y \<in> V"
     show "\<exists>d>0. \<forall>x'\<in>V. dist x' y < d \<longrightarrow> dist (g x') (g y) \<le> e"
     proof (intro exI conjI ballI impI)
       show "0 < e/2"
         by (simp add: \<open>0 < e\<close>)
     qed (use 5 y in \<open>force simp: dist_norm\<close>)
   qed
   show thesis
   proof
     define U' where "U' \<equiv> (f -` V) \<inter> ball 0 \<delta>"
     have contf: "continuous_on U f"
       using derf has_derivative_at_withinI by (fast intro: has_derivative_continuous_on)
     then have "continuous_on (ball 0 \<delta>) f"
       by (meson ball_subset_cball continuous_on_subset subU)
     then show "open U'"
       by (simp add: U'_def V_def Int_commute continuous_open_preimage)
     show "0 \<in> U'" "U' \<subseteq> U" "open V" "0 \<in> V"
       using \<open>0 < \<delta>\<close> subU by (auto simp: U'_def V_def)
     show hom: "homeomorphism U' V f g"
     proof
       show "continuous_on U' f"
         using \<open>U' \<subseteq> U\<close> contf continuous_on_subset by blast
       show "continuous_on V g"
         using contg by blast
       show "f ` U' \<subseteq> V"
         using U'_def by blast
       show "g ` V \<subseteq> U'"
         by (simp add: U'_def V_def g image_subset_iff)
       show "g (f x) = x" if "x \<in> U'" for x
         by (metis that fg Int_iff U'_def V_def for_g g mem_ball_0 vimage_eq)
       show "f (g y) = y" if "y \<in> V" for y
         using that by (simp add: g V_def)
     qed
     show bij: "bij (blinfun_apply (f'(g y)))" if "y \<in> V" for y
     proof -
       have inj: "inj (blinfun_apply (f' (g y)))"
       proof (rule linear_injective_contraction)
         show "linear (blinfun_apply (f' (g y)))"
           using blinfun.bounded_linear_right bounded_linear_def by blast
       next
         fix x
         have "norm (blinfun_apply (f' (g y)) x - x) = norm (blinfun_apply (f' (g y) - id_blinfun) x)"
           by (simp add: blinfun.diff_left)
         also have "\<dots> \<le> norm (f' (g y) - id_blinfun) * norm x"
           by (rule norm_blinfun)
         also have "\<dots> \<le> (1/2) * norm x"
         proof (rule mult_right_mono)
           show "norm (f' (g y) - id_blinfun) \<le> 1/2"
             using that g [of y] le by (auto simp: V_def dist_norm)
         qed auto
         finally show "norm (blinfun_apply (f' (g y)) x - x) \<le> (1/2) * norm x" .
       qed auto
       moreover
       have "surj (blinfun_apply (f' (g y)))"
         using blinfun.bounded_linear_right bounded_linear_def
         by (blast intro!: linear_inj_imp_surj [OF _ inj])
       ultimately show ?thesis
         using bijI by blast
     qed
     define g' where "g' \<equiv> \<lambda>y. inv (blinfun_apply (f'(g y)))"
     show "(g has_derivative g' y) (at y)" if "y \<in> V" for y
     proof -
       have gy: "g y \<in> U"
         using g subU that unfolding V_def by fastforce
       obtain e where e: "\<And>h. f (g y + h) = y + blinfun_apply (f' (g y)) h + e h"
         and e0: "(\<lambda>h. norm (e h) / norm h) \<midarrow>0\<rightarrow> 0"
         using iffD1 [OF has_derivative_iff_Ex derf [OF gy]] \<open>y \<in> V\<close> by auto
       have [simp]: "e 0 = 0"
         using e [of 0] that by simp
       let ?INV = "inv (blinfun_apply (f' (g y)))"
       have inj: "inj (blinfun_apply (f' (g y)))"
         using bij bij_betw_def that by blast
       have "(g has_derivative g' y) (at y within V)"
         unfolding has_derivative_at_within_iff_Ex [OF \<open>y \<in> V\<close> \<open>open V\<close>]
       proof
         show blinv: "bounded_linear (g' y)"
           unfolding g'_def using derf gy inj inj_linear_imp_inv_bounded_linear by blast
         define eg where "eg \<equiv> \<lambda>k. - ?INV (e (g (y+k) - g y))"
         have "g (y+k) = g y + g' y k + eg k" if "y + k \<in> V" for k
         proof -
           have "?INV k = ?INV (blinfun_apply (f' (g y)) (g (y+k) - g y) + e (g (y+k) - g y))"
             using e [of "g(y+k) - g y"] that by simp
           then have "g (y+k) = g y + ?INV k - ?INV (e (g (y+k) - g y))"
             using inj blinv by (simp add: linear_simps g'_def)
           then show ?thesis
             by (auto simp: eg_def g'_def)
         qed
         moreover have "(\<lambda>k. norm (eg k) / norm k) \<midarrow>0\<rightarrow> 0"
         proof (rule Lim_null_comparison)
           let ?g = "\<lambda>k. 2 * onorm ?INV * norm (e (g (y+k) - g y)) / norm (g (y+k) - g y)"
           show "\<forall>\<^sub>F k in at 0. norm (norm (eg k) / norm k) \<le> ?g k"
             unfolding eventually_at_topological
           proof (intro exI conjI ballI impI)
             show "open ((+)(-y) ` V)"
               using \<open>open V\<close> open_translation by blast
             show "0 \<in> (+)(-y) ` V"
               by (simp add: that)
             show "norm (norm (eg k) / norm k) \<le> 2 * onorm (inv (blinfun_apply (f' (g y)))) * norm (e (g (y+k) - g y)) / norm (g (y+k) - g y)"
               if "k \<in> (+)(-y) ` V" "k \<noteq> 0" for k
             proof -
               have "y+k \<in> V"
                 using that by auto
               have "norm (norm (eg k) / norm k) \<le> onorm ?INV * norm (e (g (y+k) - g y)) / norm k"
                 using blinv g'_def onorm by (force simp: eg_def divide_simps)
               also have "\<dots> = (norm (g (y+k) - g y) / norm k) * (onorm ?INV * (norm (e (g (y+k) - g y)) / norm (g (y+k) - g y)))"
                 by (simp add: divide_simps)
               also have "\<dots> \<le> 2 * (onorm ?INV * (norm (e (g (y+k) - g y)) / norm (g (y+k) - g y)))"
                 apply (rule mult_right_mono)
                 using 5 [of y "y+k"] \<open>y \<in> V\<close> \<open>y + k \<in> V\<close>  onorm_pos_le [OF blinv]
                  apply (auto simp: divide_simps zero_le_mult_iff zero_le_divide_iff g'_def)
                 done
               finally show "norm (norm (eg k) / norm k) \<le> 2 * onorm ?INV * norm (e (g (y+k) - g y)) / norm (g (y+k) - g y)"
                 by simp
             qed
           qed
           have 1: "(\<lambda>h. norm (e h) / norm h) \<midarrow>0\<rightarrow> (norm (e 0) / norm 0)"
             using e0 by auto
           have 2: "(\<lambda>k. g (y+k) - g y) \<midarrow>0\<rightarrow> 0"
             using contg \<open>open V\<close> \<open>y \<in> V\<close> LIM_offset_zero_iff LIM_zero_iff at_within_open continuous_on_def by fastforce
           from tendsto_compose [OF 1 2, simplified]
           have "(\<lambda>k. norm (e (g (y+k) - g y)) / norm (g (y+k) - g y)) \<midarrow>0\<rightarrow> 0" .
           from tendsto_mult_left [OF this] show "?g \<midarrow>0\<rightarrow> 0" by auto
         qed
         ultimately show "\<exists>e. (\<forall>k. y + k \<in> V \<longrightarrow> g (y+k) = g y + g' y k + e k) \<and> (\<lambda>k. norm (e k) / norm k) \<midarrow>0\<rightarrow> 0"
           by blast
       qed
       then show ?thesis
         by (metis \<open>open V\<close> at_within_open that)
     qed
     show "g' y = inv (blinfun_apply (f' (g y)))"
       if "y \<in> V" for y
       by (simp add: g'_def)
   qed
 qed
 
 
 text\<open>We need all this to justify the scaling and translations.\<close>
 theorem inverse_function_theorem:
   fixes f::"'a::euclidean_space \<Rightarrow> 'a"
     and f'::"'a \<Rightarrow> ('a \<Rightarrow>\<^sub>L 'a)"
   assumes "open U"
     and derf: "\<And>x. x \<in> U \<Longrightarrow> (f has_derivative (blinfun_apply (f' x))) (at x)"
     and contf:  "continuous_on U f'"
     and "x0 \<in> U"
     and invf: "invf o\<^sub>L f' x0 = id_blinfun"
   obtains U' V g g' where "open U'" "U' \<subseteq> U" "x0 \<in> U'" "open V" "f x0 \<in> V" "homeomorphism U' V f g"
     "\<And>y. y \<in> V \<Longrightarrow> (g has_derivative (g' y)) (at y)"
     "\<And>y. y \<in> V \<Longrightarrow> g' y = inv (blinfun_apply (f'(g y)))"
     "\<And>y. y \<in> V \<Longrightarrow> bij (blinfun_apply (f'(g y)))"
 proof -
   have apply1 [simp]: "\<And>i. blinfun_apply invf (blinfun_apply (f' x0) i) = i"
     by (metis blinfun_apply_blinfun_compose blinfun_apply_id_blinfun invf)
   have apply2 [simp]: "\<And>i. blinfun_apply (f' x0) (blinfun_apply invf i) = i"
     by (metis apply1 bij_inv_eq_iff blinfun_bij1 invf)
   have [simp]: "(range (blinfun_apply invf)) = UNIV"
     using apply1 surjI by blast
   let ?f = "invf \<circ> (\<lambda>x. (f \<circ> (+)x0)x - f x0)"
   let ?f' = "\<lambda>x. invf o\<^sub>L (f' (x + x0))"
   obtain U' V g g' where "open U'" and U': "U' \<subseteq> (+)(-x0) ` U" "0 \<in> U'"
     and "open V" "0 \<in> V" and hom: "homeomorphism U' V ?f g"
     and derg: "\<And>y. y \<in> V \<Longrightarrow> (g has_derivative (g' y)) (at y)"
     and g': "\<And>y. y \<in> V \<Longrightarrow> g' y = inv (?f'(g y))"
     and bij: "\<And>y. y \<in> V \<Longrightarrow> bij (?f'(g y))"
   proof (rule inverse_function_theorem_scaled [of "(+)(-x0) ` U" ?f "?f'"])
     show ope: "open ((+) (- x0) ` U)"
       using \<open>open U\<close> open_translation by blast
     show "(?f has_derivative blinfun_apply (?f' x)) (at x)"
       if "x \<in> (+) (- x0) ` U" for x
       using that
       apply clarify
       apply (rule derf derivative_eq_intros | simp add: blinfun_compose.rep_eq)+
       done
     have YY: "(\<lambda>x. f' (x + x0)) \<midarrow>u-x0\<rightarrow> f' u"
       if "f' \<midarrow>u\<rightarrow> f' u" "u \<in> U" for u
       using that LIM_offset [where k = x0] by (auto simp: algebra_simps)
     then have "continuous_on ((+) (- x0) ` U) (\<lambda>x. f' (x + x0))"
       using contf \<open>open U\<close> Lim_at_imp_Lim_at_within
       by (fastforce simp: continuous_on_def at_within_open_NO_MATCH ope)
     then show "continuous_on ((+) (- x0) ` U) ?f'"
       by (intro continuous_intros) simp
   qed (auto simp: invf \<open>x0 \<in> U\<close>)
   show thesis
   proof
     let ?U' = "(+)x0 ` U'"
     let ?V = "((+)(f x0) \<circ> f' x0) ` V"
     let ?g = "(+)x0 \<circ> g \<circ> invf \<circ> (+)(- f x0)"
     let ?g' = "\<lambda>y. inv (blinfun_apply (f' (?g y)))"
     show oU': "open ?U'"
       by (simp add: \<open>open U'\<close> open_translation)
     show subU: "?U' \<subseteq> U"
       using ComplI \<open>U' \<subseteq> (+) (- x0) ` U\<close> by auto
     show "x0 \<in> ?U'"
       by (simp add: \<open>0 \<in> U'\<close>)
     show "open ?V"
       using blinfun_bij2 [OF invf]
       by (metis \<open>open V\<close> bij_is_surj blinfun.bounded_linear_right bounded_linear_def image_comp open_surjective_linear_image open_translation)
     show "f x0 \<in> ?V"
       using \<open>0 \<in> V\<close> image_iff by fastforce
     show "homeomorphism ?U' ?V f ?g"
     proof
       show "continuous_on ?U' f"
         by (meson subU continuous_on_eq_continuous_at derf has_derivative_continuous oU' subsetD)
       have "?f ` U' \<subseteq> V"
         using hom homeomorphism_image1 by blast
       then show "f ` ?U' \<subseteq> ?V"
         unfolding image_subset_iff
         by (clarsimp simp: image_def) (metis apply2 add.commute diff_add_cancel)
       show "?g ` ?V \<subseteq> ?U'"
         using hom invf by (auto simp: image_def homeomorphism_def)
       show "?g (f x) = x"
         if "x \<in> ?U'" for x
         using that hom homeomorphism_apply1 by fastforce
       have "continuous_on V g"
         using hom homeomorphism_def by blast
       then show "continuous_on ?V ?g"
         by (intro continuous_intros) (auto elim!: continuous_on_subset)
       have fg: "?f (g x) = x" if "x \<in> V" for x
         using hom homeomorphism_apply2 that by blast
       show "f (?g y) = y"
         if "y \<in> ?V" for y
         using that fg by (simp add: image_iff) (metis apply2 add.commute diff_add_cancel)
     qed
     show "(?g has_derivative ?g' y) (at y)" "bij (blinfun_apply (f' (?g y)))"
       if "y \<in> ?V" for y
     proof -
       have 1: "bij (blinfun_apply invf)"
         using blinfun_bij1 invf by blast
       then have 2: "bij (blinfun_apply (f' (x0 + g x)))" if "x \<in> V" for x
         by (metis add.commute bij bij_betw_comp_iff2 blinfun_compose.rep_eq that top_greatest)
       then show "bij (blinfun_apply (f' (?g y)))"
         using that by auto
       have "g' x \<circ> blinfun_apply invf = inv (blinfun_apply (f' (x0 + g x)))"
         if "x \<in> V" for x
         using that
         by (simp add: g' o_inv_distrib blinfun_compose.rep_eq 1 2 add.commute bij_is_inj flip: o_assoc)
       then show "(?g has_derivative ?g' y) (at y)"
         using that invf
         by clarsimp (rule derg derivative_eq_intros | simp flip: id_def)+
     qed
   qed auto
 qed
 
 end
diff --git a/src/HOL/Analysis/Starlike.thy b/src/HOL/Analysis/Starlike.thy
--- a/src/HOL/Analysis/Starlike.thy
+++ b/src/HOL/Analysis/Starlike.thy
@@ -1,7684 +1,7079 @@
 (* Title:      HOL/Analysis/Starlike.thy
    Author:     L C Paulson, University of Cambridge
    Author:     Robert Himmelmann, TU Muenchen
    Author:     Bogdan Grechuk, University of Edinburgh
    Author:     Armin Heller, TU Muenchen
    Author:     Johannes Hoelzl, TU Muenchen
 *)
 chapter \<open>Unsorted\<close>
 
 theory Starlike
 imports Convex_Euclidean_Space Abstract_Limits
 begin
 
-section \<open>Line Segments\<close>
-
-subsection \<open>Midpoint\<close>
-
-definition\<^marker>\<open>tag important\<close> midpoint :: "'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a"
-  where "midpoint a b = (inverse (2::real)) *\<^sub>R (a + b)"
-
-lemma midpoint_idem [simp]: "midpoint x x = x"
-  unfolding midpoint_def  by simp
-
-lemma midpoint_sym: "midpoint a b = midpoint b a"
-  unfolding midpoint_def by (auto simp add: scaleR_right_distrib)
-
-lemma midpoint_eq_iff: "midpoint a b = c \<longleftrightarrow> a + b = c + c"
-proof -
-  have "midpoint a b = c \<longleftrightarrow> scaleR 2 (midpoint a b) = scaleR 2 c"
-    by simp
-  then show ?thesis
-    unfolding midpoint_def scaleR_2 [symmetric] by simp
-qed
-
-lemma
-  fixes a::real
-  assumes "a \<le> b" shows ge_midpoint_1: "a \<le> midpoint a b"
-                    and le_midpoint_1: "midpoint a b \<le> b"
-  by (simp_all add: midpoint_def assms)
-
-lemma dist_midpoint:
-  fixes a b :: "'a::real_normed_vector" shows
-  "dist a (midpoint a b) = (dist a b) / 2" (is ?t1)
-  "dist b (midpoint a b) = (dist a b) / 2" (is ?t2)
-  "dist (midpoint a b) a = (dist a b) / 2" (is ?t3)
-  "dist (midpoint a b) b = (dist a b) / 2" (is ?t4)
-proof -
-  have *: "\<And>x y::'a. 2 *\<^sub>R x = - y \<Longrightarrow> norm x = (norm y) / 2"
-    unfolding equation_minus_iff by auto
-  have **: "\<And>x y::'a. 2 *\<^sub>R x =   y \<Longrightarrow> norm x = (norm y) / 2"
-    by auto
-  note scaleR_right_distrib [simp]
-  show ?t1
-    unfolding midpoint_def dist_norm
-    apply (rule **)
-    apply (simp add: scaleR_right_diff_distrib)
-    apply (simp add: scaleR_2)
-    done
-  show ?t2
-    unfolding midpoint_def dist_norm
-    apply (rule *)
-    apply (simp add: scaleR_right_diff_distrib)
-    apply (simp add: scaleR_2)
-    done
-  show ?t3
-    unfolding midpoint_def dist_norm
-    apply (rule *)
-    apply (simp add: scaleR_right_diff_distrib)
-    apply (simp add: scaleR_2)
-    done
-  show ?t4
-    unfolding midpoint_def dist_norm
-    apply (rule **)
-    apply (simp add: scaleR_right_diff_distrib)
-    apply (simp add: scaleR_2)
-    done
-qed
-
-lemma midpoint_eq_endpoint [simp]:
-  "midpoint a b = a \<longleftrightarrow> a = b"
-  "midpoint a b = b \<longleftrightarrow> a = b"
-  unfolding midpoint_eq_iff by auto
-
-lemma midpoint_plus_self [simp]: "midpoint a b + midpoint a b = a + b"
-  using midpoint_eq_iff by metis
-
-lemma midpoint_linear_image:
-   "linear f \<Longrightarrow> midpoint(f a)(f b) = f(midpoint a b)"
-by (simp add: linear_iff midpoint_def)
-
-
-subsection \<open>Line segments\<close>
-
-definition\<^marker>\<open>tag important\<close> closed_segment :: "'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a set"
-  where "closed_segment a b = {(1 - u) *\<^sub>R a + u *\<^sub>R b | u::real. 0 \<le> u \<and> u \<le> 1}"
-
-definition\<^marker>\<open>tag important\<close> open_segment :: "'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a set" where
-  "open_segment a b \<equiv> closed_segment a b - {a,b}"
-
-lemmas segment = open_segment_def closed_segment_def
-
-lemma in_segment:
-    "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)"
-    "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)"
-  using less_eq_real_def by (auto simp: segment algebra_simps)
-
-lemma closed_segment_linear_image:
-  "closed_segment (f a) (f b) = f ` (closed_segment a b)" if "linear f"
-proof -
-  interpret linear f by fact
-  show ?thesis
-    by (force simp add: in_segment add scale)
-qed
-
-lemma open_segment_linear_image:
-    "\<lbrakk>linear f; inj f\<rbrakk> \<Longrightarrow> open_segment (f a) (f b) = f ` (open_segment a b)"
-  by (force simp: open_segment_def closed_segment_linear_image inj_on_def)
-
-lemma closed_segment_translation:
-    "closed_segment (c + a) (c + b) = image (\<lambda>x. c + x) (closed_segment a b)"
-apply safe
-apply (rule_tac x="x-c" in image_eqI)
-apply (auto simp: in_segment algebra_simps)
-done
-
-lemma open_segment_translation:
-    "open_segment (c + a) (c + b) = image (\<lambda>x. c + x) (open_segment a b)"
-by (simp add: open_segment_def closed_segment_translation translation_diff)
-
-lemma closed_segment_of_real:
-    "closed_segment (of_real x) (of_real y) = of_real ` closed_segment x y"
-  apply (auto simp: image_iff in_segment scaleR_conv_of_real)
-    apply (rule_tac x="(1-u)*x + u*y" in bexI)
-  apply (auto simp: in_segment)
-  done
-
-lemma open_segment_of_real:
-    "open_segment (of_real x) (of_real y) = of_real ` open_segment x y"
-  apply (auto simp: image_iff in_segment scaleR_conv_of_real)
-    apply (rule_tac x="(1-u)*x + u*y" in bexI)
-  apply (auto simp: in_segment)
-  done
-
-lemma closed_segment_Reals:
-    "\<lbrakk>x \<in> Reals; y \<in> Reals\<rbrakk> \<Longrightarrow> closed_segment x y = of_real ` closed_segment (Re x) (Re y)"
-  by (metis closed_segment_of_real of_real_Re)
-
-lemma open_segment_Reals:
-    "\<lbrakk>x \<in> Reals; y \<in> Reals\<rbrakk> \<Longrightarrow> open_segment x y = of_real ` open_segment (Re x) (Re y)"
-  by (metis open_segment_of_real of_real_Re)
-
-lemma open_segment_PairD:
-    "(x, x') \<in> open_segment (a, a') (b, b')
-     \<Longrightarrow> (x \<in> open_segment a b \<or> a = b) \<and> (x' \<in> open_segment a' b' \<or> a' = b')"
-  by (auto simp: in_segment)
-
-lemma closed_segment_PairD:
-  "(x, x') \<in> closed_segment (a, a') (b, b') \<Longrightarrow> x \<in> closed_segment a b \<and> x' \<in> closed_segment a' b'"
-  by (auto simp: closed_segment_def)
-
-lemma closed_segment_translation_eq [simp]:
-    "d + x \<in> closed_segment (d + a) (d + b) \<longleftrightarrow> x \<in> closed_segment a b"
-proof -
-  have *: "\<And>d x a b. x \<in> closed_segment a b \<Longrightarrow> d + x \<in> closed_segment (d + a) (d + b)"
-    apply (simp add: closed_segment_def)
-    apply (erule ex_forward)
-    apply (simp add: algebra_simps)
-    done
-  show ?thesis
-  using * [where d = "-d"] *
-  by (fastforce simp add:)
-qed
-
-lemma open_segment_translation_eq [simp]:
-    "d + x \<in> open_segment (d + a) (d + b) \<longleftrightarrow> x \<in> open_segment a b"
-  by (simp add: open_segment_def)
-
-lemma of_real_closed_segment [simp]:
-  "of_real x \<in> closed_segment (of_real a) (of_real b) \<longleftrightarrow> x \<in> closed_segment a b"
-  apply (auto simp: in_segment scaleR_conv_of_real elim!: ex_forward)
-  using of_real_eq_iff by fastforce
-
-lemma of_real_open_segment [simp]:
-  "of_real x \<in> open_segment (of_real a) (of_real b) \<longleftrightarrow> x \<in> open_segment a b"
-  apply (auto simp: in_segment scaleR_conv_of_real elim!: ex_forward del: exE)
-  using of_real_eq_iff by fastforce
-
-lemma convex_contains_segment:
-  "convex S \<longleftrightarrow> (\<forall>a\<in>S. \<forall>b\<in>S. closed_segment a b \<subseteq> S)"
-  unfolding convex_alt closed_segment_def by auto
-
-lemma closed_segment_in_Reals:
-   "\<lbrakk>x \<in> closed_segment a b; a \<in> Reals; b \<in> Reals\<rbrakk> \<Longrightarrow> x \<in> Reals"
-  by (meson subsetD convex_Reals convex_contains_segment)
-
-lemma open_segment_in_Reals:
-   "\<lbrakk>x \<in> open_segment a b; a \<in> Reals; b \<in> Reals\<rbrakk> \<Longrightarrow> x \<in> Reals"
-  by (metis Diff_iff closed_segment_in_Reals open_segment_def)
-
-lemma closed_segment_subset: "\<lbrakk>x \<in> S; y \<in> S; convex S\<rbrakk> \<Longrightarrow> closed_segment x y \<subseteq> S"
-  by (simp add: convex_contains_segment)
-
-lemma closed_segment_subset_convex_hull:
-    "\<lbrakk>x \<in> convex hull S; y \<in> convex hull S\<rbrakk> \<Longrightarrow> closed_segment x y \<subseteq> convex hull S"
-  using convex_contains_segment by blast
-
-lemma segment_convex_hull:
-  "closed_segment a b = convex hull {a,b}"
-proof -
-  have *: "\<And>x. {x} \<noteq> {}" by auto
-  show ?thesis
-    unfolding segment convex_hull_insert[OF *] convex_hull_singleton
-    by (safe; rule_tac x="1 - u" in exI; force)
-qed
-
-lemma open_closed_segment: "u \<in> open_segment w z \<Longrightarrow> u \<in> closed_segment w z"
-  by (auto simp add: closed_segment_def open_segment_def)
-
-lemma segment_open_subset_closed:
-   "open_segment a b \<subseteq> closed_segment a b"
-  by (auto simp: closed_segment_def open_segment_def)
-
-lemma bounded_closed_segment:
-    fixes a :: "'a::euclidean_space" shows "bounded (closed_segment a b)"
-  by (simp add: segment_convex_hull compact_convex_hull compact_imp_bounded)
-
-lemma bounded_open_segment:
-    fixes a :: "'a::euclidean_space" shows "bounded (open_segment a b)"
-  by (rule bounded_subset [OF bounded_closed_segment segment_open_subset_closed])
-
-lemmas bounded_segment = bounded_closed_segment open_closed_segment
-
-lemma ends_in_segment [iff]: "a \<in> closed_segment a b" "b \<in> closed_segment a b"
-  unfolding segment_convex_hull
-  by (auto intro!: hull_subset[unfolded subset_eq, rule_format])
-
-lemma eventually_closed_segment:
-  fixes x0::"'a::real_normed_vector"
-  assumes "open X0" "x0 \<in> X0"
-  shows "\<forall>\<^sub>F x in at x0 within U. closed_segment x0 x \<subseteq> X0"
-proof -
-  from openE[OF assms]
-  obtain e where e: "0 < e" "ball x0 e \<subseteq> X0" .
-  then have "\<forall>\<^sub>F x in at x0 within U. x \<in> ball x0 e"
-    by (auto simp: dist_commute eventually_at)
-  then show ?thesis
-  proof eventually_elim
-    case (elim x)
-    have "x0 \<in> ball x0 e" using \<open>e > 0\<close> by simp
-    from convex_ball[unfolded convex_contains_segment, rule_format, OF this elim]
-    have "closed_segment x0 x \<subseteq> ball x0 e" .
-    also note \<open>\<dots> \<subseteq> X0\<close>
-    finally show ?case .
-  qed
-qed
-
-lemma segment_furthest_le:
-  fixes a b x y :: "'a::euclidean_space"
-  assumes "x \<in> closed_segment a b"
-  shows "norm (y - x) \<le> norm (y - a) \<or>  norm (y - x) \<le> norm (y - b)"
-proof -
-  obtain z where "z \<in> {a, b}" "norm (x - y) \<le> norm (z - y)"
-    using simplex_furthest_le[of "{a, b}" y]
-    using assms[unfolded segment_convex_hull]
-    by auto
-  then show ?thesis
-    by (auto simp add:norm_minus_commute)
-qed
-
-lemma closed_segment_commute: "closed_segment a b = closed_segment b a"
-proof -
-  have "{a, b} = {b, a}" by auto
-  thus ?thesis
-    by (simp add: segment_convex_hull)
-qed
-
-lemma segment_bound1:
-  assumes "x \<in> closed_segment a b"
-  shows "norm (x - a) \<le> norm (b - a)"
-proof -
-  obtain u where "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" "0 \<le> u" "u \<le> 1"
-    using assms by (auto simp add: closed_segment_def)
-  then show "norm (x - a) \<le> norm (b - a)"
-    apply clarify
-    apply (auto simp: algebra_simps)
-    apply (simp add: scaleR_diff_right [symmetric] mult_left_le_one_le)
-    done
-qed
-
-lemma segment_bound:
-  assumes "x \<in> closed_segment a b"
-  shows "norm (x - a) \<le> norm (b - a)" "norm (x - b) \<le> norm (b - a)"
-apply (simp add: assms segment_bound1)
-by (metis assms closed_segment_commute dist_commute dist_norm segment_bound1)
-
-lemma open_segment_commute: "open_segment a b = open_segment b a"
-proof -
-  have "{a, b} = {b, a}" by auto
-  thus ?thesis
-    by (simp add: closed_segment_commute open_segment_def)
-qed
-
-lemma closed_segment_idem [simp]: "closed_segment a a = {a}"
-  unfolding segment by (auto simp add: algebra_simps)
-
-lemma open_segment_idem [simp]: "open_segment a a = {}"
-  by (simp add: open_segment_def)
-
-lemma closed_segment_eq_open: "closed_segment a b = open_segment a b \<union> {a,b}"
-  using open_segment_def by auto
-
-lemma convex_contains_open_segment:
-  "convex s \<longleftrightarrow> (\<forall>a\<in>s. \<forall>b\<in>s. open_segment a b \<subseteq> s)"
-  by (simp add: convex_contains_segment closed_segment_eq_open)
-
-lemma closed_segment_eq_real_ivl:
-  fixes a b::real
-  shows "closed_segment a b = (if a \<le> b then {a .. b} else {b .. a})"
-proof -
-  have "b \<le> a \<Longrightarrow> closed_segment b a = {b .. a}"
-    and "a \<le> b \<Longrightarrow> closed_segment a b = {a .. b}"
-    by (auto simp: convex_hull_eq_real_cbox segment_convex_hull)
-  thus ?thesis
-    by (auto simp: closed_segment_commute)
-qed
-
-lemma open_segment_eq_real_ivl:
-  fixes a b::real
-  shows "open_segment a b = (if a \<le> b then {a<..<b} else {b<..<a})"
-by (auto simp: closed_segment_eq_real_ivl open_segment_def split: if_split_asm)
-
-lemma closed_segment_real_eq:
-  fixes u::real shows "closed_segment u v = (\<lambda>x. (v - u) * x + u) ` {0..1}"
-  by (simp add: add.commute [of u] image_affinity_atLeastAtMost [where c=u] closed_segment_eq_real_ivl)
-
-lemma dist_in_closed_segment:
-  fixes a :: "'a :: euclidean_space"
-  assumes "x \<in> closed_segment a b"
-    shows "dist x a \<le> dist a b \<and> dist x b \<le> dist a b"
-proof (intro conjI)
-  obtain u where u: "0 \<le> u" "u \<le> 1" and x: "x = (1 - u) *\<^sub>R a + u *\<^sub>R b"
-    using assms by (force simp: in_segment algebra_simps)
-  have "dist x a = u * dist a b"
-    apply (simp add: dist_norm algebra_simps x)
-    by (metis \<open>0 \<le> u\<close> abs_of_nonneg norm_minus_commute norm_scaleR real_vector.scale_right_diff_distrib)
-  also have "...  \<le> dist a b"
-    by (simp add: mult_left_le_one_le u)
-  finally show "dist x a \<le> dist a b" .
-  have "dist x b = norm ((1-u) *\<^sub>R a - (1-u) *\<^sub>R b)"
-    by (simp add: dist_norm algebra_simps x)
-  also have "... = (1-u) * dist a b"
-  proof -
-    have "norm ((1 - 1 * u) *\<^sub>R (a - b)) = (1 - 1 * u) * norm (a - b)"
-      using \<open>u \<le> 1\<close> by force
-    then show ?thesis
-      by (simp add: dist_norm real_vector.scale_right_diff_distrib)
-  qed
-  also have "... \<le> dist a b"
-    by (simp add: mult_left_le_one_le u)
-  finally show "dist x b \<le> dist a b" .
-qed
-
-lemma dist_in_open_segment:
-  fixes a :: "'a :: euclidean_space"
-  assumes "x \<in> open_segment a b"
-    shows "dist x a < dist a b \<and> dist x b < dist a b"
-proof (intro conjI)
-  obtain u where u: "0 < u" "u < 1" and x: "x = (1 - u) *\<^sub>R a + u *\<^sub>R b"
-    using assms by (force simp: in_segment algebra_simps)
-  have "dist x a = u * dist a b"
-    apply (simp add: dist_norm algebra_simps x)
-    by (metis abs_of_nonneg less_eq_real_def norm_minus_commute norm_scaleR real_vector.scale_right_diff_distrib \<open>0 < u\<close>)
-  also have *: "...  < dist a b"
-    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>)
-  finally show "dist x a < dist a b" .
-  have ab_ne0: "dist a b \<noteq> 0"
-    using * by fastforce
-  have "dist x b = norm ((1-u) *\<^sub>R a - (1-u) *\<^sub>R b)"
-    by (simp add: dist_norm algebra_simps x)
-  also have "... = (1-u) * dist a b"
-  proof -
-    have "norm ((1 - 1 * u) *\<^sub>R (a - b)) = (1 - 1 * u) * norm (a - b)"
-      using \<open>u < 1\<close> by force
-    then show ?thesis
-      by (simp add: dist_norm real_vector.scale_right_diff_distrib)
-  qed
-  also have "... < dist a b"
-    using ab_ne0 \<open>0 < u\<close> by simp
-  finally show "dist x b < dist a b" .
-qed
-
-lemma dist_decreases_open_segment_0:
-  fixes x :: "'a :: euclidean_space"
-  assumes "x \<in> open_segment 0 b"
-    shows "dist c x < dist c 0 \<or> dist c x < dist c b"
-proof (rule ccontr, clarsimp simp: not_less)
-  obtain u where u: "0 \<noteq> b" "0 < u" "u < 1" and x: "x = u *\<^sub>R b"
-    using assms by (auto simp: in_segment)
-  have xb: "x \<bullet> b < b \<bullet> b"
-    using u x by auto
-  assume "norm c \<le> dist c x"
-  then have "c \<bullet> c \<le> (c - x) \<bullet> (c - x)"
-    by (simp add: dist_norm norm_le)
-  moreover have "0 < x \<bullet> b"
-    using u x by auto
-  ultimately have less: "c \<bullet> b < x \<bullet> b"
-    by (simp add: x algebra_simps inner_commute u)
-  assume "dist c b \<le> dist c x"
-  then have "(c - b) \<bullet> (c - b) \<le> (c - x) \<bullet> (c - x)"
-    by (simp add: dist_norm norm_le)
-  then have "(b \<bullet> b) * (1 - u*u) \<le> 2 * (b \<bullet> c) * (1-u)"
-    by (simp add: x algebra_simps inner_commute)
-  then have "(1+u) * (b \<bullet> b) * (1-u) \<le> 2 * (b \<bullet> c) * (1-u)"
-    by (simp add: algebra_simps)
-  then have "(1+u) * (b \<bullet> b) \<le> 2 * (b \<bullet> c)"
-    using \<open>u < 1\<close> by auto
-  with xb have "c \<bullet> b \<ge> x \<bullet> b"
-    by (auto simp: x algebra_simps inner_commute)
-  with less show False by auto
-qed
-
-proposition dist_decreases_open_segment:
-  fixes a :: "'a :: euclidean_space"
-  assumes "x \<in> open_segment a b"
-    shows "dist c x < dist c a \<or> dist c x < dist c b"
-proof -
-  have *: "x - a \<in> open_segment 0 (b - a)" using assms
-    by (metis diff_self open_segment_translation_eq uminus_add_conv_diff)
-  show ?thesis
-    using dist_decreases_open_segment_0 [OF *, of "c-a"] assms
-    by (simp add: dist_norm)
-qed
-
-corollary open_segment_furthest_le:
-  fixes a b x y :: "'a::euclidean_space"
-  assumes "x \<in> open_segment a b"
-  shows "norm (y - x) < norm (y - a) \<or>  norm (y - x) < norm (y - b)"
-  by (metis assms dist_decreases_open_segment dist_norm)
-
-corollary dist_decreases_closed_segment:
-  fixes a :: "'a :: euclidean_space"
-  assumes "x \<in> closed_segment a b"
-    shows "dist c x \<le> dist c a \<or> dist c x \<le> dist c b"
-apply (cases "x \<in> open_segment a b")
- using dist_decreases_open_segment less_eq_real_def apply blast
-by (metis DiffI assms empty_iff insertE open_segment_def order_refl)
-
-lemma convex_intermediate_ball:
-  fixes a :: "'a :: euclidean_space"
-  shows "\<lbrakk>ball a r \<subseteq> T; T \<subseteq> cball a r\<rbrakk> \<Longrightarrow> convex T"
-apply (simp add: convex_contains_open_segment, clarify)
-by (metis (no_types, hide_lams) less_le_trans mem_ball mem_cball subsetCE dist_decreases_open_segment)
-
-lemma csegment_midpoint_subset: "closed_segment (midpoint a b) b \<subseteq> closed_segment a b"
-  apply (clarsimp simp: midpoint_def in_segment)
-  apply (rule_tac x="(1 + u) / 2" in exI)
-  apply (auto simp: algebra_simps add_divide_distrib diff_divide_distrib)
-  by (metis field_sum_of_halves scaleR_left.add)
-
-lemma notin_segment_midpoint:
-  fixes a :: "'a :: euclidean_space"
-  shows "a \<noteq> b \<Longrightarrow> a \<notin> closed_segment (midpoint a b) b"
-by (auto simp: dist_midpoint dest!: dist_in_closed_segment)
-
-lemma segment_to_closest_point:
-  fixes S :: "'a :: euclidean_space set"
-  shows "\<lbrakk>closed S; S \<noteq> {}\<rbrakk> \<Longrightarrow> open_segment a (closest_point S a) \<inter> S = {}"
-  apply (subst disjoint_iff_not_equal)
-  apply (clarify dest!: dist_in_open_segment)
-  by (metis closest_point_le dist_commute le_less_trans less_irrefl)
-
-lemma segment_to_point_exists:
-  fixes S :: "'a :: euclidean_space set"
-    assumes "closed S" "S \<noteq> {}"
-    obtains b where "b \<in> S" "open_segment a b \<inter> S = {}"
-  by (metis assms segment_to_closest_point closest_point_exists that)
-
-subsubsection\<open>More lemmas, especially for working with the underlying formula\<close>
-
-lemma segment_eq_compose:
-  fixes a :: "'a :: real_vector"
-  shows "(\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) = (\<lambda>x. a + x) o (\<lambda>u. u *\<^sub>R (b - a))"
-    by (simp add: o_def algebra_simps)
-
-lemma segment_degen_1:
-  fixes a :: "'a :: real_vector"
-  shows "(1 - u) *\<^sub>R a + u *\<^sub>R b = b \<longleftrightarrow> a=b \<or> u=1"
-proof -
-  { assume "(1 - u) *\<^sub>R a + u *\<^sub>R b = b"
-    then have "(1 - u) *\<^sub>R a = (1 - u) *\<^sub>R b"
-      by (simp add: algebra_simps)
-    then have "a=b \<or> u=1"
-      by simp
-  } then show ?thesis
-      by (auto simp: algebra_simps)
-qed
-
-lemma segment_degen_0:
-    fixes a :: "'a :: real_vector"
-    shows "(1 - u) *\<^sub>R a + u *\<^sub>R b = a \<longleftrightarrow> a=b \<or> u=0"
-  using segment_degen_1 [of "1-u" b a]
-  by (auto simp: algebra_simps)
-
-lemma add_scaleR_degen:
-  fixes a b ::"'a::real_vector"
-  assumes  "(u *\<^sub>R b + v *\<^sub>R a) = (u *\<^sub>R a + v *\<^sub>R b)"  "u \<noteq> v"
-  shows "a=b"
-  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)
-  
-lemma closed_segment_image_interval:
-     "closed_segment a b = (\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) ` {0..1}"
-  by (auto simp: set_eq_iff image_iff closed_segment_def)
-
-lemma open_segment_image_interval:
-     "open_segment a b = (if a=b then {} else (\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) ` {0<..<1})"
-  by (auto simp:  open_segment_def closed_segment_def segment_degen_0 segment_degen_1)
-
-lemmas segment_image_interval = closed_segment_image_interval open_segment_image_interval
-
-lemma open_segment_bound1:
-  assumes "x \<in> open_segment a b"
-  shows "norm (x - a) < norm (b - a)"
-proof -
-  obtain u where "x = (1 - u) *\<^sub>R a + u *\<^sub>R b" "0 < u" "u < 1" "a \<noteq> b"
-    using assms by (auto simp add: open_segment_image_interval split: if_split_asm)
-  then show "norm (x - a) < norm (b - a)"
-    apply clarify
-    apply (auto simp: algebra_simps)
-    apply (simp add: scaleR_diff_right [symmetric])
-    done
-qed
-
-lemma compact_segment [simp]:
-  fixes a :: "'a::real_normed_vector"
-  shows "compact (closed_segment a b)"
-  by (auto simp: segment_image_interval intro!: compact_continuous_image continuous_intros)
-
-lemma closed_segment [simp]:
-  fixes a :: "'a::real_normed_vector"
-  shows "closed (closed_segment a b)"
-  by (simp add: compact_imp_closed)
-
-lemma closure_closed_segment [simp]:
-  fixes a :: "'a::real_normed_vector"
-  shows "closure(closed_segment a b) = closed_segment a b"
-  by simp
-
-lemma open_segment_bound:
-  assumes "x \<in> open_segment a b"
-  shows "norm (x - a) < norm (b - a)" "norm (x - b) < norm (b - a)"
-apply (simp add: assms open_segment_bound1)
-by (metis assms norm_minus_commute open_segment_bound1 open_segment_commute)
-
-lemma closure_open_segment [simp]:
-  "closure (open_segment a b) = (if a = b then {} else closed_segment a b)"
-    for a :: "'a::euclidean_space"
-proof (cases "a = b")
-  case True
-  then show ?thesis
-    by simp
-next
-  case False
-  have "closure ((\<lambda>u. u *\<^sub>R (b - a)) ` {0<..<1}) = (\<lambda>u. u *\<^sub>R (b - a)) ` closure {0<..<1}"
-    apply (rule closure_injective_linear_image [symmetric])
-     apply (use False in \<open>auto intro!: injI\<close>)
-    done
-  then have "closure
-     ((\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) ` {0<..<1}) =
-    (\<lambda>x. (1 - x) *\<^sub>R a + x *\<^sub>R b) ` closure {0<..<1}"
-    using closure_translation [of a "((\<lambda>x. x *\<^sub>R b - x *\<^sub>R a) ` {0<..<1})"]
-    by (simp add: segment_eq_compose field_simps scaleR_diff_left scaleR_diff_right image_image)
-  then show ?thesis
-    by (simp add: segment_image_interval closure_greaterThanLessThan [symmetric] del: closure_greaterThanLessThan)
-qed
-
-lemma closed_open_segment_iff [simp]:
-    fixes a :: "'a::euclidean_space"  shows "closed(open_segment a b) \<longleftrightarrow> a = b"
-  by (metis open_segment_def DiffE closure_eq closure_open_segment ends_in_segment(1) insert_iff segment_image_interval(2))
-
-lemma compact_open_segment_iff [simp]:
-    fixes a :: "'a::euclidean_space"  shows "compact(open_segment a b) \<longleftrightarrow> a = b"
-  by (simp add: bounded_open_segment compact_eq_bounded_closed)
-
-lemma convex_closed_segment [iff]: "convex (closed_segment a b)"
-  unfolding segment_convex_hull by(rule convex_convex_hull)
-
-lemma convex_open_segment [iff]: "convex (open_segment a b)"
-proof -
-  have "convex ((\<lambda>u. u *\<^sub>R (b - a)) ` {0<..<1})"
-    by (rule convex_linear_image) auto
-  then have "convex ((+) a ` (\<lambda>u. u *\<^sub>R (b - a)) ` {0<..<1})"
-    by (rule convex_translation)
-  then show ?thesis
-    by (simp add: image_image open_segment_image_interval segment_eq_compose field_simps scaleR_diff_left scaleR_diff_right)
-qed
-
-lemmas convex_segment = convex_closed_segment convex_open_segment
-
-lemma connected_segment [iff]:
-  fixes x :: "'a :: real_normed_vector"
-  shows "connected (closed_segment x y)"
-  by (simp add: convex_connected)
-
-lemma is_interval_closed_segment_1[intro, simp]: "is_interval (closed_segment a b)" for a b::real
-  by (auto simp: is_interval_convex_1)
-
-lemma IVT'_closed_segment_real:
-  fixes f :: "real \<Rightarrow> real"
-  assumes "y \<in> closed_segment (f a) (f b)"
-  assumes "continuous_on (closed_segment a b) f"
-  shows "\<exists>x \<in> closed_segment a b. f x = y"
-  using IVT'[of f a y b]
-    IVT'[of "-f" a "-y" b]
-    IVT'[of f b y a]
-    IVT'[of "-f" b "-y" a] assms
-  by (cases "a \<le> b"; cases "f b \<ge> f a") (auto simp: closed_segment_eq_real_ivl continuous_on_minus)
-
-
 subsection\<open>Starlike sets\<close>
 
 definition\<^marker>\<open>tag important\<close> "starlike S \<longleftrightarrow> (\<exists>a\<in>S. \<forall>x\<in>S. closed_segment a x \<subseteq> S)"
 
 lemma starlike_UNIV [simp]: "starlike UNIV"
   by (simp add: starlike_def)
 
 lemma convex_imp_starlike:
   "convex S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> starlike S"
   unfolding convex_contains_segment starlike_def by auto
 
 
 lemma affine_hull_closed_segment [simp]:
      "affine hull (closed_segment a b) = affine hull {a,b}"
   by (simp add: segment_convex_hull)
 
 lemma affine_hull_open_segment [simp]:
     fixes a :: "'a::euclidean_space"
     shows "affine hull (open_segment a b) = (if a = b then {} else affine hull {a,b})"
 by (metis affine_hull_convex_hull affine_hull_empty closure_open_segment closure_same_affine_hull segment_convex_hull)
 
 lemma rel_interior_closure_convex_segment:
   fixes S :: "_::euclidean_space set"
   assumes "convex S" "a \<in> rel_interior S" "b \<in> closure S"
     shows "open_segment a b \<subseteq> rel_interior S"
 proof
   fix x
   have [simp]: "(1 - u) *\<^sub>R a + u *\<^sub>R b = b - (1 - u) *\<^sub>R (b - a)" for u
     by (simp add: algebra_simps)
   assume "x \<in> open_segment a b"
   then show "x \<in> rel_interior S"
     unfolding closed_segment_def open_segment_def  using assms
     by (auto intro: rel_interior_closure_convex_shrink)
 qed
 
 lemma convex_hull_insert_segments:
    "convex hull (insert a S) =
     (if S = {} then {a} else  \<Union>x \<in> convex hull S. closed_segment a x)"
   by (force simp add: convex_hull_insert_alt in_segment)
 
 lemma Int_convex_hull_insert_rel_exterior:
   fixes z :: "'a::euclidean_space"
   assumes "convex C" "T \<subseteq> C" and z: "z \<in> rel_interior C" and dis: "disjnt S (rel_interior C)"
   shows "S \<inter> (convex hull (insert z T)) = S \<inter> (convex hull T)" (is "?lhs = ?rhs")
 proof
   have "T = {} \<Longrightarrow> z \<notin> S"
     using dis z by (auto simp add: disjnt_def)
   then show "?lhs \<subseteq> ?rhs"
   proof (clarsimp simp add: convex_hull_insert_segments)
     fix x y
     assume "x \<in> S" and y: "y \<in> convex hull T" and "x \<in> closed_segment z y"
     have "y \<in> closure C"
       by (metis y \<open>convex C\<close> \<open>T \<subseteq> C\<close> closure_subset contra_subsetD convex_hull_eq hull_mono)
     moreover have "x \<notin> rel_interior C"
       by (meson \<open>x \<in> S\<close> dis disjnt_iff)
     moreover have "x \<in> open_segment z y \<union> {z, y}"
       using \<open>x \<in> closed_segment z y\<close> closed_segment_eq_open by blast
     ultimately show "x \<in> convex hull T"
       using rel_interior_closure_convex_segment [OF \<open>convex C\<close> z]
       using y z by blast
   qed
   show "?rhs \<subseteq> ?lhs"
     by (meson hull_mono inf_mono subset_insertI subset_refl)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>More results about segments\<close>
 
 lemma dist_half_times2:
   fixes a :: "'a :: real_normed_vector"
   shows "dist ((1 / 2) *\<^sub>R (a + b)) x * 2 = dist (a+b) (2 *\<^sub>R x)"
 proof -
   have "norm ((1 / 2) *\<^sub>R (a + b) - x) * 2 = norm (2 *\<^sub>R ((1 / 2) *\<^sub>R (a + b) - x))"
     by simp
   also have "... = norm ((a + b) - 2 *\<^sub>R x)"
     by (simp add: real_vector.scale_right_diff_distrib)
   finally show ?thesis
     by (simp only: dist_norm)
 qed
 
 lemma closed_segment_as_ball:
     "closed_segment a b = affine hull {a,b} \<inter> cball(inverse 2 *\<^sub>R (a + b))(norm(b - a) / 2)"
 proof (cases "b = a")
   case True then show ?thesis by (auto simp: hull_inc)
 next
   case False
   then have *: "((\<exists>u v. x = u *\<^sub>R a + v *\<^sub>R b \<and> u + v = 1) \<and>
                   dist ((1 / 2) *\<^sub>R (a + b)) x * 2 \<le> norm (b - a)) =
                  (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> u \<and> u \<le> 1)" for x
   proof -
     have "((\<exists>u v. x = u *\<^sub>R a + v *\<^sub>R b \<and> u + v = 1) \<and>
                   dist ((1 / 2) *\<^sub>R (a + b)) x * 2 \<le> norm (b - a)) =
           ((\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b) \<and>
                   dist ((1 / 2) *\<^sub>R (a + b)) x * 2 \<le> norm (b - a))"
       unfolding eq_diff_eq [symmetric] by simp
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
                           norm ((a+b) - (2 *\<^sub>R x)) \<le> norm (b - a))"
       by (simp add: dist_half_times2) (simp add: dist_norm)
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
             norm ((a+b) - (2 *\<^sub>R ((1 - u) *\<^sub>R a + u *\<^sub>R b))) \<le> norm (b - a))"
       by auto
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
                 norm ((1 - u * 2) *\<^sub>R (b - a)) \<le> norm (b - a))"
       by (simp add: algebra_simps scaleR_2)
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
                           \<bar>1 - u * 2\<bar> * norm (b - a) \<le> norm (b - a))"
       by simp
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> \<bar>1 - u * 2\<bar> \<le> 1)"
       by (simp add: mult_le_cancel_right2 False)
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> u \<and> u \<le> 1)"
       by auto
     finally show ?thesis .
   qed
   show ?thesis
     by (simp add: affine_hull_2 Set.set_eq_iff closed_segment_def *)
 qed
 
 lemma open_segment_as_ball:
     "open_segment a b =
      affine hull {a,b} \<inter> ball(inverse 2 *\<^sub>R (a + b))(norm(b - a) / 2)"
 proof (cases "b = a")
   case True then show ?thesis by (auto simp: hull_inc)
 next
   case False
   then have *: "((\<exists>u v. x = u *\<^sub>R a + v *\<^sub>R b \<and> u + v = 1) \<and>
                   dist ((1 / 2) *\<^sub>R (a + b)) x * 2 < norm (b - a)) =
                  (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 < u \<and> u < 1)" for x
   proof -
     have "((\<exists>u v. x = u *\<^sub>R a + v *\<^sub>R b \<and> u + v = 1) \<and>
                   dist ((1 / 2) *\<^sub>R (a + b)) x * 2 < norm (b - a)) =
           ((\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b) \<and>
                   dist ((1 / 2) *\<^sub>R (a + b)) x * 2 < norm (b - a))"
       unfolding eq_diff_eq [symmetric] by simp
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
                           norm ((a+b) - (2 *\<^sub>R x)) < norm (b - a))"
       by (simp add: dist_half_times2) (simp add: dist_norm)
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
             norm ((a+b) - (2 *\<^sub>R ((1 - u) *\<^sub>R a + u *\<^sub>R b))) < norm (b - a))"
       by auto
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
                 norm ((1 - u * 2) *\<^sub>R (b - a)) < norm (b - a))"
       by (simp add: algebra_simps scaleR_2)
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and>
                           \<bar>1 - u * 2\<bar> * norm (b - a) < norm (b - a))"
       by simp
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> \<bar>1 - u * 2\<bar> < 1)"
       by (simp add: mult_le_cancel_right2 False)
     also have "... = (\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 < u \<and> u < 1)"
       by auto
     finally show ?thesis .
   qed
   show ?thesis
     using False by (force simp: affine_hull_2 Set.set_eq_iff open_segment_image_interval *)
 qed
 
 lemmas segment_as_ball = closed_segment_as_ball open_segment_as_ball
 
 lemma closed_segment_neq_empty [simp]: "closed_segment a b \<noteq> {}"
   by auto
 
 lemma open_segment_eq_empty [simp]: "open_segment a b = {} \<longleftrightarrow> a = b"
 proof -
   { assume a1: "open_segment a b = {}"
     have "{} \<noteq> {0::real<..<1}"
       by simp
     then have "a = b"
       using a1 open_segment_image_interval by fastforce
   } then show ?thesis by auto
 qed
 
 lemma open_segment_eq_empty' [simp]: "{} = open_segment a b \<longleftrightarrow> a = b"
   using open_segment_eq_empty by blast
 
 lemmas segment_eq_empty = closed_segment_neq_empty open_segment_eq_empty
 
 lemma inj_segment:
   fixes a :: "'a :: real_vector"
   assumes "a \<noteq> b"
     shows "inj_on (\<lambda>u. (1 - u) *\<^sub>R a + u *\<^sub>R b) I"
 proof
   fix x y
   assume "(1 - x) *\<^sub>R a + x *\<^sub>R b = (1 - y) *\<^sub>R a + y *\<^sub>R b"
   then have "x *\<^sub>R (b - a) = y *\<^sub>R (b - a)"
     by (simp add: algebra_simps)
   with assms show "x = y"
     by (simp add: real_vector.scale_right_imp_eq)
 qed
 
 lemma finite_closed_segment [simp]: "finite(closed_segment a b) \<longleftrightarrow> a = b"
   apply auto
   apply (rule ccontr)
   apply (simp add: segment_image_interval)
   using infinite_Icc [OF zero_less_one] finite_imageD [OF _ inj_segment] apply blast
   done
 
 lemma finite_open_segment [simp]: "finite(open_segment a b) \<longleftrightarrow> a = b"
   by (auto simp: open_segment_def)
 
 lemmas finite_segment = finite_closed_segment finite_open_segment
 
 lemma closed_segment_eq_sing: "closed_segment a b = {c} \<longleftrightarrow> a = c \<and> b = c"
   by auto
 
 lemma open_segment_eq_sing: "open_segment a b \<noteq> {c}"
   by (metis finite_insert finite_open_segment insert_not_empty open_segment_image_interval)
 
 lemmas segment_eq_sing = closed_segment_eq_sing open_segment_eq_sing
 
 lemma subset_closed_segment:
     "closed_segment a b \<subseteq> closed_segment c d \<longleftrightarrow>
      a \<in> closed_segment c d \<and> b \<in> closed_segment c d"
   by auto (meson contra_subsetD convex_closed_segment convex_contains_segment)
 
 lemma subset_co_segment:
     "closed_segment a b \<subseteq> open_segment c d \<longleftrightarrow>
      a \<in> open_segment c d \<and> b \<in> open_segment c d"
 using closed_segment_subset by blast
 
 lemma subset_open_segment:
   fixes a :: "'a::euclidean_space"
   shows "open_segment a b \<subseteq> open_segment c d \<longleftrightarrow>
          a = b \<or> a \<in> closed_segment c d \<and> b \<in> closed_segment c d"
         (is "?lhs = ?rhs")
 proof (cases "a = b")
   case True then show ?thesis by simp
 next
   case False show ?thesis
   proof
     assume rhs: ?rhs
     with \<open>a \<noteq> b\<close> have "c \<noteq> d"
       using closed_segment_idem singleton_iff by auto
     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) =
                (1 - uc) *\<^sub>R c + uc *\<^sub>R d \<and> 0 < uc \<and> uc < 1"
         if neq: "(1 - ua) *\<^sub>R c + ua *\<^sub>R d \<noteq> (1 - ub) *\<^sub>R c + ub *\<^sub>R d" "c \<noteq> d"
            and "a = (1 - ua) *\<^sub>R c + ua *\<^sub>R d" "b = (1 - ub) *\<^sub>R c + ub *\<^sub>R d"
            and u: "0 < u" "u < 1" and uab: "0 \<le> ua" "ua \<le> 1" "0 \<le> ub" "ub \<le> 1"
         for u ua ub
     proof -
       have "ua \<noteq> ub"
         using neq by auto
       moreover have "(u - 1) * ua \<le> 0" using u uab
         by (simp add: mult_nonpos_nonneg)
       ultimately have lt: "(u - 1) * ua < u * ub" using u uab
         by (metis antisym_conv diff_ge_0_iff_ge le_less_trans mult_eq_0_iff mult_le_0_iff not_less)
       have "p * ua + q * ub < p+q" if p: "0 < p" and  q: "0 < q" for p q
       proof -
         have "\<not> p \<le> 0" "\<not> q \<le> 0"
           using p q not_less by blast+
         then show ?thesis
           by (metis \<open>ua \<noteq> ub\<close> add_less_cancel_left add_less_cancel_right add_mono_thms_linordered_field(5)
                     less_eq_real_def mult_cancel_left1 mult_less_cancel_left2 uab(2) uab(4))
       qed
       then have "(1 - u) * ua + u * ub < 1" using u \<open>ua \<noteq> ub\<close>
         by (metis diff_add_cancel diff_gt_0_iff_gt)
       with lt show ?thesis
         by (rule_tac x="ua + u*(ub-ua)" in exI) (simp add: algebra_simps)
     qed
     with rhs \<open>a \<noteq> b\<close> \<open>c \<noteq> d\<close> show ?lhs
       unfolding open_segment_image_interval closed_segment_def
       by (fastforce simp add:)
   next
     assume lhs: ?lhs
     with \<open>a \<noteq> b\<close> have "c \<noteq> d"
       by (meson finite_open_segment rev_finite_subset)
     have "closure (open_segment a b) \<subseteq> closure (open_segment c d)"
       using lhs closure_mono by blast
     then have "closed_segment a b \<subseteq> closed_segment c d"
       by (simp add: \<open>a \<noteq> b\<close> \<open>c \<noteq> d\<close>)
     then show ?rhs
       by (force simp: \<open>a \<noteq> b\<close>)
   qed
 qed
 
 lemma subset_oc_segment:
   fixes a :: "'a::euclidean_space"
   shows "open_segment a b \<subseteq> closed_segment c d \<longleftrightarrow>
          a = b \<or> a \<in> closed_segment c d \<and> b \<in> closed_segment c d"
 apply (simp add: subset_open_segment [symmetric])
 apply (rule iffI)
  apply (metis closure_closed_segment closure_mono closure_open_segment subset_closed_segment subset_open_segment)
 apply (meson dual_order.trans segment_open_subset_closed)
 done
 
 lemmas subset_segment = subset_closed_segment subset_co_segment subset_oc_segment subset_open_segment
 
 
 subsection\<open>Betweenness\<close>
 
 definition\<^marker>\<open>tag important\<close> "between = (\<lambda>(a,b) x. x \<in> closed_segment a b)"
 
 lemma betweenI:
   assumes "0 \<le> u" "u \<le> 1" "x = (1 - u) *\<^sub>R a + u *\<^sub>R b"
   shows "between (a, b) x"
 using assms unfolding between_def closed_segment_def by auto
 
 lemma betweenE:
   assumes "between (a, b) x"
   obtains u where "0 \<le> u" "u \<le> 1" "x = (1 - u) *\<^sub>R a + u *\<^sub>R b"
 using assms unfolding between_def closed_segment_def by auto
 
 lemma between_implies_scaled_diff:
   assumes "between (S, T) X" "between (S, T) Y" "S \<noteq> Y"
   obtains c where "(X - Y) = c *\<^sub>R (S - Y)"
 proof -
   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"
     by (metis add.commute betweenE eq_diff_eq)
   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"
     by (metis add.commute betweenE eq_diff_eq)
   have "X - Y = (u\<^sub>X - u\<^sub>Y) *\<^sub>R (S - T)"
   proof -
     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
     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)
     finally show ?thesis by (simp add: real_vector.scale_right_diff_distrib)
   qed
   moreover from Y have "S - Y = (1 - u\<^sub>Y) *\<^sub>R (S - T)"
     by (simp add: real_vector.scale_left_diff_distrib real_vector.scale_right_diff_distrib)
   moreover note \<open>S \<noteq> Y\<close>
   ultimately have "(X - Y) = ((u\<^sub>X - u\<^sub>Y) / (1 - u\<^sub>Y)) *\<^sub>R (S - Y)" by auto
   from this that show thesis by blast
 qed
 
 lemma between_mem_segment: "between (a,b) x \<longleftrightarrow> x \<in> closed_segment a b"
   unfolding between_def by auto
 
 lemma between: "between (a, b) (x::'a::euclidean_space) \<longleftrightarrow> dist a b = (dist a x) + (dist x b)"
 proof (cases "a = b")
   case True
   then show ?thesis
     by (auto simp add: between_def dist_commute)
 next
   case False
   then have Fal: "norm (a - b) \<noteq> 0" and Fal2: "norm (a - b) > 0"
     by auto
   have *: "\<And>u. a - ((1 - u) *\<^sub>R a + u *\<^sub>R b) = u *\<^sub>R (a - b)"
     by (auto simp add: algebra_simps)
   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
   proof -
     have *: "a - x = u *\<^sub>R (a - b)" "x - b = (1 - u) *\<^sub>R (a - b)"
       unfolding that(1) by (auto simp add:algebra_simps)
     show "norm (a - x) *\<^sub>R (x - b) = norm (x - b) *\<^sub>R (a - x)"
       unfolding norm_minus_commute[of x a] * using \<open>0 \<le> u\<close> \<open>u \<le> 1\<close>
       by simp
   qed
   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" 
   proof -
     let ?\<beta> = "norm (a - x) / norm (a - b)"
     show "\<exists>u. x = (1 - u) *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> u \<and> u \<le> 1"
     proof (intro exI conjI)
       show "?\<beta> \<le> 1"
         using Fal2 unfolding that[unfolded dist_norm] norm_ge_zero by auto
       show "x = (1 - ?\<beta>) *\<^sub>R a + (?\<beta>) *\<^sub>R b"
       proof (subst euclidean_eq_iff; intro ballI)
         fix i :: 'a
         assume i: "i \<in> Basis"
         have "((1 - ?\<beta>) *\<^sub>R a + (?\<beta>) *\<^sub>R b) \<bullet> i 
               = ((norm (a - b) - norm (a - x)) * (a \<bullet> i) + norm (a - x) * (b \<bullet> i)) / norm (a - b)"
           using Fal by (auto simp add: field_simps inner_simps)
         also have "\<dots> = x\<bullet>i"
           apply (rule divide_eq_imp[OF Fal])
           unfolding that[unfolded dist_norm]
           using that[unfolded dist_triangle_eq] i
           apply (subst (asm) euclidean_eq_iff)
            apply (auto simp add: field_simps inner_simps)
           done
         finally show "x \<bullet> i = ((1 - ?\<beta>) *\<^sub>R a + (?\<beta>) *\<^sub>R b) \<bullet> i"
           by auto
       qed
     qed (use Fal2 in auto)
   qed
   ultimately show ?thesis
     by (force simp add: between_def closed_segment_def dist_triangle_eq)
 qed
 
 lemma between_midpoint:
   fixes a :: "'a::euclidean_space"
   shows "between (a,b) (midpoint a b)" (is ?t1)
     and "between (b,a) (midpoint a b)" (is ?t2)
 proof -
   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"
     by auto
   show ?t1 ?t2
     unfolding between midpoint_def dist_norm
     by (auto simp add: field_simps inner_simps euclidean_eq_iff[where 'a='a] intro!: *)
 qed
 
 lemma between_mem_convex_hull:
   "between (a,b) x \<longleftrightarrow> x \<in> convex hull {a,b}"
   unfolding between_mem_segment segment_convex_hull ..
 
 lemma between_triv_iff [simp]: "between (a,a) b \<longleftrightarrow> a=b"
   by (auto simp: between_def)
 
 lemma between_triv1 [simp]: "between (a,b) a"
   by (auto simp: between_def)
 
 lemma between_triv2 [simp]: "between (a,b) b"
   by (auto simp: between_def)
 
 lemma between_commute:
    "between (a,b) = between (b,a)"
 by (auto simp: between_def closed_segment_commute)
 
 lemma between_antisym:
   fixes a :: "'a :: euclidean_space"
   shows "\<lbrakk>between (b,c) a; between (a,c) b\<rbrakk> \<Longrightarrow> a = b"
 by (auto simp: between dist_commute)
 
 lemma between_trans:
     fixes a :: "'a :: euclidean_space"
     shows "\<lbrakk>between (b,c) a; between (a,c) d\<rbrakk> \<Longrightarrow> between (b,c) d"
   using dist_triangle2 [of b c d] dist_triangle3 [of b d a]
   by (auto simp: between dist_commute)
 
 lemma between_norm:
     fixes a :: "'a :: euclidean_space"
     shows "between (a,b) x \<longleftrightarrow> norm(x - a) *\<^sub>R (b - x) = norm(b - x) *\<^sub>R (x - a)"
   by (auto simp: between dist_triangle_eq norm_minus_commute algebra_simps)
 
 lemma between_swap:
   fixes A B X Y :: "'a::euclidean_space"
   assumes "between (A, B) X"
   assumes "between (A, B) Y"
   shows "between (X, B) Y \<longleftrightarrow> between (A, Y) X"
 using assms by (auto simp add: between)
 
 lemma between_translation [simp]: "between (a + y,a + z) (a + x) \<longleftrightarrow> between (y,z) x"
   by (auto simp: between_def)
 
 lemma between_trans_2:
   fixes a :: "'a :: euclidean_space"
   shows "\<lbrakk>between (b,c) a; between (a,b) d\<rbrakk> \<Longrightarrow> between (c,d) a"
   by (metis between_commute between_swap between_trans)
 
 lemma between_scaleR_lift [simp]:
   fixes v :: "'a::euclidean_space"
   shows "between (a *\<^sub>R v, b *\<^sub>R v) (c *\<^sub>R v) \<longleftrightarrow> v = 0 \<or> between (a, b) c"
   by (simp add: between dist_norm scaleR_left_diff_distrib [symmetric] distrib_right [symmetric])
 
 lemma between_1:
   fixes x::real
   shows "between (a,b) x \<longleftrightarrow> (a \<le> x \<and> x \<le> b) \<or> (b \<le> x \<and> x \<le> a)"
   by (auto simp: between_mem_segment closed_segment_eq_real_ivl)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Shrinking towards the interior of a convex set\<close>
 
 lemma mem_interior_convex_shrink:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S"
     and "c \<in> interior S"
     and "x \<in> S"
     and "0 < e"
     and "e \<le> 1"
   shows "x - e *\<^sub>R (x - c) \<in> interior S"
 proof -
   obtain d where "d > 0" and d: "ball c d \<subseteq> S"
     using assms(2) unfolding mem_interior by auto
   show ?thesis
     unfolding mem_interior
   proof (intro exI subsetI conjI)
     fix y
     assume "y \<in> ball (x - e *\<^sub>R (x - c)) (e*d)"
     then have as: "dist (x - e *\<^sub>R (x - c)) y < e * d"
       by simp
     have *: "y = (1 - (1 - e)) *\<^sub>R ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) + (1 - e) *\<^sub>R x"
       using \<open>e > 0\<close> by (auto simp add: scaleR_left_diff_distrib scaleR_right_diff_distrib)
     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)"
       unfolding dist_norm
       unfolding norm_scaleR[symmetric]
       apply (rule arg_cong[where f=norm])
       using \<open>e > 0\<close>
       by (auto simp add: euclidean_eq_iff[where 'a='a] field_simps inner_simps)
     also have "\<dots> = \<bar>1/e\<bar> * norm (x - e *\<^sub>R (x - c) - y)"
       by (auto intro!:arg_cong[where f=norm] simp add: algebra_simps)
     also have "\<dots> < d"
       using as[unfolded dist_norm] and \<open>e > 0\<close>
       by (auto simp add:pos_divide_less_eq[OF \<open>e > 0\<close>] mult.commute)
     finally show "y \<in> S"
       apply (subst *)
       apply (rule assms(1)[unfolded convex_alt,rule_format])
       apply (rule d[unfolded subset_eq,rule_format])
       unfolding mem_ball
       using assms(3-5)
       apply auto
       done
   qed (insert \<open>e>0\<close> \<open>d>0\<close>, auto)
 qed
 
 lemma mem_interior_closure_convex_shrink:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S"
     and "c \<in> interior S"
     and "x \<in> closure S"
     and "0 < e"
     and "e \<le> 1"
   shows "x - e *\<^sub>R (x - c) \<in> interior S"
 proof -
   obtain d where "d > 0" and d: "ball c d \<subseteq> S"
     using assms(2) unfolding mem_interior by auto
   have "\<exists>y\<in>S. norm (y - x) * (1 - e) < e * d"
   proof (cases "x \<in> S")
     case True
     then show ?thesis
       using \<open>e > 0\<close> \<open>d > 0\<close>
       apply (rule_tac bexI[where x=x])
       apply (auto)
       done
   next
     case False
     then have x: "x islimpt S"
       using assms(3)[unfolded closure_def] by auto
     show ?thesis
     proof (cases "e = 1")
       case True
       obtain y where "y \<in> S" "y \<noteq> x" "dist y x < 1"
         using x[unfolded islimpt_approachable,THEN spec[where x=1]] by auto
       then show ?thesis
         apply (rule_tac x=y in bexI)
         unfolding True
         using \<open>d > 0\<close>
         apply auto
         done
     next
       case False
       then have "0 < e * d / (1 - e)" and *: "1 - e > 0"
         using \<open>e \<le> 1\<close> \<open>e > 0\<close> \<open>d > 0\<close> by auto
       then obtain y where "y \<in> S" "y \<noteq> x" "dist y x < e * d / (1 - e)"
         using x[unfolded islimpt_approachable,THEN spec[where x="e*d / (1 - e)"]] by auto
       then show ?thesis
         apply (rule_tac x=y in bexI)
         unfolding dist_norm
         using pos_less_divide_eq[OF *]
         apply auto
         done
     qed
   qed
   then obtain y where "y \<in> S" and y: "norm (y - x) * (1 - e) < e * d"
     by auto
   define z where "z = c + ((1 - e) / e) *\<^sub>R (x - y)"
   have *: "x - e *\<^sub>R (x - c) = y - e *\<^sub>R (y - z)"
     unfolding z_def using \<open>e > 0\<close>
     by (auto simp add: scaleR_right_diff_distrib scaleR_right_distrib scaleR_left_diff_distrib)
   have "z \<in> interior S"
     apply (rule interior_mono[OF d,unfolded subset_eq,rule_format])
     unfolding interior_open[OF open_ball] mem_ball z_def dist_norm using y and assms(4,5)
     by simp (simp add: field_simps norm_minus_commute)
   then show ?thesis
     unfolding *
     using mem_interior_convex_shrink \<open>y \<in> S\<close> assms by blast
 qed
 
 lemma in_interior_closure_convex_segment:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" and a: "a \<in> interior S" and b: "b \<in> closure S"
     shows "open_segment a b \<subseteq> interior S"
 proof (clarsimp simp: in_segment)
   fix u::real
   assume u: "0 < u" "u < 1"
   have "(1 - u) *\<^sub>R a + u *\<^sub>R b = b - (1 - u) *\<^sub>R (b - a)"
     by (simp add: algebra_simps)
   also have "... \<in> interior S" using mem_interior_closure_convex_shrink [OF assms] u
     by simp
   finally show "(1 - u) *\<^sub>R a + u *\<^sub>R b \<in> interior S" .
 qed
 
 lemma closure_open_Int_superset:
   assumes "open S" "S \<subseteq> closure T"
   shows "closure(S \<inter> T) = closure S"
 proof -
   have "closure S \<subseteq> closure(S \<inter> T)"
     by (metis assms closed_closure closure_minimal inf.orderE open_Int_closure_subset)
   then show ?thesis
     by (simp add: closure_mono dual_order.antisym)
 qed
 
 lemma convex_closure_interior:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" and int: "interior S \<noteq> {}"
   shows "closure(interior S) = closure S"
 proof -
   obtain a where a: "a \<in> interior S"
     using int by auto
   have "closure S \<subseteq> closure(interior S)"
   proof
     fix x
     assume x: "x \<in> closure S"
     show "x \<in> closure (interior S)"
     proof (cases "x=a")
       case True
       then show ?thesis
         using \<open>a \<in> interior S\<close> closure_subset by blast
     next
       case False
       show ?thesis
       proof (clarsimp simp add: closure_def islimpt_approachable)
         fix e::real
         assume xnotS: "x \<notin> interior S" and "0 < e"
         show "\<exists>x'\<in>interior S. x' \<noteq> x \<and> dist x' x < e"
         proof (intro bexI conjI)
           show "x - min (e/2 / norm (x - a)) 1 *\<^sub>R (x - a) \<noteq> x"
             using False \<open>0 < e\<close> by (auto simp: algebra_simps min_def)
           show "dist (x - min (e/2 / norm (x - a)) 1 *\<^sub>R (x - a)) x < e"
             using \<open>0 < e\<close> by (auto simp: dist_norm min_def)
           show "x - min (e/2 / norm (x - a)) 1 *\<^sub>R (x - a) \<in> interior S"
             apply (clarsimp simp add: min_def a)
             apply (rule mem_interior_closure_convex_shrink [OF \<open>convex S\<close> a x])
             using \<open>0 < e\<close> False apply (auto simp: field_split_simps)
             done
         qed
       qed
     qed
   qed
   then show ?thesis
     by (simp add: closure_mono interior_subset subset_antisym)
 qed
 
 lemma closure_convex_Int_superset:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "interior S \<noteq> {}" "interior S \<subseteq> closure T"
   shows "closure(S \<inter> T) = closure S"
 proof -
   have "closure S \<subseteq> closure(interior S)"
     by (simp add: convex_closure_interior assms)
   also have "... \<subseteq> closure (S \<inter> T)"
     using interior_subset [of S] assms
     by (metis (no_types, lifting) Int_assoc Int_lower2 closure_mono closure_open_Int_superset inf.orderE open_interior)
   finally show ?thesis
     by (simp add: closure_mono dual_order.antisym)
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Some obvious but surprisingly hard simplex lemmas\<close>
 
 lemma simplex:
   assumes "finite S"
     and "0 \<notin> S"
   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}"
 proof (simp add: convex_hull_finite set_eq_iff assms, safe)
   fix x and u :: "'a \<Rightarrow> real"
   assume "0 \<le> u 0" "\<forall>x\<in>S. 0 \<le> u x" "u 0 + sum u S = 1"
   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)"
     by force
 next
   fix x and u :: "'a \<Rightarrow> real"
   assume "\<forall>x\<in>S. 0 \<le> u x" "sum u S \<le> 1"
   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)"
     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)
 qed
 
 lemma substd_simplex:
   assumes d: "d \<subseteq> Basis"
   shows "convex hull (insert 0 d) =
     {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)}"
   (is "convex hull (insert 0 ?p) = ?s")
 proof -
   let ?D = d
   have "0 \<notin> ?p"
     using assms by (auto simp: image_def)
   from d have "finite d"
     by (blast intro: finite_subset finite_Basis)
   show ?thesis
     unfolding simplex[OF \<open>finite d\<close> \<open>0 \<notin> ?p\<close>]
   proof (intro set_eqI; safe)
     fix u :: "'a \<Rightarrow> real"
     assume as: "\<forall>x\<in>?D. 0 \<le> u x" "sum u ?D \<le> 1" 
     let ?x = "(\<Sum>x\<in>?D. u x *\<^sub>R x)"
     have ind: "\<forall>i\<in>Basis. i \<in> d \<longrightarrow> u i = ?x \<bullet> i"
       and notind: "(\<forall>i\<in>Basis. i \<notin> d \<longrightarrow> ?x \<bullet> i = 0)"
       using substdbasis_expansion_unique[OF assms] by blast+
     then have **: "sum u ?D = sum ((\<bullet>) ?x) ?D"
       using assms by (auto intro!: sum.cong)
     show "0 \<le> ?x \<bullet> i" if "i \<in> Basis" for i
       using as(1) ind notind that by fastforce
     show "sum ((\<bullet>) ?x) ?D \<le> 1"
       using "**" as(2) by linarith
     show "?x \<bullet> i = 0" if "i \<in> Basis" "i \<notin> d" for i
       using notind that by blast
   next
     fix x 
     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)"
     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"
       unfolding substdbasis_expansion_unique[OF assms] 
       by (rule_tac x="inner x" in exI) auto
   qed
 qed
 
 lemma std_simplex:
   "convex hull (insert 0 Basis) =
     {x::'a::euclidean_space. (\<forall>i\<in>Basis. 0 \<le> x\<bullet>i) \<and> sum (\<lambda>i. x\<bullet>i) Basis \<le> 1}"
   using substd_simplex[of Basis] by auto
 
 lemma interior_std_simplex:
   "interior (convex hull (insert 0 Basis)) =
     {x::'a::euclidean_space. (\<forall>i\<in>Basis. 0 < x\<bullet>i) \<and> sum (\<lambda>i. x\<bullet>i) Basis < 1}"
   unfolding set_eq_iff mem_interior std_simplex
 proof (intro allI iffI CollectI; clarify)
   fix x :: 'a
   fix e
   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}"
   show "(\<forall>i\<in>Basis. 0 < x \<bullet> i) \<and> sum ((\<bullet>) x) Basis < 1"
   proof safe
     fix i :: 'a
     assume i: "i \<in> Basis"
     then show "0 < x \<bullet> i"
       using as[THEN subsetD[where c="x - (e / 2) *\<^sub>R i"]] and \<open>e > 0\<close> 
       by (force simp add: inner_simps)
   next
     have **: "dist x (x + (e / 2) *\<^sub>R (SOME i. i\<in>Basis)) < e" using \<open>e > 0\<close>
       unfolding dist_norm
       by (auto intro!: mult_strict_left_mono simp: SOME_Basis)
     have "\<And>i. i \<in> Basis \<Longrightarrow> (x + (e / 2) *\<^sub>R (SOME i. i\<in>Basis)) \<bullet> i =
       x\<bullet>i + (if i = (SOME i. i\<in>Basis) then e/2 else 0)"
       by (auto simp: SOME_Basis inner_Basis inner_simps)
     then have *: "sum ((\<bullet>) (x + (e / 2) *\<^sub>R (SOME i. i\<in>Basis))) Basis =
       sum (\<lambda>i. x\<bullet>i + (if (SOME i. i\<in>Basis) = i then e/2 else 0)) Basis"
       by (auto simp: intro!: sum.cong)
     have "sum ((\<bullet>) x) Basis < sum ((\<bullet>) (x + (e / 2) *\<^sub>R (SOME i. i\<in>Basis))) Basis"
       using \<open>e > 0\<close> DIM_positive by (auto simp: SOME_Basis sum.distrib *)
     also have "\<dots> \<le> 1"
       using ** as by force
     finally show "sum ((\<bullet>) x) Basis < 1" by auto
   qed 
 next
   fix x :: 'a
   assume as: "\<forall>i\<in>Basis. 0 < x \<bullet> i" "sum ((\<bullet>) x) Basis < 1"
   obtain a :: 'b where "a \<in> UNIV" using UNIV_witness ..
   let ?d = "(1 - sum ((\<bullet>) x) Basis) / real (DIM('a))"
   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}"
   proof (rule_tac x="min (Min (((\<bullet>) x) ` Basis)) D" for D in exI, intro conjI subsetI CollectI)
     fix y
     assume y: "y \<in> ball x (min (Min ((\<bullet>) x ` Basis)) ?d)"
     have "sum ((\<bullet>) y) Basis \<le> sum (\<lambda>i. x\<bullet>i + ?d) Basis"
     proof (rule sum_mono)
       fix i :: 'a
       assume i: "i \<in> Basis"
       have "\<bar>y\<bullet>i - x\<bullet>i\<bar> \<le> norm (y - x)"
         by (metis Basis_le_norm i inner_commute inner_diff_right)
       also have "... < ?d"
         using y by (simp add: dist_norm norm_minus_commute)
       finally have "\<bar>y\<bullet>i - x\<bullet>i\<bar> < ?d" .
       then show "y \<bullet> i \<le> x \<bullet> i + ?d" by auto
     qed
     also have "\<dots> \<le> 1"
       unfolding sum.distrib sum_constant
       by (auto simp add: Suc_le_eq)
     finally show "sum ((\<bullet>) y) Basis \<le> 1" .
     show "(\<forall>i\<in>Basis. 0 \<le> y \<bullet> i)"
     proof safe
       fix i :: 'a
       assume i: "i \<in> Basis"
       have "norm (x - y) < Min (((\<bullet>) x) ` Basis)"
         using y by (auto simp: dist_norm less_eq_real_def)
       also have "... \<le> x\<bullet>i"
         using i by auto
       finally have "norm (x - y) < x\<bullet>i" .
       then show "0 \<le> y\<bullet>i"
         using Basis_le_norm[OF i, of "x - y"] and as(1)[rule_format, OF i]
         by (auto simp: inner_simps)
     qed
   next
     have "Min (((\<bullet>) x) ` Basis) > 0"
       using as by simp
     moreover have "?d > 0"
       using as by (auto simp: Suc_le_eq)
     ultimately show "0 < min (Min ((\<bullet>) x ` Basis)) ((1 - sum ((\<bullet>) x) Basis) / real DIM('a))"
       by linarith
   qed 
 qed
 
 lemma interior_std_simplex_nonempty:
   obtains a :: "'a::euclidean_space" where
     "a \<in> interior(convex hull (insert 0 Basis))"
 proof -
   let ?D = "Basis :: 'a set"
   let ?a = "sum (\<lambda>b::'a. inverse (2 * real DIM('a)) *\<^sub>R b) Basis"
   {
     fix i :: 'a
     assume i: "i \<in> Basis"
     have "?a \<bullet> i = inverse (2 * real DIM('a))"
       by (rule trans[of _ "sum (\<lambda>j. if i = j then inverse (2 * real DIM('a)) else 0) ?D"])
          (simp_all add: sum.If_cases i) }
   note ** = this
   show ?thesis
     apply (rule that[of ?a])
     unfolding interior_std_simplex mem_Collect_eq
   proof safe
     fix i :: 'a
     assume i: "i \<in> Basis"
     show "0 < ?a \<bullet> i"
       unfolding **[OF i] by (auto simp add: Suc_le_eq DIM_positive)
   next
     have "sum ((\<bullet>) ?a) ?D = sum (\<lambda>i. inverse (2 * real DIM('a))) ?D"
       apply (rule sum.cong)
       apply rule
       apply auto
       done
     also have "\<dots> < 1"
       unfolding sum_constant divide_inverse[symmetric]
       by (auto simp add: field_simps)
     finally show "sum ((\<bullet>) ?a) ?D < 1" by auto
   qed
 qed
 
 lemma rel_interior_substd_simplex:
   assumes D: "D \<subseteq> Basis"
   shows "rel_interior (convex hull (insert 0 D)) =
     {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)}"
   (is "rel_interior (convex hull (insert 0 ?p)) = ?s")
 proof -
   have "finite D"
     using D finite_Basis finite_subset by blast
   show ?thesis
   proof (cases "D = {}")
     case True
     then show ?thesis
       using rel_interior_sing using euclidean_eq_iff[of _ 0] by auto
   next
     case False
     have h0: "affine hull (convex hull (insert 0 ?p)) =
       {x::'a::euclidean_space. (\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> x\<bullet>i = 0)}"
       using affine_hull_convex_hull affine_hull_substd_basis assms by auto
     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"
       by auto
     {
       fix x :: "'a::euclidean_space"
       assume x: "x \<in> rel_interior (convex hull (insert 0 ?p))"
       then obtain e where "e > 0" and
         "ball x e \<inter> {xa. (\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> xa\<bullet>i = 0)} \<subseteq> convex hull (insert 0 ?p)"
         using mem_rel_interior_ball[of x "convex hull (insert 0 ?p)"] h0 by auto
       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>
         (\<forall>i\<in>D. 0 \<le> y \<bullet> i) \<and> sum ((\<bullet>) y) D \<le> 1"
         unfolding ball_def unfolding substd_simplex[OF assms] using assms by auto
       have x0: "(\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> x\<bullet>i = 0)"
         using x rel_interior_subset  substd_simplex[OF assms] by auto
       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)"
       proof (intro conjI ballI)
         fix i :: 'a
         assume "i \<in> D"
         then have "\<forall>j\<in>D. 0 \<le> (x - (e / 2) *\<^sub>R i) \<bullet> j"
           apply -
           apply (rule as[THEN conjunct1])
           using D \<open>e > 0\<close> x0
           apply (auto simp: dist_norm inner_simps inner_Basis)
           done
         then show "0 < x \<bullet> i"
           using \<open>e > 0\<close> \<open>i \<in> D\<close> D  by (force simp: inner_simps inner_Basis)
       next
         obtain a where a: "a \<in> D"
           using \<open>D \<noteq> {}\<close> by auto
         then have **: "dist x (x + (e / 2) *\<^sub>R a) < e"
           using \<open>e > 0\<close> norm_Basis[of a] D
           unfolding dist_norm
           by auto
         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)"
           using a D by (auto simp: inner_simps inner_Basis)
         then have *: "sum ((\<bullet>) (x + (e / 2) *\<^sub>R a)) D =
           sum (\<lambda>i. x\<bullet>i + (if a = i then e/2 else 0)) D"
           using D by (intro sum.cong) auto
         have "a \<in> Basis"
           using \<open>a \<in> D\<close> D by auto
         then have h1: "(\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> (x + (e / 2) *\<^sub>R a) \<bullet> i = 0)"
           using x0 D \<open>a\<in>D\<close> by (auto simp add: inner_add_left inner_Basis)
         have "sum ((\<bullet>) x) D < sum ((\<bullet>) (x + (e / 2) *\<^sub>R a)) D"
           using \<open>e > 0\<close> \<open>a \<in> D\<close> \<open>finite D\<close> by (auto simp add: * sum.distrib)
         also have "\<dots> \<le> 1"
           using ** h1 as[rule_format, of "x + (e / 2) *\<^sub>R a"]
           by auto
         finally show "sum ((\<bullet>) x) D < 1" "\<And>i. i\<in>Basis \<Longrightarrow> i \<notin> D \<longrightarrow> x\<bullet>i = 0"
           using x0 by auto
       qed
     }
     moreover
     {
       fix x :: "'a::euclidean_space"
       assume as: "x \<in> ?s"
       have "\<forall>i. 0 < x\<bullet>i \<or> 0 = x\<bullet>i \<longrightarrow> 0 \<le> x\<bullet>i"
         by auto
       moreover have "\<forall>i. i \<in> D \<or> i \<notin> D" by auto
       ultimately
       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"
         by metis
       then have h2: "x \<in> convex hull (insert 0 ?p)"
         using as assms
         unfolding substd_simplex[OF assms] by fastforce
       obtain a where a: "a \<in> D"
         using \<open>D \<noteq> {}\<close> by auto
       let ?d = "(1 - sum ((\<bullet>) x) D) / real (card D)"
       have "0 < card D" using \<open>D \<noteq> {}\<close> \<open>finite D\<close>
         by (simp add: card_gt_0_iff)
       have "Min (((\<bullet>) x) ` D) > 0"
         using as \<open>D \<noteq> {}\<close> \<open>finite D\<close> by (simp add: Min_gr_iff)
       moreover have "?d > 0" using as using \<open>0 < card D\<close> by auto
       ultimately have h3: "min (Min (((\<bullet>) x) ` D)) ?d > 0"
         by auto
 
       have "x \<in> rel_interior (convex hull (insert 0 ?p))"
         unfolding rel_interior_ball mem_Collect_eq h0
         apply (rule,rule h2)
         unfolding substd_simplex[OF assms]
         apply (rule_tac x="min (Min (((\<bullet>) x) ` D)) ?d" in exI)
         apply (rule, rule h3)
         apply safe
         unfolding mem_ball
       proof -
         fix y :: 'a
         assume y: "dist x y < min (Min ((\<bullet>) x ` D)) ?d"
         assume y2: "\<forall>i\<in>Basis. i \<notin> D \<longrightarrow> y\<bullet>i = 0"
         have "sum ((\<bullet>) y) D \<le> sum (\<lambda>i. x\<bullet>i + ?d) D"
         proof (rule sum_mono)
           fix i
           assume "i \<in> D"
           with D have i: "i \<in> Basis"
             by auto
           have "\<bar>y\<bullet>i - x\<bullet>i\<bar> \<le> norm (y - x)"
             by (metis i inner_commute inner_diff_right norm_bound_Basis_le order_refl)
           also have "... < ?d"
             by (metis dist_norm min_less_iff_conj norm_minus_commute y)
           finally have "\<bar>y\<bullet>i - x\<bullet>i\<bar> < ?d" .
           then show "y \<bullet> i \<le> x \<bullet> i + ?d" by auto
         qed
         also have "\<dots> \<le> 1"
           unfolding sum.distrib sum_constant  using \<open>0 < card D\<close>
           by auto
         finally show "sum ((\<bullet>) y) D \<le> 1" .
 
         fix i :: 'a
         assume i: "i \<in> Basis"
         then show "0 \<le> y\<bullet>i"
         proof (cases "i\<in>D")
           case True
           have "norm (x - y) < x\<bullet>i"
             using y[unfolded min_less_iff_conj dist_norm, THEN conjunct1]
             using Min_gr_iff[of "(\<bullet>) x ` D" "norm (x - y)"] \<open>0 < card D\<close> \<open>i \<in> D\<close>
             by (simp add: card_gt_0_iff)
           then show "0 \<le> y\<bullet>i"
             using Basis_le_norm[OF i, of "x - y"] and as(1)[rule_format]
             by (auto simp: inner_simps)
         qed (insert y2, auto)
       qed
     }
     ultimately have
       "\<And>x. x \<in> rel_interior (convex hull insert 0 D) \<longleftrightarrow>
         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)}"
       by blast
     then show ?thesis by (rule set_eqI)
   qed
 qed
 
 lemma rel_interior_substd_simplex_nonempty:
   assumes "D \<noteq> {}"
     and "D \<subseteq> Basis"
   obtains a :: "'a::euclidean_space"
     where "a \<in> rel_interior (convex hull (insert 0 D))"
 proof -
   let ?D = D
   let ?a = "sum (\<lambda>b::'a::euclidean_space. inverse (2 * real (card D)) *\<^sub>R b) ?D"
   have "finite D"
     apply (rule finite_subset)
     using assms(2)
     apply auto
     done
   then have d1: "0 < real (card D)"
     using \<open>D \<noteq> {}\<close> by auto
   {
     fix i
     assume "i \<in> D"
     have "?a \<bullet> i = inverse (2 * real (card D))"
       apply (rule trans[of _ "sum (\<lambda>j. if i = j then inverse (2 * real (card D)) else 0) ?D"])
       unfolding inner_sum_left
       apply (rule sum.cong)
       using \<open>i \<in> D\<close> \<open>finite D\<close> sum.delta'[of D i "(\<lambda>k. inverse (2 * real (card D)))"]
         d1 assms(2)
       by (auto simp: inner_Basis rev_subsetD[OF _ assms(2)])
   }
   note ** = this
   show ?thesis
     apply (rule that[of ?a])
     unfolding rel_interior_substd_simplex[OF assms(2)] mem_Collect_eq
   proof safe
     fix i
     assume "i \<in> D"
     have "0 < inverse (2 * real (card D))"
       using d1 by auto
     also have "\<dots> = ?a \<bullet> i" using **[of i] \<open>i \<in> D\<close>
       by auto
     finally show "0 < ?a \<bullet> i" by auto
   next
     have "sum ((\<bullet>) ?a) ?D = sum (\<lambda>i. inverse (2 * real (card D))) ?D"
       by (rule sum.cong) (rule refl, rule **)
     also have "\<dots> < 1"
       unfolding sum_constant divide_real_def[symmetric]
       by (auto simp add: field_simps)
     finally show "sum ((\<bullet>) ?a) ?D < 1" by auto
   next
     fix i
     assume "i \<in> Basis" and "i \<notin> D"
     have "?a \<in> span D"
     proof (rule span_sum[of D "(\<lambda>b. b /\<^sub>R (2 * real (card D)))" D])
       {
         fix x :: "'a::euclidean_space"
         assume "x \<in> D"
         then have "x \<in> span D"
           using span_base[of _ "D"] by auto
         then have "x /\<^sub>R (2 * real (card D)) \<in> span D"
           using span_mul[of x "D" "(inverse (real (card D)) / 2)"] by auto
       }
       then show "\<And>x. x\<in>D \<Longrightarrow> x /\<^sub>R (2 * real (card D)) \<in> span D"
         by auto
     qed
     then show "?a \<bullet> i = 0 "
       using \<open>i \<notin> D\<close> unfolding span_substd_basis[OF assms(2)] using \<open>i \<in> Basis\<close> by auto
   qed
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Relative interior of convex set\<close>
 
 lemma rel_interior_convex_nonempty_aux:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
     and "0 \<in> S"
   shows "rel_interior S \<noteq> {}"
 proof (cases "S = {0}")
   case True
   then show ?thesis using rel_interior_sing by auto
 next
   case False
   obtain B where B: "independent B \<and> B \<le> S \<and> S \<le> span B \<and> card B = dim S"
     using basis_exists[of S] by metis
   then have "B \<noteq> {}"
     using B assms \<open>S \<noteq> {0}\<close> span_empty by auto
   have "insert 0 B \<le> span B"
     using subspace_span[of B] subspace_0[of "span B"]
       span_superset by auto
   then have "span (insert 0 B) \<le> span B"
     using span_span[of B] span_mono[of "insert 0 B" "span B"] by blast
   then have "convex hull insert 0 B \<le> span B"
     using convex_hull_subset_span[of "insert 0 B"] by auto
   then have "span (convex hull insert 0 B) \<le> span B"
     using span_span[of B]
       span_mono[of "convex hull insert 0 B" "span B"] by blast
   then have *: "span (convex hull insert 0 B) = span B"
     using span_mono[of B "convex hull insert 0 B"] hull_subset[of "insert 0 B"] by auto
   then have "span (convex hull insert 0 B) = span S"
     using B span_mono[of B S] span_mono[of S "span B"]
       span_span[of B] by auto
   moreover have "0 \<in> affine hull (convex hull insert 0 B)"
     using hull_subset[of "convex hull insert 0 B"] hull_subset[of "insert 0 B"] by auto
   ultimately have **: "affine hull (convex hull insert 0 B) = affine hull S"
     using affine_hull_span_0[of "convex hull insert 0 B"] affine_hull_span_0[of "S"]
       assms hull_subset[of S]
     by auto
   obtain d and f :: "'n \<Rightarrow> 'n" where
     fd: "card d = card B" "linear f" "f ` B = d"
       "f ` span B = {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = (0::real)} \<and> inj_on f (span B)"
     and d: "d \<subseteq> Basis"
     using basis_to_substdbasis_subspace_isomorphism[of B,OF _ ] B by auto
   then have "bounded_linear f"
     using linear_conv_bounded_linear by auto
   have "d \<noteq> {}"
     using fd B \<open>B \<noteq> {}\<close> by auto
   have "insert 0 d = f ` (insert 0 B)"
     using fd linear_0 by auto
   then have "(convex hull (insert 0 d)) = f ` (convex hull (insert 0 B))"
     using convex_hull_linear_image[of f "(insert 0 d)"]
       convex_hull_linear_image[of f "(insert 0 B)"] \<open>linear f\<close>
     by auto
   moreover have "rel_interior (f ` (convex hull insert 0 B)) =
     f ` rel_interior (convex hull insert 0 B)"
     apply (rule  rel_interior_injective_on_span_linear_image[of f "(convex hull insert 0 B)"])
     using \<open>bounded_linear f\<close> fd *
     apply auto
     done
   ultimately have "rel_interior (convex hull insert 0 B) \<noteq> {}"
     using rel_interior_substd_simplex_nonempty[OF \<open>d \<noteq> {}\<close> d]
     apply auto
     apply blast
     done
   moreover have "convex hull (insert 0 B) \<subseteq> S"
     using B assms hull_mono[of "insert 0 B" "S" "convex"] convex_hull_eq
     by auto
   ultimately show ?thesis
     using subset_rel_interior[of "convex hull insert 0 B" S] ** by auto
 qed
 
 lemma rel_interior_eq_empty:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "rel_interior S = {} \<longleftrightarrow> S = {}"
 proof -
   {
     assume "S \<noteq> {}"
     then obtain a where "a \<in> S" by auto
     then have "0 \<in> (+) (-a) ` S"
       using assms exI[of "(\<lambda>x. x \<in> S \<and> - a + x = 0)" a] by auto
     then have "rel_interior ((+) (-a) ` S) \<noteq> {}"
       using rel_interior_convex_nonempty_aux[of "(+) (-a) ` S"]
         convex_translation[of S "-a"] assms
       by auto
     then have "rel_interior S \<noteq> {}"
       using rel_interior_translation [of "- a"] by simp
   }
   then show ?thesis
     using rel_interior_empty by auto
 qed
 
 lemma interior_simplex_nonempty:
   fixes S :: "'N :: euclidean_space set"
   assumes "independent S" "finite S" "card S = DIM('N)"
   obtains a where "a \<in> interior (convex hull (insert 0 S))"
 proof -
   have "affine hull (insert 0 S) = UNIV"
     by (simp add: hull_inc affine_hull_span_0 dim_eq_full[symmetric]
          assms(1) assms(3) dim_eq_card_independent)
   moreover have "rel_interior (convex hull insert 0 S) \<noteq> {}"
     using rel_interior_eq_empty [of "convex hull (insert 0 S)"] by auto
   ultimately have "interior (convex hull insert 0 S) \<noteq> {}"
     by (simp add: rel_interior_interior)
   with that show ?thesis
     by auto
 qed
 
 lemma convex_rel_interior:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "convex (rel_interior S)"
 proof -
   {
     fix x y and u :: real
     assume assm: "x \<in> rel_interior S" "y \<in> rel_interior S" "0 \<le> u" "u \<le> 1"
     then have "x \<in> S"
       using rel_interior_subset by auto
     have "x - u *\<^sub>R (x-y) \<in> rel_interior S"
     proof (cases "0 = u")
       case False
       then have "0 < u" using assm by auto
       then show ?thesis
         using assm rel_interior_convex_shrink[of S y x u] assms \<open>x \<in> S\<close> by auto
     next
       case True
       then show ?thesis using assm by auto
     qed
     then have "(1 - u) *\<^sub>R x + u *\<^sub>R y \<in> rel_interior S"
       by (simp add: algebra_simps)
   }
   then show ?thesis
     unfolding convex_alt by auto
 qed
 
 lemma convex_closure_rel_interior:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "closure (rel_interior S) = closure S"
 proof -
   have h1: "closure (rel_interior S) \<le> closure S"
     using closure_mono[of "rel_interior S" S] rel_interior_subset[of S] by auto
   show ?thesis
   proof (cases "S = {}")
     case False
     then obtain a where a: "a \<in> rel_interior S"
       using rel_interior_eq_empty assms by auto
     { fix x
       assume x: "x \<in> closure S"
       {
         assume "x = a"
         then have "x \<in> closure (rel_interior S)"
           using a unfolding closure_def by auto
       }
       moreover
       {
         assume "x \<noteq> a"
          {
            fix e :: real
            assume "e > 0"
            define e1 where "e1 = min 1 (e/norm (x - a))"
            then have e1: "e1 > 0" "e1 \<le> 1" "e1 * norm (x - a) \<le> e"
              using \<open>x \<noteq> a\<close> \<open>e > 0\<close> le_divide_eq[of e1 e "norm (x - a)"]
              by simp_all
            then have *: "x - e1 *\<^sub>R (x - a) \<in> rel_interior S"
              using rel_interior_closure_convex_shrink[of S a x e1] assms x a e1_def
              by auto
            have "\<exists>y. y \<in> rel_interior S \<and> y \<noteq> x \<and> dist y x \<le> e"
               apply (rule_tac x="x - e1 *\<^sub>R (x - a)" in exI)
               using * e1 dist_norm[of "x - e1 *\<^sub>R (x - a)" x] \<open>x \<noteq> a\<close>
               apply simp
               done
         }
         then have "x islimpt rel_interior S"
           unfolding islimpt_approachable_le by auto
         then have "x \<in> closure(rel_interior S)"
           unfolding closure_def by auto
       }
       ultimately have "x \<in> closure(rel_interior S)" by auto
     }
     then show ?thesis using h1 by auto
   next
     case True
     then have "rel_interior S = {}"
       using rel_interior_empty by auto
     then have "closure (rel_interior S) = {}"
       using closure_empty by auto
     with True show ?thesis by auto
   qed
 qed
 
 lemma rel_interior_same_affine_hull:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "affine hull (rel_interior S) = affine hull S"
   by (metis assms closure_same_affine_hull convex_closure_rel_interior)
 
 lemma rel_interior_aff_dim:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "aff_dim (rel_interior S) = aff_dim S"
   by (metis aff_dim_affine_hull2 assms rel_interior_same_affine_hull)
 
 lemma rel_interior_rel_interior:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "rel_interior (rel_interior S) = rel_interior S"
 proof -
   have "openin (top_of_set (affine hull (rel_interior S))) (rel_interior S)"
     using openin_rel_interior[of S] rel_interior_same_affine_hull[of S] assms by auto
   then show ?thesis
     using rel_interior_def by auto
 qed
 
 lemma rel_interior_rel_open:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "rel_open (rel_interior S)"
   unfolding rel_open_def using rel_interior_rel_interior assms by auto
 
 lemma convex_rel_interior_closure_aux:
   fixes x y z :: "'n::euclidean_space"
   assumes "0 < a" "0 < b" "(a + b) *\<^sub>R z = a *\<^sub>R x + b *\<^sub>R y"
   obtains e where "0 < e" "e \<le> 1" "z = y - e *\<^sub>R (y - x)"
 proof -
   define e where "e = a / (a + b)"
   have "z = (1 / (a + b)) *\<^sub>R ((a + b) *\<^sub>R z)"
     using assms  by (simp add: eq_vector_fraction_iff)
   also have "\<dots> = (1 / (a + b)) *\<^sub>R (a *\<^sub>R x + b *\<^sub>R y)"
     using assms scaleR_cancel_left[of "1/(a+b)" "(a + b) *\<^sub>R z" "a *\<^sub>R x + b *\<^sub>R y"]
     by auto
   also have "\<dots> = y - e *\<^sub>R (y-x)"
     using e_def
     apply (simp add: algebra_simps)
     using scaleR_left_distrib[of "a/(a+b)" "b/(a+b)" y] assms add_divide_distrib[of a b "a+b"]
     apply auto
     done
   finally have "z = y - e *\<^sub>R (y-x)"
     by auto
   moreover have "e > 0" using e_def assms by auto
   moreover have "e \<le> 1" using e_def assms by auto
   ultimately show ?thesis using that[of e] by auto
 qed
 
 lemma convex_rel_interior_closure:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "rel_interior (closure S) = rel_interior S"
 proof (cases "S = {}")
   case True
   then show ?thesis
     using assms rel_interior_eq_empty by auto
 next
   case False
   have "rel_interior (closure S) \<supseteq> rel_interior S"
     using subset_rel_interior[of S "closure S"] closure_same_affine_hull closure_subset
     by auto
   moreover
   {
     fix z
     assume z: "z \<in> rel_interior (closure S)"
     obtain x where x: "x \<in> rel_interior S"
       using \<open>S \<noteq> {}\<close> assms rel_interior_eq_empty by auto
     have "z \<in> rel_interior S"
     proof (cases "x = z")
       case True
       then show ?thesis using x by auto
     next
       case False
       obtain e where e: "e > 0" "cball z e \<inter> affine hull closure S \<le> closure S"
         using z rel_interior_cball[of "closure S"] by auto
       hence *: "0 < e/norm(z-x)" using e False by auto
       define y where "y = z + (e/norm(z-x)) *\<^sub>R (z-x)"
       have yball: "y \<in> cball z e"
         using mem_cball y_def dist_norm[of z y] e by auto
       have "x \<in> affine hull closure S"
         using x rel_interior_subset_closure hull_inc[of x "closure S"] by blast
       moreover have "z \<in> affine hull closure S"
         using z rel_interior_subset hull_subset[of "closure S"] by blast
       ultimately have "y \<in> affine hull closure S"
         using y_def affine_affine_hull[of "closure S"]
           mem_affine_3_minus [of "affine hull closure S" z z x "e/norm(z-x)"] by auto
       then have "y \<in> closure S" using e yball by auto
       have "(1 + (e/norm(z-x))) *\<^sub>R z = (e/norm(z-x)) *\<^sub>R x + y"
         using y_def by (simp add: algebra_simps)
       then obtain e1 where "0 < e1" "e1 \<le> 1" "z = y - e1 *\<^sub>R (y - x)"
         using * convex_rel_interior_closure_aux[of "e / norm (z - x)" 1 z x y]
         by (auto simp add: algebra_simps)
       then show ?thesis
         using rel_interior_closure_convex_shrink assms x \<open>y \<in> closure S\<close>
         by auto
     qed
   }
   ultimately show ?thesis by auto
 qed
 
 lemma convex_interior_closure:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "interior (closure S) = interior S"
   using closure_aff_dim[of S] interior_rel_interior_gen[of S]
     interior_rel_interior_gen[of "closure S"]
     convex_rel_interior_closure[of S] assms
   by auto
 
 lemma closure_eq_rel_interior_eq:
   fixes S1 S2 :: "'n::euclidean_space set"
   assumes "convex S1"
     and "convex S2"
   shows "closure S1 = closure S2 \<longleftrightarrow> rel_interior S1 = rel_interior S2"
   by (metis convex_rel_interior_closure convex_closure_rel_interior assms)
 
 lemma closure_eq_between:
   fixes S1 S2 :: "'n::euclidean_space set"
   assumes "convex S1"
     and "convex S2"
   shows "closure S1 = closure S2 \<longleftrightarrow> rel_interior S1 \<le> S2 \<and> S2 \<subseteq> closure S1"
   (is "?A \<longleftrightarrow> ?B")
 proof
   assume ?A
   then show ?B
     by (metis assms closure_subset convex_rel_interior_closure rel_interior_subset)
 next
   assume ?B
   then have "closure S1 \<subseteq> closure S2"
     by (metis assms(1) convex_closure_rel_interior closure_mono)
   moreover from \<open>?B\<close> have "closure S1 \<supseteq> closure S2"
     by (metis closed_closure closure_minimal)
   ultimately show ?A ..
 qed
 
 lemma open_inter_closure_rel_interior:
   fixes S A :: "'n::euclidean_space set"
   assumes "convex S"
     and "open A"
   shows "A \<inter> closure S = {} \<longleftrightarrow> A \<inter> rel_interior S = {}"
   by (metis assms convex_closure_rel_interior open_Int_closure_eq_empty)
 
 lemma rel_interior_open_segment:
   fixes a :: "'a :: euclidean_space"
   shows "rel_interior(open_segment a b) = open_segment a b"
 proof (cases "a = b")
   case True then show ?thesis by auto
 next
   case False then show ?thesis
     apply (simp add: rel_interior_eq openin_open)
     apply (rule_tac x="ball (inverse 2 *\<^sub>R (a + b)) (norm(b - a) / 2)" in exI)
     apply (simp add: open_segment_as_ball)
     done
 qed
 
 lemma rel_interior_closed_segment:
   fixes a :: "'a :: euclidean_space"
   shows "rel_interior(closed_segment a b) =
          (if a = b then {a} else open_segment a b)"
 proof (cases "a = b")
   case True then show ?thesis by auto
 next
   case False then show ?thesis
     by simp
        (metis closure_open_segment convex_open_segment convex_rel_interior_closure
               rel_interior_open_segment)
 qed
 
 lemmas rel_interior_segment = rel_interior_closed_segment rel_interior_open_segment
 
 lemma starlike_convex_tweak_boundary_points:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "S \<noteq> {}" and ST: "rel_interior S \<subseteq> T" and TS: "T \<subseteq> closure S"
   shows "starlike T"
 proof -
   have "rel_interior S \<noteq> {}"
     by (simp add: assms rel_interior_eq_empty)
   then obtain a where a: "a \<in> rel_interior S"  by blast
   with ST have "a \<in> T"  by blast
   have *: "\<And>x. x \<in> T \<Longrightarrow> open_segment a x \<subseteq> rel_interior S"
     apply (rule rel_interior_closure_convex_segment [OF \<open>convex S\<close> a])
     using assms by blast
   show ?thesis
     unfolding starlike_def
     apply (rule bexI [OF _ \<open>a \<in> T\<close>])
     apply (simp add: closed_segment_eq_open)
     apply (intro conjI ballI a \<open>a \<in> T\<close> rel_interior_closure_convex_segment [OF \<open>convex S\<close> a])
     apply (simp add: order_trans [OF * ST])
     done
 qed
 
 subsection\<open>The relative frontier of a set\<close>
 
 definition\<^marker>\<open>tag important\<close> "rel_frontier S = closure S - rel_interior S"
 
 lemma rel_frontier_empty [simp]: "rel_frontier {} = {}"
   by (simp add: rel_frontier_def)
 
 lemma rel_frontier_eq_empty:
     fixes S :: "'n::euclidean_space set"
     shows "rel_frontier S = {} \<longleftrightarrow> affine S"
   unfolding rel_frontier_def
   using rel_interior_subset_closure  by (auto simp add: rel_interior_eq_closure [symmetric])
 
 lemma rel_frontier_sing [simp]:
     fixes a :: "'n::euclidean_space"
     shows "rel_frontier {a} = {}"
   by (simp add: rel_frontier_def)
 
 lemma rel_frontier_affine_hull:
   fixes S :: "'a::euclidean_space set"
   shows "rel_frontier S \<subseteq> affine hull S"
 using closure_affine_hull rel_frontier_def by fastforce
 
 lemma rel_frontier_cball [simp]:
     fixes a :: "'n::euclidean_space"
     shows "rel_frontier(cball a r) = (if r = 0 then {} else sphere a r)"
 proof (cases rule: linorder_cases [of r 0])
   case less then show ?thesis
     by (force simp: sphere_def)
 next
   case equal then show ?thesis by simp
 next
   case greater then show ?thesis
     apply simp
     by (metis centre_in_ball empty_iff frontier_cball frontier_def interior_cball interior_rel_interior_gen rel_frontier_def)
 qed
 
 lemma rel_frontier_translation:
   fixes a :: "'a::euclidean_space"
   shows "rel_frontier((\<lambda>x. a + x) ` S) = (\<lambda>x. a + x) ` (rel_frontier S)"
 by (simp add: rel_frontier_def translation_diff rel_interior_translation closure_translation)
 
 lemma closed_affine_hull [iff]:
   fixes S :: "'n::euclidean_space set"
   shows "closed (affine hull S)"
   by (metis affine_affine_hull affine_closed)
 
 lemma rel_frontier_nonempty_interior:
   fixes S :: "'n::euclidean_space set"
   shows "interior S \<noteq> {} \<Longrightarrow> rel_frontier S = frontier S"
 by (metis frontier_def interior_rel_interior_gen rel_frontier_def)
 
 lemma rel_frontier_frontier:
   fixes S :: "'n::euclidean_space set"
   shows "affine hull S = UNIV \<Longrightarrow> rel_frontier S = frontier S"
 by (simp add: frontier_def rel_frontier_def rel_interior_interior)
 
 lemma closest_point_in_rel_frontier:
    "\<lbrakk>closed S; S \<noteq> {}; x \<in> affine hull S - rel_interior S\<rbrakk>
    \<Longrightarrow> closest_point S x \<in> rel_frontier S"
   by (simp add: closest_point_in_rel_interior closest_point_in_set rel_frontier_def)
 
 lemma closed_rel_frontier [iff]:
   fixes S :: "'n::euclidean_space set"
   shows "closed (rel_frontier S)"
 proof -
   have *: "closedin (top_of_set (affine hull S)) (closure S - rel_interior S)"
     by (simp add: closed_subset closedin_diff closure_affine_hull openin_rel_interior)
   show ?thesis
     apply (rule closedin_closed_trans[of "affine hull S" "rel_frontier S"])
     unfolding rel_frontier_def
     using * closed_affine_hull
     apply auto
     done
 qed
 
 lemma closed_rel_boundary:
   fixes S :: "'n::euclidean_space set"
   shows "closed S \<Longrightarrow> closed(S - rel_interior S)"
 by (metis closed_rel_frontier closure_closed rel_frontier_def)
 
 lemma compact_rel_boundary:
   fixes S :: "'n::euclidean_space set"
   shows "compact S \<Longrightarrow> compact(S - rel_interior S)"
 by (metis bounded_diff closed_rel_boundary closure_eq compact_closure compact_imp_closed)
 
 lemma bounded_rel_frontier:
   fixes S :: "'n::euclidean_space set"
   shows "bounded S \<Longrightarrow> bounded(rel_frontier S)"
 by (simp add: bounded_closure bounded_diff rel_frontier_def)
 
 lemma compact_rel_frontier_bounded:
   fixes S :: "'n::euclidean_space set"
   shows "bounded S \<Longrightarrow> compact(rel_frontier S)"
 using bounded_rel_frontier closed_rel_frontier compact_eq_bounded_closed by blast
 
 lemma compact_rel_frontier:
   fixes S :: "'n::euclidean_space set"
   shows "compact S \<Longrightarrow> compact(rel_frontier S)"
 by (meson compact_eq_bounded_closed compact_rel_frontier_bounded)
 
 lemma convex_same_rel_interior_closure:
   fixes S :: "'n::euclidean_space set"
   shows "\<lbrakk>convex S; convex T\<rbrakk>
          \<Longrightarrow> rel_interior S = rel_interior T \<longleftrightarrow> closure S = closure T"
 by (simp add: closure_eq_rel_interior_eq)
 
 lemma convex_same_rel_interior_closure_straddle:
   fixes S :: "'n::euclidean_space set"
   shows "\<lbrakk>convex S; convex T\<rbrakk>
          \<Longrightarrow> rel_interior S = rel_interior T \<longleftrightarrow>
              rel_interior S \<subseteq> T \<and> T \<subseteq> closure S"
 by (simp add: closure_eq_between convex_same_rel_interior_closure)
 
 lemma convex_rel_frontier_aff_dim:
   fixes S1 S2 :: "'n::euclidean_space set"
   assumes "convex S1"
     and "convex S2"
     and "S2 \<noteq> {}"
     and "S1 \<le> rel_frontier S2"
   shows "aff_dim S1 < aff_dim S2"
 proof -
   have "S1 \<subseteq> closure S2"
     using assms unfolding rel_frontier_def by auto
   then have *: "affine hull S1 \<subseteq> affine hull S2"
     using hull_mono[of "S1" "closure S2"] closure_same_affine_hull[of S2] by blast
   then have "aff_dim S1 \<le> aff_dim S2"
     using * aff_dim_affine_hull[of S1] aff_dim_affine_hull[of S2]
       aff_dim_subset[of "affine hull S1" "affine hull S2"]
     by auto
   moreover
   {
     assume eq: "aff_dim S1 = aff_dim S2"
     then have "S1 \<noteq> {}"
       using aff_dim_empty[of S1] aff_dim_empty[of S2] \<open>S2 \<noteq> {}\<close> by auto
     have **: "affine hull S1 = affine hull S2"
        apply (rule affine_dim_equal)
        using * affine_affine_hull
        apply auto
        using \<open>S1 \<noteq> {}\<close> hull_subset[of S1]
        apply auto
        using eq aff_dim_affine_hull[of S1] aff_dim_affine_hull[of S2]
        apply auto
        done
     obtain a where a: "a \<in> rel_interior S1"
       using \<open>S1 \<noteq> {}\<close> rel_interior_eq_empty assms by auto
     obtain T where T: "open T" "a \<in> T \<inter> S1" "T \<inter> affine hull S1 \<subseteq> S1"
        using mem_rel_interior[of a S1] a by auto
     then have "a \<in> T \<inter> closure S2"
       using a assms unfolding rel_frontier_def by auto
     then obtain b where b: "b \<in> T \<inter> rel_interior S2"
       using open_inter_closure_rel_interior[of S2 T] assms T by auto
     then have "b \<in> affine hull S1"
       using rel_interior_subset hull_subset[of S2] ** by auto
     then have "b \<in> S1"
       using T b by auto
     then have False
       using b assms unfolding rel_frontier_def by auto
   }
   ultimately show ?thesis
     using less_le by auto
 qed
 
 lemma convex_rel_interior_if:
   fixes S ::  "'n::euclidean_space set"
   assumes "convex S"
     and "z \<in> rel_interior S"
   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)"
 proof -
   obtain e1 where e1: "e1 > 0 \<and> cball z e1 \<inter> affine hull S \<subseteq> S"
     using mem_rel_interior_cball[of z S] assms by auto
   {
     fix x
     assume x: "x \<in> affine hull S"
     {
       assume "x \<noteq> z"
       define m where "m = 1 + e1/norm(x-z)"
       hence "m > 1" using e1 \<open>x \<noteq> z\<close> by auto
       {
         fix e
         assume e: "e > 1 \<and> e \<le> m"
         have "z \<in> affine hull S"
           using assms rel_interior_subset hull_subset[of S] by auto
         then have *: "(1 - e)*\<^sub>R x + e *\<^sub>R z \<in> affine hull S"
           using mem_affine[of "affine hull S" x z "(1-e)" e] affine_affine_hull[of S] x
           by auto
         have "norm (z + e *\<^sub>R x - (x + e *\<^sub>R z)) = norm ((e - 1) *\<^sub>R (x - z))"
           by (simp add: algebra_simps)
         also have "\<dots> = (e - 1) * norm (x-z)"
           using norm_scaleR e by auto
         also have "\<dots> \<le> (m - 1) * norm (x - z)"
           using e mult_right_mono[of _ _ "norm(x-z)"] by auto
         also have "\<dots> = (e1 / norm (x - z)) * norm (x - z)"
           using m_def by auto
         also have "\<dots> = e1"
           using \<open>x \<noteq> z\<close> e1 by simp
         finally have **: "norm (z + e *\<^sub>R x - (x + e *\<^sub>R z)) \<le> e1"
           by auto
         have "(1 - e)*\<^sub>R x+ e *\<^sub>R z \<in> cball z e1"
           using m_def **
           unfolding cball_def dist_norm
           by (auto simp add: algebra_simps)
         then have "(1 - e) *\<^sub>R x+ e *\<^sub>R z \<in> S"
           using e * e1 by auto
       }
       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 )"
         using \<open>m> 1 \<close> by auto
     }
     moreover
     {
       assume "x = z"
       define m where "m = 1 + e1"
       then have "m > 1"
         using e1 by auto
       {
         fix e
         assume e: "e > 1 \<and> e \<le> m"
         then have "(1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S"
           using e1 x \<open>x = z\<close> by (auto simp add: algebra_simps)
         then have "(1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S"
           using e by auto
       }
       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)"
         using \<open>m > 1\<close> by auto
     }
     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 )"
       by blast
   }
   then show ?thesis by auto
 qed
 
 lemma convex_rel_interior_if2:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   assumes "z \<in> rel_interior S"
   shows "\<forall>x\<in>affine hull S. \<exists>e. e > 1 \<and> (1 - e)*\<^sub>R x + e *\<^sub>R z \<in> S"
   using convex_rel_interior_if[of S z] assms by auto
 
 lemma convex_rel_interior_only_if:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
     and "S \<noteq> {}"
   assumes "\<forall>x\<in>S. \<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S"
   shows "z \<in> rel_interior S"
 proof -
   obtain x where x: "x \<in> rel_interior S"
     using rel_interior_eq_empty assms by auto
   then have "x \<in> S"
     using rel_interior_subset by auto
   then obtain e where e: "e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S"
     using assms by auto
   define y where [abs_def]: "y = (1 - e) *\<^sub>R x + e *\<^sub>R z"
   then have "y \<in> S" using e by auto
   define e1 where "e1 = 1/e"
   then have "0 < e1 \<and> e1 < 1" using e by auto
   then have "z  =y - (1 - e1) *\<^sub>R (y - x)"
     using e1_def y_def by (auto simp add: algebra_simps)
   then show ?thesis
     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
     by auto
 qed
 
 lemma convex_rel_interior_iff:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
     and "S \<noteq> {}"
   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)"
   using assms hull_subset[of S "affine"]
     convex_rel_interior_if[of S z] convex_rel_interior_only_if[of S z]
   by auto
 
 lemma convex_rel_interior_iff2:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
     and "S \<noteq> {}"
   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)"
   using assms hull_subset[of S] convex_rel_interior_if2[of S z] convex_rel_interior_only_if[of S z]
   by auto
 
 lemma convex_interior_iff:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "z \<in> interior S \<longleftrightarrow> (\<forall>x. \<exists>e. e > 0 \<and> z + e *\<^sub>R x \<in> S)"
 proof (cases "aff_dim S = int DIM('n)")
   case False
   { assume "z \<in> interior S"
     then have False
       using False interior_rel_interior_gen[of S] by auto }
   moreover
   { assume r: "\<forall>x. \<exists>e. e > 0 \<and> z + e *\<^sub>R x \<in> S"
     { fix x
       obtain e1 where e1: "e1 > 0 \<and> z + e1 *\<^sub>R (x - z) \<in> S"
         using r by auto
       obtain e2 where e2: "e2 > 0 \<and> z + e2 *\<^sub>R (z - x) \<in> S"
         using r by auto
       define x1 where [abs_def]: "x1 = z + e1 *\<^sub>R (x - z)"
       then have x1: "x1 \<in> affine hull S"
         using e1 hull_subset[of S] by auto
       define x2 where [abs_def]: "x2 = z + e2 *\<^sub>R (z - x)"
       then have x2: "x2 \<in> affine hull S"
         using e2 hull_subset[of S] by auto
       have *: "e1/(e1+e2) + e2/(e1+e2) = 1"
         using add_divide_distrib[of e1 e2 "e1+e2"] e1 e2 by simp
       then have "z = (e2/(e1+e2)) *\<^sub>R x1 + (e1/(e1+e2)) *\<^sub>R x2"
         using x1_def x2_def
         apply (auto simp add: algebra_simps)
         using scaleR_left_distrib[of "e1/(e1+e2)" "e2/(e1+e2)" z]
         apply auto
         done
       then have z: "z \<in> affine hull S"
         using mem_affine[of "affine hull S" x1 x2 "e2/(e1+e2)" "e1/(e1+e2)"]
           x1 x2 affine_affine_hull[of S] *
         by auto
       have "x1 - x2 = (e1 + e2) *\<^sub>R (x - z)"
         using x1_def x2_def by (auto simp add: algebra_simps)
       then have "x = z+(1/(e1+e2)) *\<^sub>R (x1-x2)"
         using e1 e2 by simp
       then have "x \<in> affine hull S"
         using mem_affine_3_minus[of "affine hull S" z x1 x2 "1/(e1+e2)"]
           x1 x2 z affine_affine_hull[of S]
         by auto
     }
     then have "affine hull S = UNIV"
       by auto
     then have "aff_dim S = int DIM('n)"
       using aff_dim_affine_hull[of S] by (simp add: aff_dim_UNIV)
     then have False
       using False by auto
   }
   ultimately show ?thesis by auto
 next
   case True
   then have "S \<noteq> {}"
     using aff_dim_empty[of S] by auto
   have *: "affine hull S = UNIV"
     using True affine_hull_UNIV by auto
   {
     assume "z \<in> interior S"
     then have "z \<in> rel_interior S"
       using True interior_rel_interior_gen[of S] by auto
     then have **: "\<forall>x. \<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S"
       using convex_rel_interior_iff2[of S z] assms \<open>S \<noteq> {}\<close> * by auto
     fix x
     obtain e1 where e1: "e1 > 1" "(1 - e1) *\<^sub>R (z - x) + e1 *\<^sub>R z \<in> S"
       using **[rule_format, of "z-x"] by auto
     define e where [abs_def]: "e = e1 - 1"
     then have "(1 - e1) *\<^sub>R (z - x) + e1 *\<^sub>R z = z + e *\<^sub>R x"
       by (simp add: algebra_simps)
     then have "e > 0" "z + e *\<^sub>R x \<in> S"
       using e1 e_def by auto
     then have "\<exists>e. e > 0 \<and> z + e *\<^sub>R x \<in> S"
       by auto
   }
   moreover
   {
     assume r: "\<forall>x. \<exists>e. e > 0 \<and> z + e *\<^sub>R x \<in> S"
     {
       fix x
       obtain e1 where e1: "e1 > 0" "z + e1 *\<^sub>R (z - x) \<in> S"
         using r[rule_format, of "z-x"] by auto
       define e where "e = e1 + 1"
       then have "z + e1 *\<^sub>R (z - x) = (1 - e) *\<^sub>R x + e *\<^sub>R z"
         by (simp add: algebra_simps)
       then have "e > 1" "(1 - e)*\<^sub>R x + e *\<^sub>R z \<in> S"
         using e1 e_def by auto
       then have "\<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> S" by auto
     }
     then have "z \<in> rel_interior S"
       using convex_rel_interior_iff2[of S z] assms \<open>S \<noteq> {}\<close> by auto
     then have "z \<in> interior S"
       using True interior_rel_interior_gen[of S] by auto
   }
   ultimately show ?thesis by auto
 qed
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Relative interior and closure under common operations\<close>
 
 lemma rel_interior_inter_aux: "\<Inter>{rel_interior S |S. S \<in> I} \<subseteq> \<Inter>I"
 proof -
   {
     fix y
     assume "y \<in> \<Inter>{rel_interior S |S. S \<in> I}"
     then have y: "\<forall>S \<in> I. y \<in> rel_interior S"
       by auto
     {
       fix S
       assume "S \<in> I"
       then have "y \<in> S"
         using rel_interior_subset y by auto
     }
     then have "y \<in> \<Inter>I" by auto
   }
   then show ?thesis by auto
 qed
 
 lemma closure_Int: "closure (\<Inter>I) \<le> \<Inter>{closure S |S. S \<in> I}"
 proof -
   {
     fix y
     assume "y \<in> \<Inter>I"
     then have y: "\<forall>S \<in> I. y \<in> S" by auto
     {
       fix S
       assume "S \<in> I"
       then have "y \<in> closure S"
         using closure_subset y by auto
     }
     then have "y \<in> \<Inter>{closure S |S. S \<in> I}"
       by auto
   }
   then have "\<Inter>I \<subseteq> \<Inter>{closure S |S. S \<in> I}"
     by auto
   moreover have "closed (\<Inter>{closure S |S. S \<in> I})"
     unfolding closed_Inter closed_closure by auto
   ultimately show ?thesis using closure_hull[of "\<Inter>I"]
     hull_minimal[of "\<Inter>I" "\<Inter>{closure S |S. S \<in> I}" "closed"] by auto
 qed
 
 lemma convex_closure_rel_interior_inter:
   assumes "\<forall>S\<in>I. convex (S :: 'n::euclidean_space set)"
     and "\<Inter>{rel_interior S |S. S \<in> I} \<noteq> {}"
   shows "\<Inter>{closure S |S. S \<in> I} \<le> closure (\<Inter>{rel_interior S |S. S \<in> I})"
 proof -
   obtain x where x: "\<forall>S\<in>I. x \<in> rel_interior S"
     using assms by auto
   {
     fix y
     assume "y \<in> \<Inter>{closure S |S. S \<in> I}"
     then have y: "\<forall>S \<in> I. y \<in> closure S"
       by auto
     {
       assume "y = x"
       then have "y \<in> closure (\<Inter>{rel_interior S |S. S \<in> I})"
         using x closure_subset[of "\<Inter>{rel_interior S |S. S \<in> I}"] by auto
     }
     moreover
     {
       assume "y \<noteq> x"
       { fix e :: real
         assume e: "e > 0"
         define e1 where "e1 = min 1 (e/norm (y - x))"
         then have e1: "e1 > 0" "e1 \<le> 1" "e1 * norm (y - x) \<le> e"
           using \<open>y \<noteq> x\<close> \<open>e > 0\<close> le_divide_eq[of e1 e "norm (y - x)"]
           by simp_all
         define z where "z = y - e1 *\<^sub>R (y - x)"
         {
           fix S
           assume "S \<in> I"
           then have "z \<in> rel_interior S"
             using rel_interior_closure_convex_shrink[of S x y e1] assms x y e1 z_def
             by auto
         }
         then have *: "z \<in> \<Inter>{rel_interior S |S. S \<in> I}"
           by auto
         have "\<exists>z. z \<in> \<Inter>{rel_interior S |S. S \<in> I} \<and> z \<noteq> y \<and> dist z y \<le> e"
           apply (rule_tac x="z" in exI)
           using \<open>y \<noteq> x\<close> z_def * e1 e dist_norm[of z y]
           apply simp
           done
       }
       then have "y islimpt \<Inter>{rel_interior S |S. S \<in> I}"
         unfolding islimpt_approachable_le by blast
       then have "y \<in> closure (\<Inter>{rel_interior S |S. S \<in> I})"
         unfolding closure_def by auto
     }
     ultimately have "y \<in> closure (\<Inter>{rel_interior S |S. S \<in> I})"
       by auto
   }
   then show ?thesis by auto
 qed
 
 lemma convex_closure_inter:
   assumes "\<forall>S\<in>I. convex (S :: 'n::euclidean_space set)"
     and "\<Inter>{rel_interior S |S. S \<in> I} \<noteq> {}"
   shows "closure (\<Inter>I) = \<Inter>{closure S |S. S \<in> I}"
 proof -
   have "\<Inter>{closure S |S. S \<in> I} \<le> closure (\<Inter>{rel_interior S |S. S \<in> I})"
     using convex_closure_rel_interior_inter assms by auto
   moreover
   have "closure (\<Inter>{rel_interior S |S. S \<in> I}) \<le> closure (\<Inter>I)"
     using rel_interior_inter_aux closure_mono[of "\<Inter>{rel_interior S |S. S \<in> I}" "\<Inter>I"]
     by auto
   ultimately show ?thesis
     using closure_Int[of I] by auto
 qed
 
 lemma convex_inter_rel_interior_same_closure:
   assumes "\<forall>S\<in>I. convex (S :: 'n::euclidean_space set)"
     and "\<Inter>{rel_interior S |S. S \<in> I} \<noteq> {}"
   shows "closure (\<Inter>{rel_interior S |S. S \<in> I}) = closure (\<Inter>I)"
 proof -
   have "\<Inter>{closure S |S. S \<in> I} \<le> closure (\<Inter>{rel_interior S |S. S \<in> I})"
     using convex_closure_rel_interior_inter assms by auto
   moreover
   have "closure (\<Inter>{rel_interior S |S. S \<in> I}) \<le> closure (\<Inter>I)"
     using rel_interior_inter_aux closure_mono[of "\<Inter>{rel_interior S |S. S \<in> I}" "\<Inter>I"]
     by auto
   ultimately show ?thesis
     using closure_Int[of I] by auto
 qed
 
 lemma convex_rel_interior_inter:
   assumes "\<forall>S\<in>I. convex (S :: 'n::euclidean_space set)"
     and "\<Inter>{rel_interior S |S. S \<in> I} \<noteq> {}"
   shows "rel_interior (\<Inter>I) \<subseteq> \<Inter>{rel_interior S |S. S \<in> I}"
 proof -
   have "convex (\<Inter>I)"
     using assms convex_Inter by auto
   moreover
   have "convex (\<Inter>{rel_interior S |S. S \<in> I})"
     apply (rule convex_Inter)
     using assms convex_rel_interior
     apply auto
     done
   ultimately
   have "rel_interior (\<Inter>{rel_interior S |S. S \<in> I}) = rel_interior (\<Inter>I)"
     using convex_inter_rel_interior_same_closure assms
       closure_eq_rel_interior_eq[of "\<Inter>{rel_interior S |S. S \<in> I}" "\<Inter>I"]
     by blast
   then show ?thesis
     using rel_interior_subset[of "\<Inter>{rel_interior S |S. S \<in> I}"] by auto
 qed
 
 lemma convex_rel_interior_finite_inter:
   assumes "\<forall>S\<in>I. convex (S :: 'n::euclidean_space set)"
     and "\<Inter>{rel_interior S |S. S \<in> I} \<noteq> {}"
     and "finite I"
   shows "rel_interior (\<Inter>I) = \<Inter>{rel_interior S |S. S \<in> I}"
 proof -
   have "\<Inter>I \<noteq> {}"
     using assms rel_interior_inter_aux[of I] by auto
   have "convex (\<Inter>I)"
     using convex_Inter assms by auto
   show ?thesis
   proof (cases "I = {}")
     case True
     then show ?thesis
       using Inter_empty rel_interior_UNIV by auto
   next
     case False
     {
       fix z
       assume z: "z \<in> \<Inter>{rel_interior S |S. S \<in> I}"
       {
         fix x
         assume x: "x \<in> \<Inter>I"
         {
           fix S
           assume S: "S \<in> I"
           then have "z \<in> rel_interior S" "x \<in> S"
             using z x by auto
           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)"
             using convex_rel_interior_if[of S z] S assms hull_subset[of S] by auto
         }
         then obtain mS where
           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
         define e where "e = Min (mS ` I)"
         then have "e \<in> mS ` I" using assms \<open>I \<noteq> {}\<close> by simp
         then have "e > 1" using mS by auto
         moreover have "\<forall>S\<in>I. e \<le> mS S"
           using e_def assms by auto
         ultimately have "\<exists>e > 1. (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> \<Inter>I"
           using mS by auto
       }
       then have "z \<in> rel_interior (\<Inter>I)"
         using convex_rel_interior_iff[of "\<Inter>I" z] \<open>\<Inter>I \<noteq> {}\<close> \<open>convex (\<Inter>I)\<close> by auto
     }
     then show ?thesis
       using convex_rel_interior_inter[of I] assms by auto
   qed
 qed
 
 lemma convex_closure_inter_two:
   fixes S T :: "'n::euclidean_space set"
   assumes "convex S"
     and "convex T"
   assumes "rel_interior S \<inter> rel_interior T \<noteq> {}"
   shows "closure (S \<inter> T) = closure S \<inter> closure T"
   using convex_closure_inter[of "{S,T}"] assms by auto
 
 lemma convex_rel_interior_inter_two:
   fixes S T :: "'n::euclidean_space set"
   assumes "convex S"
     and "convex T"
     and "rel_interior S \<inter> rel_interior T \<noteq> {}"
   shows "rel_interior (S \<inter> T) = rel_interior S \<inter> rel_interior T"
   using convex_rel_interior_finite_inter[of "{S,T}"] assms by auto
 
 lemma convex_affine_closure_Int:
   fixes S T :: "'n::euclidean_space set"
   assumes "convex S"
     and "affine T"
     and "rel_interior S \<inter> T \<noteq> {}"
   shows "closure (S \<inter> T) = closure S \<inter> T"
 proof -
   have "affine hull T = T"
     using assms by auto
   then have "rel_interior T = T"
     using rel_interior_affine_hull[of T] by metis
   moreover have "closure T = T"
     using assms affine_closed[of T] by auto
   ultimately show ?thesis
     using convex_closure_inter_two[of S T] assms affine_imp_convex by auto
 qed
 
 lemma connected_component_1_gen:
   fixes S :: "'a :: euclidean_space set"
   assumes "DIM('a) = 1"
   shows "connected_component S a b \<longleftrightarrow> closed_segment a b \<subseteq> S"
 unfolding connected_component_def
 by (metis (no_types, lifting) assms subsetD subsetI convex_contains_segment convex_segment(1)
             ends_in_segment connected_convex_1_gen)
 
 lemma connected_component_1:
   fixes S :: "real set"
   shows "connected_component S a b \<longleftrightarrow> closed_segment a b \<subseteq> S"
 by (simp add: connected_component_1_gen)
 
 lemma convex_affine_rel_interior_Int:
   fixes S T :: "'n::euclidean_space set"
   assumes "convex S"
     and "affine T"
     and "rel_interior S \<inter> T \<noteq> {}"
   shows "rel_interior (S \<inter> T) = rel_interior S \<inter> T"
 proof -
   have "affine hull T = T"
     using assms by auto
   then have "rel_interior T = T"
     using rel_interior_affine_hull[of T] by metis
   moreover have "closure T = T"
     using assms affine_closed[of T] by auto
   ultimately show ?thesis
     using convex_rel_interior_inter_two[of S T] assms affine_imp_convex by auto
 qed
 
 lemma convex_affine_rel_frontier_Int:
    fixes S T :: "'n::euclidean_space set"
   assumes "convex S"
     and "affine T"
     and "interior S \<inter> T \<noteq> {}"
   shows "rel_frontier(S \<inter> T) = frontier S \<inter> T"
 using assms
 apply (simp add: rel_frontier_def convex_affine_closure_Int frontier_def)
 by (metis Diff_Int_distrib2 Int_emptyI convex_affine_closure_Int convex_affine_rel_interior_Int empty_iff interior_rel_interior_gen)
 
 lemma rel_interior_convex_Int_affine:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "affine T" "interior S \<inter> T \<noteq> {}"
     shows "rel_interior(S \<inter> T) = interior S \<inter> T"
 proof -
   obtain a where aS: "a \<in> interior S" and aT:"a \<in> T"
     using assms by force
   have "rel_interior S = interior S"
     by (metis (no_types) aS affine_hull_nonempty_interior equals0D rel_interior_interior)
   then show ?thesis
     by (metis (no_types) affine_imp_convex assms convex_rel_interior_inter_two hull_same rel_interior_affine_hull)
 qed
 
 lemma closure_convex_Int_affine:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "affine T" "rel_interior S \<inter> T \<noteq> {}"
   shows "closure(S \<inter> T) = closure S \<inter> T"
 proof
   have "closure (S \<inter> T) \<subseteq> closure T"
     by (simp add: closure_mono)
   also have "... \<subseteq> T"
     by (simp add: affine_closed assms)
   finally show "closure(S \<inter> T) \<subseteq> closure S \<inter> T"
     by (simp add: closure_mono)
 next
   obtain a where "a \<in> rel_interior S" "a \<in> T"
     using assms by auto
   then have ssT: "subspace ((\<lambda>x. (-a)+x) ` T)" and "a \<in> S"
     using affine_diffs_subspace rel_interior_subset assms by blast+
   show "closure S \<inter> T \<subseteq> closure (S \<inter> T)"
   proof
     fix x  assume "x \<in> closure S \<inter> T"
     show "x \<in> closure (S \<inter> T)"
     proof (cases "x = a")
       case True
       then show ?thesis
         using \<open>a \<in> S\<close> \<open>a \<in> T\<close> closure_subset by fastforce
     next
       case False
       then have "x \<in> closure(open_segment a x)"
         by auto
       then show ?thesis
         using \<open>x \<in> closure S \<inter> T\<close> assms convex_affine_closure_Int by blast
     qed
   qed
 qed
 
 lemma subset_rel_interior_convex:
   fixes S T :: "'n::euclidean_space set"
   assumes "convex S"
     and "convex T"
     and "S \<le> closure T"
     and "\<not> S \<subseteq> rel_frontier T"
   shows "rel_interior S \<subseteq> rel_interior T"
 proof -
   have *: "S \<inter> closure T = S"
     using assms by auto
   have "\<not> rel_interior S \<subseteq> rel_frontier T"
     using closure_mono[of "rel_interior S" "rel_frontier T"] closed_rel_frontier[of T]
       closure_closed[of S] convex_closure_rel_interior[of S] closure_subset[of S] assms
     by auto
   then have "rel_interior S \<inter> rel_interior (closure T) \<noteq> {}"
     using assms rel_frontier_def[of T] rel_interior_subset convex_rel_interior_closure[of T]
     by auto
   then have "rel_interior S \<inter> rel_interior T = rel_interior (S \<inter> closure T)"
     using assms convex_closure convex_rel_interior_inter_two[of S "closure T"]
       convex_rel_interior_closure[of T]
     by auto
   also have "\<dots> = rel_interior S"
     using * by auto
   finally show ?thesis
     by auto
 qed
 
 lemma rel_interior_convex_linear_image:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes "linear f"
     and "convex S"
   shows "f ` (rel_interior S) = rel_interior (f ` S)"
 proof (cases "S = {}")
   case True
   then show ?thesis
     using assms rel_interior_empty rel_interior_eq_empty by auto
 next
   case False
   interpret linear f by fact
   have *: "f ` (rel_interior S) \<subseteq> f ` S"
     unfolding image_mono using rel_interior_subset by auto
   have "f ` S \<subseteq> f ` (closure S)"
     unfolding image_mono using closure_subset by auto
   also have "\<dots> = f ` (closure (rel_interior S))"
     using convex_closure_rel_interior assms by auto
   also have "\<dots> \<subseteq> closure (f ` (rel_interior S))"
     using closure_linear_image_subset assms by auto
   finally have "closure (f ` S) = closure (f ` rel_interior S)"
     using closure_mono[of "f ` S" "closure (f ` rel_interior S)"] closure_closure
       closure_mono[of "f ` rel_interior S" "f ` S"] *
     by auto
   then have "rel_interior (f ` S) = rel_interior (f ` rel_interior S)"
     using assms convex_rel_interior
       linear_conv_bounded_linear[of f] convex_linear_image[of _ S]
       convex_linear_image[of _ "rel_interior S"]
       closure_eq_rel_interior_eq[of "f ` S" "f ` rel_interior S"]
     by auto
   then have "rel_interior (f ` S) \<subseteq> f ` rel_interior S"
     using rel_interior_subset by auto
   moreover
   {
     fix z
     assume "z \<in> f ` rel_interior S"
     then obtain z1 where z1: "z1 \<in> rel_interior S" "f z1 = z" by auto
     {
       fix x
       assume "x \<in> f ` S"
       then obtain x1 where x1: "x1 \<in> S" "f x1 = x" by auto
       then obtain e where e: "e > 1" "(1 - e) *\<^sub>R x1 + e *\<^sub>R z1 \<in> S"
         using convex_rel_interior_iff[of S z1] \<open>convex S\<close> x1 z1 by auto
       moreover have "f ((1 - e) *\<^sub>R x1 + e *\<^sub>R z1) = (1 - e) *\<^sub>R x + e *\<^sub>R z"
         using x1 z1 by (simp add: linear_add linear_scale \<open>linear f\<close>)
       ultimately have "(1 - e) *\<^sub>R x + e *\<^sub>R z \<in> f ` S"
         using imageI[of "(1 - e) *\<^sub>R x1 + e *\<^sub>R z1" S f] by auto
       then have "\<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> f ` S"
         using e by auto
     }
     then have "z \<in> rel_interior (f ` S)"
       using convex_rel_interior_iff[of "f ` S" z] \<open>convex S\<close> \<open>linear f\<close>
         \<open>S \<noteq> {}\<close> convex_linear_image[of f S]  linear_conv_bounded_linear[of f]
       by auto
   }
   ultimately show ?thesis by auto
 qed
 
 lemma rel_interior_convex_linear_preimage:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes "linear f"
     and "convex S"
     and "f -` (rel_interior S) \<noteq> {}"
   shows "rel_interior (f -` S) = f -` (rel_interior S)"
 proof -
   interpret linear f by fact
   have "S \<noteq> {}"
     using assms rel_interior_empty by auto
   have nonemp: "f -` S \<noteq> {}"
     by (metis assms(3) rel_interior_subset subset_empty vimage_mono)
   then have "S \<inter> (range f) \<noteq> {}"
     by auto
   have conv: "convex (f -` S)"
     using convex_linear_vimage assms by auto
   then have "convex (S \<inter> range f)"
     by (simp add: assms(2) convex_Int convex_linear_image linear_axioms)
   {
     fix z
     assume "z \<in> f -` (rel_interior S)"
     then have z: "f z \<in> rel_interior S"
       by auto
     {
       fix x
       assume "x \<in> f -` S"
       then have "f x \<in> S" by auto
       then obtain e where e: "e > 1" "(1 - e) *\<^sub>R f x + e *\<^sub>R f z \<in> S"
         using convex_rel_interior_iff[of S "f z"] z assms \<open>S \<noteq> {}\<close> by auto
       moreover have "(1 - e) *\<^sub>R f x + e *\<^sub>R f z = f ((1 - e) *\<^sub>R x + e *\<^sub>R z)"
         using \<open>linear f\<close> by (simp add: linear_iff)
       ultimately have "\<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R z \<in> f -` S"
         using e by auto
     }
     then have "z \<in> rel_interior (f -` S)"
       using convex_rel_interior_iff[of "f -` S" z] conv nonemp by auto
   }
   moreover
   {
     fix z
     assume z: "z \<in> rel_interior (f -` S)"
     {
       fix x
       assume "x \<in> S \<inter> range f"
       then obtain y where y: "f y = x" "y \<in> f -` S" by auto
       then obtain e where e: "e > 1" "(1 - e) *\<^sub>R y + e *\<^sub>R z \<in> f -` S"
         using convex_rel_interior_iff[of "f -` S" z] z conv by auto
       moreover have "(1 - e) *\<^sub>R x + e *\<^sub>R f z = f ((1 - e) *\<^sub>R y + e *\<^sub>R z)"
         using \<open>linear f\<close> y by (simp add: linear_iff)
       ultimately have "\<exists>e. e > 1 \<and> (1 - e) *\<^sub>R x + e *\<^sub>R f z \<in> S \<inter> range f"
         using e by auto
     }
     then have "f z \<in> rel_interior (S \<inter> range f)"
       using \<open>convex (S \<inter> (range f))\<close> \<open>S \<inter> range f \<noteq> {}\<close>
         convex_rel_interior_iff[of "S \<inter> (range f)" "f z"]
       by auto
     moreover have "affine (range f)"
       by (simp add: linear_axioms linear_subspace_image subspace_imp_affine)
     ultimately have "f z \<in> rel_interior S"
       using convex_affine_rel_interior_Int[of S "range f"] assms by auto
     then have "z \<in> f -` (rel_interior S)"
       by auto
   }
   ultimately show ?thesis by auto
 qed
 
 lemma rel_interior_Times:
   fixes S :: "'n::euclidean_space set"
     and T :: "'m::euclidean_space set"
   assumes "convex S"
     and "convex T"
   shows "rel_interior (S \<times> T) = rel_interior S \<times> rel_interior T"
 proof -
   { assume "S = {}"
     then have ?thesis
       by auto
   }
   moreover
   { assume "T = {}"
     then have ?thesis
        by auto
   }
   moreover
   {
     assume "S \<noteq> {}" "T \<noteq> {}"
     then have ri: "rel_interior S \<noteq> {}" "rel_interior T \<noteq> {}"
       using rel_interior_eq_empty assms by auto
     then have "fst -` rel_interior S \<noteq> {}"
       using fst_vimage_eq_Times[of "rel_interior S"] by auto
     then have "rel_interior ((fst :: 'n * 'm \<Rightarrow> 'n) -` S) = fst -` rel_interior S"
       using fst_linear \<open>convex S\<close> rel_interior_convex_linear_preimage[of fst S] by auto
     then have s: "rel_interior (S \<times> (UNIV :: 'm set)) = rel_interior S \<times> UNIV"
       by (simp add: fst_vimage_eq_Times)
     from ri have "snd -` rel_interior T \<noteq> {}"
       using snd_vimage_eq_Times[of "rel_interior T"] by auto
     then have "rel_interior ((snd :: 'n * 'm \<Rightarrow> 'm) -` T) = snd -` rel_interior T"
       using snd_linear \<open>convex T\<close> rel_interior_convex_linear_preimage[of snd T] by auto
     then have t: "rel_interior ((UNIV :: 'n set) \<times> T) = UNIV \<times> rel_interior T"
       by (simp add: snd_vimage_eq_Times)
     from s t have *: "rel_interior (S \<times> (UNIV :: 'm set)) \<inter> rel_interior ((UNIV :: 'n set) \<times> T) =
       rel_interior S \<times> rel_interior T" by auto
     have "S \<times> T = S \<times> (UNIV :: 'm set) \<inter> (UNIV :: 'n set) \<times> T"
       by auto
     then have "rel_interior (S \<times> T) = rel_interior ((S \<times> (UNIV :: 'm set)) \<inter> ((UNIV :: 'n set) \<times> T))"
       by auto
     also have "\<dots> = rel_interior (S \<times> (UNIV :: 'm set)) \<inter> rel_interior ((UNIV :: 'n set) \<times> T)"
        apply (subst convex_rel_interior_inter_two[of "S \<times> (UNIV :: 'm set)" "(UNIV :: 'n set) \<times> T"])
        using * ri assms convex_Times
        apply auto
        done
     finally have ?thesis using * by auto
   }
   ultimately show ?thesis by blast
 qed
 
 lemma rel_interior_scaleR:
   fixes S :: "'n::euclidean_space set"
   assumes "c \<noteq> 0"
   shows "((*\<^sub>R) c) ` (rel_interior S) = rel_interior (((*\<^sub>R) c) ` S)"
   using rel_interior_injective_linear_image[of "((*\<^sub>R) c)" S]
     linear_conv_bounded_linear[of "(*\<^sub>R) c"] linear_scaleR injective_scaleR[of c] assms
   by auto
 
 lemma rel_interior_convex_scaleR:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
   shows "((*\<^sub>R) c) ` (rel_interior S) = rel_interior (((*\<^sub>R) c) ` S)"
   by (metis assms linear_scaleR rel_interior_convex_linear_image)
 
 lemma convex_rel_open_scaleR:
   fixes S :: "'n::euclidean_space set"
   assumes "convex S"
     and "rel_open S"
   shows "convex (((*\<^sub>R) c) ` S) \<and> rel_open (((*\<^sub>R) c) ` S)"
   by (metis assms convex_scaling rel_interior_convex_scaleR rel_open_def)
 
 lemma convex_rel_open_finite_inter:
   assumes "\<forall>S\<in>I. convex (S :: 'n::euclidean_space set) \<and> rel_open S"
     and "finite I"
   shows "convex (\<Inter>I) \<and> rel_open (\<Inter>I)"
 proof (cases "\<Inter>{rel_interior S |S. S \<in> I} = {}")
   case True
   then have "\<Inter>I = {}"
     using assms unfolding rel_open_def by auto
   then show ?thesis
     unfolding rel_open_def using rel_interior_empty by auto
 next
   case False
   then have "rel_open (\<Inter>I)"
     using assms unfolding rel_open_def
     using convex_rel_interior_finite_inter[of I]
     by auto
   then show ?thesis
     using convex_Inter assms by auto
 qed
 
 lemma convex_rel_open_linear_image:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes "linear f"
     and "convex S"
     and "rel_open S"
   shows "convex (f ` S) \<and> rel_open (f ` S)"
   by (metis assms convex_linear_image rel_interior_convex_linear_image rel_open_def)
 
 lemma convex_rel_open_linear_preimage:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes "linear f"
     and "convex S"
     and "rel_open S"
   shows "convex (f -` S) \<and> rel_open (f -` S)"
 proof (cases "f -` (rel_interior S) = {}")
   case True
   then have "f -` S = {}"
     using assms unfolding rel_open_def by auto
   then show ?thesis
     unfolding rel_open_def using rel_interior_empty by auto
 next
   case False
   then have "rel_open (f -` S)"
     using assms unfolding rel_open_def
     using rel_interior_convex_linear_preimage[of f S]
     by auto
   then show ?thesis
     using convex_linear_vimage assms
     by auto
 qed
 
 lemma rel_interior_projection:
   fixes S :: "('m::euclidean_space \<times> 'n::euclidean_space) set"
     and f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space set"
   assumes "convex S"
     and "f = (\<lambda>y. {z. (y, z) \<in> S})"
   shows "(y, z) \<in> rel_interior S \<longleftrightarrow> (y \<in> rel_interior {y. (f y \<noteq> {})} \<and> z \<in> rel_interior (f y))"
 proof -
   {
     fix y
     assume "y \<in> {y. f y \<noteq> {}}"
     then obtain z where "(y, z) \<in> S"
       using assms by auto
     then have "\<exists>x. x \<in> S \<and> y = fst x"
       apply (rule_tac x="(y, z)" in exI)
       apply auto
       done
     then obtain x where "x \<in> S" "y = fst x"
       by blast
     then have "y \<in> fst ` S"
       unfolding image_def by auto
   }
   then have "fst ` S = {y. f y \<noteq> {}}"
     unfolding fst_def using assms by auto
   then have h1: "fst ` rel_interior S = rel_interior {y. f y \<noteq> {}}"
     using rel_interior_convex_linear_image[of fst S] assms fst_linear by auto
   {
     fix y
     assume "y \<in> rel_interior {y. f y \<noteq> {}}"
     then have "y \<in> fst ` rel_interior S"
       using h1 by auto
     then have *: "rel_interior S \<inter> fst -` {y} \<noteq> {}"
       by auto
     moreover have aff: "affine (fst -` {y})"
       unfolding affine_alt by (simp add: algebra_simps)
     ultimately have **: "rel_interior (S \<inter> fst -` {y}) = rel_interior S \<inter> fst -` {y}"
       using convex_affine_rel_interior_Int[of S "fst -` {y}"] assms by auto
     have conv: "convex (S \<inter> fst -` {y})"
       using convex_Int assms aff affine_imp_convex by auto
     {
       fix x
       assume "x \<in> f y"
       then have "(y, x) \<in> S \<inter> (fst -` {y})"
         using assms by auto
       moreover have "x = snd (y, x)" by auto
       ultimately have "x \<in> snd ` (S \<inter> fst -` {y})"
         by blast
     }
     then have "snd ` (S \<inter> fst -` {y}) = f y"
       using assms by auto
     then have ***: "rel_interior (f y) = snd ` rel_interior (S \<inter> fst -` {y})"
       using rel_interior_convex_linear_image[of snd "S \<inter> fst -` {y}"] snd_linear conv
       by auto
     {
       fix z
       assume "z \<in> rel_interior (f y)"
       then have "z \<in> snd ` rel_interior (S \<inter> fst -` {y})"
         using *** by auto
       moreover have "{y} = fst ` rel_interior (S \<inter> fst -` {y})"
         using * ** rel_interior_subset by auto
       ultimately have "(y, z) \<in> rel_interior (S \<inter> fst -` {y})"
         by force
       then have "(y,z) \<in> rel_interior S"
         using ** by auto
     }
     moreover
     {
       fix z
       assume "(y, z) \<in> rel_interior S"
       then have "(y, z) \<in> rel_interior (S \<inter> fst -` {y})"
         using ** by auto
       then have "z \<in> snd ` rel_interior (S \<inter> fst -` {y})"
         by (metis Range_iff snd_eq_Range)
       then have "z \<in> rel_interior (f y)"
         using *** by auto
     }
     ultimately have "\<And>z. (y, z) \<in> rel_interior S \<longleftrightarrow> z \<in> rel_interior (f y)"
       by auto
   }
   then have h2: "\<And>y z. y \<in> rel_interior {t. f t \<noteq> {}} \<Longrightarrow>
     (y, z) \<in> rel_interior S \<longleftrightarrow> z \<in> rel_interior (f y)"
     by auto
   {
     fix y z
     assume asm: "(y, z) \<in> rel_interior S"
     then have "y \<in> fst ` rel_interior S"
       by (metis Domain_iff fst_eq_Domain)
     then have "y \<in> rel_interior {t. f t \<noteq> {}}"
       using h1 by auto
     then have "y \<in> rel_interior {t. f t \<noteq> {}}" and "(z \<in> rel_interior (f y))"
       using h2 asm by auto
   }
   then show ?thesis using h2 by blast
 qed
 
 lemma rel_frontier_Times:
   fixes S :: "'n::euclidean_space set"
     and T :: "'m::euclidean_space set"
   assumes "convex S"
     and "convex T"
   shows "rel_frontier S \<times> rel_frontier T \<subseteq> rel_frontier (S \<times> T)"
     by (force simp: rel_frontier_def rel_interior_Times assms closure_Times)
 
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Relative interior of convex cone\<close>
 
 lemma cone_rel_interior:
   fixes S :: "'m::euclidean_space set"
   assumes "cone S"
   shows "cone ({0} \<union> rel_interior S)"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by (simp add: rel_interior_empty cone_0)
 next
   case False
   then have *: "0 \<in> S \<and> (\<forall>c. c > 0 \<longrightarrow> (*\<^sub>R) c ` S = S)"
     using cone_iff[of S] assms by auto
   then have *: "0 \<in> ({0} \<union> rel_interior S)"
     and "\<forall>c. c > 0 \<longrightarrow> (*\<^sub>R) c ` ({0} \<union> rel_interior S) = ({0} \<union> rel_interior S)"
     by (auto simp add: rel_interior_scaleR)
   then show ?thesis
     using cone_iff[of "{0} \<union> rel_interior S"] by auto
 qed
 
 lemma rel_interior_convex_cone_aux:
   fixes S :: "'m::euclidean_space set"
   assumes "convex S"
   shows "(c, x) \<in> rel_interior (cone hull ({(1 :: real)} \<times> S)) \<longleftrightarrow>
     c > 0 \<and> x \<in> (((*\<^sub>R) c) ` (rel_interior S))"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by (simp add: rel_interior_empty cone_hull_empty)
 next
   case False
   then obtain s where "s \<in> S" by auto
   have conv: "convex ({(1 :: real)} \<times> S)"
     using convex_Times[of "{(1 :: real)}" S] assms convex_singleton[of "1 :: real"]
     by auto
   define f where "f y = {z. (y, z) \<in> cone hull ({1 :: real} \<times> S)}" for y
   then have *: "(c, x) \<in> rel_interior (cone hull ({(1 :: real)} \<times> S)) =
     (c \<in> rel_interior {y. f y \<noteq> {}} \<and> x \<in> rel_interior (f c))"
     apply (subst rel_interior_projection[of "cone hull ({(1 :: real)} \<times> S)" f c x])
     using convex_cone_hull[of "{(1 :: real)} \<times> S"] conv
     apply auto
     done
   {
     fix y :: real
     assume "y \<ge> 0"
     then have "y *\<^sub>R (1,s) \<in> cone hull ({1 :: real} \<times> S)"
       using cone_hull_expl[of "{(1 :: real)} \<times> S"] \<open>s \<in> S\<close> by auto
     then have "f y \<noteq> {}"
       using f_def by auto
   }
   then have "{y. f y \<noteq> {}} = {0..}"
     using f_def cone_hull_expl[of "{1 :: real} \<times> S"] by auto
   then have **: "rel_interior {y. f y \<noteq> {}} = {0<..}"
     using rel_interior_real_semiline by auto
   {
     fix c :: real
     assume "c > 0"
     then have "f c = ((*\<^sub>R) c ` S)"
       using f_def cone_hull_expl[of "{1 :: real} \<times> S"] by auto
     then have "rel_interior (f c) = (*\<^sub>R) c ` rel_interior S"
       using rel_interior_convex_scaleR[of S c] assms by auto
   }
   then show ?thesis using * ** by auto
 qed
 
 lemma rel_interior_convex_cone:
   fixes S :: "'m::euclidean_space set"
   assumes "convex S"
   shows "rel_interior (cone hull ({1 :: real} \<times> S)) =
     {(c, c *\<^sub>R x) | c x. c > 0 \<and> x \<in> rel_interior S}"
   (is "?lhs = ?rhs")
 proof -
   {
     fix z
     assume "z \<in> ?lhs"
     have *: "z = (fst z, snd z)"
       by auto
     then have "z \<in> ?rhs"
       using rel_interior_convex_cone_aux[of S "fst z" "snd z"] assms \<open>z \<in> ?lhs\<close> by fastforce
   }
   moreover
   {
     fix z
     assume "z \<in> ?rhs"
     then have "z \<in> ?lhs"
       using rel_interior_convex_cone_aux[of S "fst z" "snd z"] assms
       by auto
   }
   ultimately show ?thesis by blast
 qed
 
 lemma convex_hull_finite_union:
   assumes "finite I"
   assumes "\<forall>i\<in>I. convex (S i) \<and> (S i) \<noteq> {}"
   shows "convex hull (\<Union>(S ` I)) =
     {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)}"
   (is "?lhs = ?rhs")
 proof -
   have "?lhs \<supseteq> ?rhs"
   proof
     fix x
     assume "x \<in> ?rhs"
     then obtain c s where *: "sum (\<lambda>i. c i *\<^sub>R s i) I = x" "sum c I = 1"
       "(\<forall>i\<in>I. c i \<ge> 0) \<and> (\<forall>i\<in>I. s i \<in> S i)" by auto
     then have "\<forall>i\<in>I. s i \<in> convex hull (\<Union>(S ` I))"
       using hull_subset[of "\<Union>(S ` I)" convex] by auto
     then show "x \<in> ?lhs"
       unfolding *(1)[symmetric]
       apply (subst convex_sum[of I "convex hull \<Union>(S ` I)" c s])
       using * assms convex_convex_hull
       apply auto
       done
   qed
 
   {
     fix i
     assume "i \<in> I"
     with assms have "\<exists>p. p \<in> S i" by auto
   }
   then obtain p where p: "\<forall>i\<in>I. p i \<in> S i" by metis
 
   {
     fix i
     assume "i \<in> I"
     {
       fix x
       assume "x \<in> S i"
       define c where "c j = (if j = i then 1::real else 0)" for j
       then have *: "sum c I = 1"
         using \<open>finite I\<close> \<open>i \<in> I\<close> sum.delta[of I i "\<lambda>j::'a. 1::real"]
         by auto
       define s where "s j = (if j = i then x else p j)" for j
       then have "\<forall>j. c j *\<^sub>R s j = (if j = i then x else 0)"
         using c_def by (auto simp add: algebra_simps)
       then have "x = sum (\<lambda>i. c i *\<^sub>R s i) I"
         using s_def c_def \<open>finite I\<close> \<open>i \<in> I\<close> sum.delta[of I i "\<lambda>j::'a. x"]
         by auto
       then have "x \<in> ?rhs"
         apply auto
         apply (rule_tac x = c in exI)
         apply (rule_tac x = s in exI)
         using * c_def s_def p \<open>x \<in> S i\<close>
         apply auto
         done
     }
     then have "?rhs \<supseteq> S i" by auto
   }
   then have *: "?rhs \<supseteq> \<Union>(S ` I)" by auto
 
   {
     fix u v :: real
     assume uv: "u \<ge> 0 \<and> v \<ge> 0 \<and> u + v = 1"
     fix x y
     assume xy: "x \<in> ?rhs \<and> y \<in> ?rhs"
     from xy obtain c s where
       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)"
       by auto
     from xy obtain d t where
       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)"
       by auto
     define e where "e i = u * c i + v * d i" for i
     have ge0: "\<forall>i\<in>I. e i \<ge> 0"
       using e_def xc yc uv by simp
     have "sum (\<lambda>i. u * c i) I = u * sum c I"
       by (simp add: sum_distrib_left)
     moreover have "sum (\<lambda>i. v * d i) I = v * sum d I"
       by (simp add: sum_distrib_left)
     ultimately have sum1: "sum e I = 1"
       using e_def xc yc uv by (simp add: sum.distrib)
     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)"
       for i
     {
       fix i
       assume i: "i \<in> I"
       have "q i \<in> S i"
       proof (cases "e i = 0")
         case True
         then show ?thesis using i p q_def by auto
       next
         case False
         then show ?thesis
           using mem_convex_alt[of "S i" "s i" "t i" "u * (c i)" "v * (d i)"]
             mult_nonneg_nonneg[of u "c i"] mult_nonneg_nonneg[of v "d i"]
             assms q_def e_def i False xc yc uv
           by (auto simp del: mult_nonneg_nonneg)
       qed
     }
     then have qs: "\<forall>i\<in>I. q i \<in> S i" by auto
     {
       fix i
       assume i: "i \<in> I"
       have "(u * c i) *\<^sub>R s i + (v * d i) *\<^sub>R t i = e i *\<^sub>R q i"
       proof (cases "e i = 0")
         case True
         have ge: "u * (c i) \<ge> 0 \<and> v * d i \<ge> 0"
           using xc yc uv i by simp
         moreover from ge have "u * c i \<le> 0 \<and> v * d i \<le> 0"
           using True e_def i by simp
         ultimately have "u * c i = 0 \<and> v * d i = 0" by auto
         with True show ?thesis by auto
       next
         case False
         then have "(u * (c i)/(e i))*\<^sub>R (s i)+(v * (d i)/(e i))*\<^sub>R (t i) = q i"
           using q_def by auto
         then have "e i *\<^sub>R ((u * (c i)/(e i))*\<^sub>R (s i)+(v * (d i)/(e i))*\<^sub>R (t i))
                = (e i) *\<^sub>R (q i)" by auto
         with False show ?thesis by (simp add: algebra_simps)
       qed
     }
     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"
       by auto
     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"
       using xc yc by (simp add: algebra_simps scaleR_right.sum sum.distrib)
     also have "\<dots> = sum (\<lambda>i. e i *\<^sub>R q i) I"
       using * by auto
     finally have "u *\<^sub>R x + v *\<^sub>R y = sum (\<lambda>i. (e i) *\<^sub>R (q i)) I"
       by auto
     then have "u *\<^sub>R x + v *\<^sub>R y \<in> ?rhs"
       using ge0 sum1 qs by auto
   }
   then have "convex ?rhs" unfolding convex_def by auto
   then show ?thesis
     using \<open>?lhs \<supseteq> ?rhs\<close> * hull_minimal[of "\<Union>(S ` I)" ?rhs convex]
     by blast
 qed
 
 lemma convex_hull_union_two:
   fixes S T :: "'m::euclidean_space set"
   assumes "convex S"
     and "S \<noteq> {}"
     and "convex T"
     and "T \<noteq> {}"
   shows "convex hull (S \<union> T) =
     {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}"
   (is "?lhs = ?rhs")
 proof
   define I :: "nat set" where "I = {1, 2}"
   define s where "s i = (if i = (1::nat) then S else T)" for i
   have "\<Union>(s ` I) = S \<union> T"
     using s_def I_def by auto
   then have "convex hull (\<Union>(s ` I)) = convex hull (S \<union> T)"
     by auto
   moreover have "convex hull \<Union>(s ` I) =
     {\<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)}"
       apply (subst convex_hull_finite_union[of I s])
       using assms s_def I_def
       apply auto
       done
   moreover have
     "{\<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"
     using s_def I_def by auto
   ultimately show "?lhs \<subseteq> ?rhs" by auto
   {
     fix x
     assume "x \<in> ?rhs"
     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"
       by auto
     then have "x \<in> convex hull {s, t}"
       using convex_hull_2[of s t] by auto
     then have "x \<in> convex hull (S \<union> T)"
       using * hull_mono[of "{s, t}" "S \<union> T"] by auto
   }
   then show "?lhs \<supseteq> ?rhs" by blast
 qed
 
 proposition ray_to_rel_frontier:
   fixes a :: "'a::real_inner"
   assumes "bounded S"
       and a: "a \<in> rel_interior S"
       and aff: "(a + l) \<in> affine hull S"
       and "l \<noteq> 0"
   obtains d where "0 < d" "(a + d *\<^sub>R l) \<in> rel_frontier S"
            "\<And>e. \<lbrakk>0 \<le> e; e < d\<rbrakk> \<Longrightarrow> (a + e *\<^sub>R l) \<in> rel_interior S"
 proof -
   have aaff: "a \<in> affine hull S"
     by (meson a hull_subset rel_interior_subset rev_subsetD)
   let ?D = "{d. 0 < d \<and> a + d *\<^sub>R l \<notin> rel_interior S}"
   obtain B where "B > 0" and B: "S \<subseteq> ball a B"
     using bounded_subset_ballD [OF \<open>bounded S\<close>] by blast
   have "a + (B / norm l) *\<^sub>R l \<notin> ball a B"
     by (simp add: dist_norm \<open>l \<noteq> 0\<close>)
   with B have "a + (B / norm l) *\<^sub>R l \<notin> rel_interior S"
     using rel_interior_subset subsetCE by blast
   with \<open>B > 0\<close> \<open>l \<noteq> 0\<close> have nonMT: "?D \<noteq> {}"
     using divide_pos_pos zero_less_norm_iff by fastforce
   have bdd: "bdd_below ?D"
     by (metis (no_types, lifting) bdd_belowI le_less mem_Collect_eq)
   have relin_Ex: "\<And>x. x \<in> rel_interior S \<Longrightarrow>
                     \<exists>e>0. \<forall>x'\<in>affine hull S. dist x' x < e \<longrightarrow> x' \<in> rel_interior S"
     using openin_rel_interior [of S] by (simp add: openin_euclidean_subtopology_iff)
   define d where "d = Inf ?D"
   obtain \<epsilon> where "0 < \<epsilon>" and \<epsilon>: "\<And>\<eta>. \<lbrakk>0 \<le> \<eta>; \<eta> < \<epsilon>\<rbrakk> \<Longrightarrow> (a + \<eta> *\<^sub>R l) \<in> rel_interior S"
   proof -
     obtain e where "e>0"
             and e: "\<And>x'. x' \<in> affine hull S \<Longrightarrow> dist x' a < e \<Longrightarrow> x' \<in> rel_interior S"
       using relin_Ex a by blast
     show thesis
     proof (rule_tac \<epsilon> = "e / norm l" in that)
       show "0 < e / norm l" by (simp add: \<open>0 < e\<close> \<open>l \<noteq> 0\<close>)
     next
       show "a + \<eta> *\<^sub>R l \<in> rel_interior S" if "0 \<le> \<eta>" "\<eta> < e / norm l" for \<eta>
       proof (rule e)
         show "a + \<eta> *\<^sub>R l \<in> affine hull S"
           by (metis (no_types) add_diff_cancel_left' aff affine_affine_hull mem_affine_3_minus aaff)
         show "dist (a + \<eta> *\<^sub>R l) a < e"
           using that by (simp add: \<open>l \<noteq> 0\<close> dist_norm pos_less_divide_eq)
       qed
     qed
   qed
   have inint: "\<And>e. \<lbrakk>0 \<le> e; e < d\<rbrakk> \<Longrightarrow> a + e *\<^sub>R l \<in> rel_interior S"
     unfolding d_def using cInf_lower [OF _ bdd]
     by (metis (no_types, lifting) a add.right_neutral le_less mem_Collect_eq not_less real_vector.scale_zero_left)
   have "\<epsilon> \<le> d"
     unfolding d_def
     apply (rule cInf_greatest [OF nonMT])
     using \<epsilon> dual_order.strict_implies_order le_less_linear by blast
   with \<open>0 < \<epsilon>\<close> have "0 < d" by simp
   have "a + d *\<^sub>R l \<notin> rel_interior S"
   proof
     assume adl: "a + d *\<^sub>R l \<in> rel_interior S"
     obtain e where "e > 0"
              and e: "\<And>x'. x' \<in> affine hull S \<Longrightarrow> dist x' (a + d *\<^sub>R l) < e \<Longrightarrow> x' \<in> rel_interior S"
       using relin_Ex adl by blast
     have "d + e / norm l \<le> Inf {d. 0 < d \<and> a + d *\<^sub>R l \<notin> rel_interior S}"
     proof (rule cInf_greatest [OF nonMT], clarsimp)
       fix x::real
       assume "0 < x" and nonrel: "a + x *\<^sub>R l \<notin> rel_interior S"
       show "d + e / norm l \<le> x"
       proof (cases "x < d")
         case True with inint nonrel \<open>0 < x\<close>
           show ?thesis by auto
       next
         case False
           then have dle: "x < d + e / norm l \<Longrightarrow> dist (a + x *\<^sub>R l) (a + d *\<^sub>R l) < e"
             by (simp add: field_simps \<open>l \<noteq> 0\<close>)
           have ain: "a + x *\<^sub>R l \<in> affine hull S"
             by (metis add_diff_cancel_left' aff affine_affine_hull mem_affine_3_minus aaff)
           show ?thesis
             using e [OF ain] nonrel dle by force
       qed
     qed
     then show False
       using \<open>0 < e\<close> \<open>l \<noteq> 0\<close> by (simp add: d_def [symmetric] field_simps)
   qed
   moreover have "a + d *\<^sub>R l \<in> closure S"
   proof (clarsimp simp: closure_approachable)
     fix \<eta>::real assume "0 < \<eta>"
     have 1: "a + (d - min d (\<eta> / 2 / norm l)) *\<^sub>R l \<in> S"
       apply (rule subsetD [OF rel_interior_subset inint])
       using \<open>l \<noteq> 0\<close> \<open>0 < d\<close> \<open>0 < \<eta>\<close> by auto
     have "norm l * min d (\<eta> / (norm l * 2)) \<le> norm l * (\<eta> / (norm l * 2))"
       by (metis min_def mult_left_mono norm_ge_zero order_refl)
     also have "... < \<eta>"
       using \<open>l \<noteq> 0\<close> \<open>0 < \<eta>\<close> by (simp add: field_simps)
     finally have 2: "norm l * min d (\<eta> / (norm l * 2)) < \<eta>" .
     show "\<exists>y\<in>S. dist y (a + d *\<^sub>R l) < \<eta>"
       apply (rule_tac x="a + (d - min d (\<eta> / 2 / norm l)) *\<^sub>R l" in bexI)
       using 1 2 \<open>0 < d\<close> \<open>0 < \<eta>\<close> apply (auto simp: algebra_simps)
       done
   qed
   ultimately have infront: "a + d *\<^sub>R l \<in> rel_frontier S"
     by (simp add: rel_frontier_def)
   show ?thesis
     by (rule that [OF \<open>0 < d\<close> infront inint])
 qed
 
 corollary ray_to_frontier:
   fixes a :: "'a::euclidean_space"
   assumes "bounded S"
       and a: "a \<in> interior S"
       and "l \<noteq> 0"
   obtains d where "0 < d" "(a + d *\<^sub>R l) \<in> frontier S"
            "\<And>e. \<lbrakk>0 \<le> e; e < d\<rbrakk> \<Longrightarrow> (a + e *\<^sub>R l) \<in> interior S"
 proof -
   have "interior S = rel_interior S"
     using a rel_interior_nonempty_interior by auto
   then have "a \<in> rel_interior S"
     using a by simp
   then show ?thesis
     apply (rule ray_to_rel_frontier [OF \<open>bounded S\<close> _ _ \<open>l \<noteq> 0\<close>])
      using a affine_hull_nonempty_interior apply blast
     by (simp add: \<open>interior S = rel_interior S\<close> frontier_def rel_frontier_def that)
 qed
 
 
 lemma segment_to_rel_frontier_aux:
   fixes x :: "'a::euclidean_space"
   assumes "convex S" "bounded S" and x: "x \<in> rel_interior S" and y: "y \<in> S" and xy: "x \<noteq> y"
   obtains z where "z \<in> rel_frontier S" "y \<in> closed_segment x z"
                    "open_segment x z \<subseteq> rel_interior S"
 proof -
   have "x + (y - x) \<in> affine hull S"
     using hull_inc [OF y] by auto
   then obtain d where "0 < d" and df: "(x + d *\<^sub>R (y-x)) \<in> rel_frontier S"
                   and di: "\<And>e. \<lbrakk>0 \<le> e; e < d\<rbrakk> \<Longrightarrow> (x + e *\<^sub>R (y-x)) \<in> rel_interior S"
     by (rule ray_to_rel_frontier [OF \<open>bounded S\<close> x]) (use xy in auto)
   show ?thesis
   proof
     show "x + d *\<^sub>R (y - x) \<in> rel_frontier S"
       by (simp add: df)
   next
     have "open_segment x y \<subseteq> rel_interior S"
       using rel_interior_closure_convex_segment [OF \<open>convex S\<close> x] closure_subset y by blast
     moreover have "x + d *\<^sub>R (y - x) \<in> open_segment x y" if "d < 1"
       using xy
       apply (auto simp: in_segment)
       apply (rule_tac x="d" in exI)
       using \<open>0 < d\<close> that apply (auto simp: algebra_simps)
       done
     ultimately have "1 \<le> d"
       using df rel_frontier_def by fastforce
     moreover have "x = (1 / d) *\<^sub>R x + ((d - 1) / d) *\<^sub>R x"
       by (metis \<open>0 < d\<close> add.commute add_divide_distrib diff_add_cancel divide_self_if less_irrefl scaleR_add_left scaleR_one)
     ultimately show "y \<in> closed_segment x (x + d *\<^sub>R (y - x))"
       apply (auto simp: in_segment)
       apply (rule_tac x="1/d" in exI)
       apply (auto simp: algebra_simps)
       done
   next
     show "open_segment x (x + d *\<^sub>R (y - x)) \<subseteq> rel_interior S"
       apply (rule rel_interior_closure_convex_segment [OF \<open>convex S\<close> x])
       using df rel_frontier_def by auto
   qed
 qed
 
 lemma segment_to_rel_frontier:
   fixes x :: "'a::euclidean_space"
   assumes S: "convex S" "bounded S" and x: "x \<in> rel_interior S"
       and y: "y \<in> S" and xy: "\<not>(x = y \<and> S = {x})"
   obtains z where "z \<in> rel_frontier S" "y \<in> closed_segment x z"
                   "open_segment x z \<subseteq> rel_interior S"
 proof (cases "x=y")
   case True
   with xy have "S \<noteq> {x}"
     by blast
   with True show ?thesis
     by (metis Set.set_insert all_not_in_conv ends_in_segment(1) insert_iff segment_to_rel_frontier_aux[OF S x] that y)
 next
   case False
   then show ?thesis
     using segment_to_rel_frontier_aux [OF S x y] that by blast
 qed
 
 proposition rel_frontier_not_sing:
   fixes a :: "'a::euclidean_space"
   assumes "bounded S"
     shows "rel_frontier S \<noteq> {a}"
 proof (cases "S = {}")
   case True  then show ?thesis  by simp
 next
   case False
   then obtain z where "z \<in> S"
     by blast
   then show ?thesis
   proof (cases "S = {z}")
     case True then show ?thesis  by simp
   next
     case False
     then obtain w where "w \<in> S" "w \<noteq> z"
       using \<open>z \<in> S\<close> by blast
     show ?thesis
     proof
       assume "rel_frontier S = {a}"
       then consider "w \<notin> rel_frontier S" | "z \<notin> rel_frontier S"
         using \<open>w \<noteq> z\<close> by auto
       then show False
       proof cases
         case 1
         then have w: "w \<in> rel_interior S"
           using \<open>w \<in> S\<close> closure_subset rel_frontier_def by fastforce
         have "w + (w - z) \<in> affine hull S"
           by (metis \<open>w \<in> S\<close> \<open>z \<in> S\<close> affine_affine_hull hull_inc mem_affine_3_minus scaleR_one)
         then obtain e where "0 < e" "(w + e *\<^sub>R (w - z)) \<in> rel_frontier S"
           using \<open>w \<noteq> z\<close>  \<open>z \<in> S\<close> by (metis assms ray_to_rel_frontier right_minus_eq w)
         moreover obtain d where "0 < d" "(w + d *\<^sub>R (z - w)) \<in> rel_frontier S"
           using ray_to_rel_frontier [OF \<open>bounded S\<close> w, of "1 *\<^sub>R (z - w)"]  \<open>w \<noteq> z\<close>  \<open>z \<in> S\<close>
           by (metis add.commute add.right_neutral diff_add_cancel hull_inc scaleR_one)
         ultimately have "d *\<^sub>R (z - w) = e *\<^sub>R (w - z)"
           using \<open>rel_frontier S = {a}\<close> by force
         moreover have "e \<noteq> -d "
           using \<open>0 < e\<close> \<open>0 < d\<close> by force
         ultimately show False
           by (metis (no_types, lifting) \<open>w \<noteq> z\<close> eq_iff_diff_eq_0 minus_diff_eq real_vector.scale_cancel_right real_vector.scale_minus_right scaleR_left.minus)
       next
         case 2
         then have z: "z \<in> rel_interior S"
           using \<open>z \<in> S\<close> closure_subset rel_frontier_def by fastforce
         have "z + (z - w) \<in> affine hull S"
           by (metis \<open>z \<in> S\<close> \<open>w \<in> S\<close> affine_affine_hull hull_inc mem_affine_3_minus scaleR_one)
         then obtain e where "0 < e" "(z + e *\<^sub>R (z - w)) \<in> rel_frontier S"
           using \<open>w \<noteq> z\<close>  \<open>w \<in> S\<close> by (metis assms ray_to_rel_frontier right_minus_eq z)
         moreover obtain d where "0 < d" "(z + d *\<^sub>R (w - z)) \<in> rel_frontier S"
           using ray_to_rel_frontier [OF \<open>bounded S\<close> z, of "1 *\<^sub>R (w - z)"]  \<open>w \<noteq> z\<close>  \<open>w \<in> S\<close>
           by (metis add.commute add.right_neutral diff_add_cancel hull_inc scaleR_one)
         ultimately have "d *\<^sub>R (w - z) = e *\<^sub>R (z - w)"
           using \<open>rel_frontier S = {a}\<close> by force
         moreover have "e \<noteq> -d "
           using \<open>0 < e\<close> \<open>0 < d\<close> by force
         ultimately show False
           by (metis (no_types, lifting) \<open>w \<noteq> z\<close> eq_iff_diff_eq_0 minus_diff_eq real_vector.scale_cancel_right real_vector.scale_minus_right scaleR_left.minus)
       qed
     qed
   qed
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Convexity on direct sums\<close>
 
 lemma closure_sum:
   fixes S T :: "'a::real_normed_vector set"
   shows "closure S + closure T \<subseteq> closure (S + T)"
   unfolding set_plus_image closure_Times [symmetric] split_def
   by (intro closure_bounded_linear_image_subset bounded_linear_add
     bounded_linear_fst bounded_linear_snd)
 
 lemma rel_interior_sum:
   fixes S T :: "'n::euclidean_space set"
   assumes "convex S"
     and "convex T"
   shows "rel_interior (S + T) = rel_interior S + rel_interior T"
 proof -
   have "rel_interior S + rel_interior T = (\<lambda>(x,y). x + y) ` (rel_interior S \<times> rel_interior T)"
     by (simp add: set_plus_image)
   also have "\<dots> = (\<lambda>(x,y). x + y) ` rel_interior (S \<times> T)"
     using rel_interior_Times assms by auto
   also have "\<dots> = rel_interior (S + T)"
     using fst_snd_linear convex_Times assms
       rel_interior_convex_linear_image[of "(\<lambda>(x,y). x + y)" "S \<times> T"]
     by (auto simp add: set_plus_image)
   finally show ?thesis ..
 qed
 
 lemma rel_interior_sum_gen:
   fixes S :: "'a \<Rightarrow> 'n::euclidean_space set"
   assumes "\<forall>i\<in>I. convex (S i)"
   shows "rel_interior (sum S I) = sum (\<lambda>i. rel_interior (S i)) I"
   apply (subst sum_set_cond_linear[of convex])
   using rel_interior_sum rel_interior_sing[of "0"] assms
   apply (auto simp add: convex_set_plus)
   done
 
 lemma convex_rel_open_direct_sum:
   fixes S T :: "'n::euclidean_space set"
   assumes "convex S"
     and "rel_open S"
     and "convex T"
     and "rel_open T"
   shows "convex (S \<times> T) \<and> rel_open (S \<times> T)"
   by (metis assms convex_Times rel_interior_Times rel_open_def)
 
 lemma convex_rel_open_sum:
   fixes S T :: "'n::euclidean_space set"
   assumes "convex S"
     and "rel_open S"
     and "convex T"
     and "rel_open T"
   shows "convex (S + T) \<and> rel_open (S + T)"
   by (metis assms convex_set_plus rel_interior_sum rel_open_def)
 
 lemma convex_hull_finite_union_cones:
   assumes "finite I"
     and "I \<noteq> {}"
   assumes "\<forall>i\<in>I. convex (S i) \<and> cone (S i) \<and> S i \<noteq> {}"
   shows "convex hull (\<Union>(S ` I)) = sum S I"
   (is "?lhs = ?rhs")
 proof -
   {
     fix x
     assume "x \<in> ?lhs"
     then obtain c xs where
       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)"
       using convex_hull_finite_union[of I S] assms by auto
     define s where "s i = c i *\<^sub>R xs i" for i
     {
       fix i
       assume "i \<in> I"
       then have "s i \<in> S i"
         using s_def x assms mem_cone[of "S i" "xs i" "c i"] by auto
     }
     then have "\<forall>i\<in>I. s i \<in> S i" by auto
     moreover have "x = sum s I" using x s_def by auto
     ultimately have "x \<in> ?rhs"
       using set_sum_alt[of I S] assms by auto
   }
   moreover
   {
     fix x
     assume "x \<in> ?rhs"
     then obtain s where x: "x = sum s I \<and> (\<forall>i\<in>I. s i \<in> S i)"
       using set_sum_alt[of I S] assms by auto
     define xs where "xs i = of_nat(card I) *\<^sub>R s i" for i
     then have "x = sum (\<lambda>i. ((1 :: real) / of_nat(card I)) *\<^sub>R xs i) I"
       using x assms by auto
     moreover have "\<forall>i\<in>I. xs i \<in> S i"
       using x xs_def assms by (simp add: cone_def)
     moreover have "\<forall>i\<in>I. (1 :: real) / of_nat (card I) \<ge> 0"
       by auto
     moreover have "sum (\<lambda>i. (1 :: real) / of_nat (card I)) I = 1"
       using assms by auto
     ultimately have "x \<in> ?lhs"
       apply (subst convex_hull_finite_union[of I S])
       using assms
       apply blast
       using assms
       apply blast
       apply rule
       apply (rule_tac x = "(\<lambda>i. (1 :: real) / of_nat (card I))" in exI)
       apply auto
       done
   }
   ultimately show ?thesis by auto
 qed
 
 lemma convex_hull_union_cones_two:
   fixes S T :: "'m::euclidean_space set"
   assumes "convex S"
     and "cone S"
     and "S \<noteq> {}"
   assumes "convex T"
     and "cone T"
     and "T \<noteq> {}"
   shows "convex hull (S \<union> T) = S + T"
 proof -
   define I :: "nat set" where "I = {1, 2}"
   define A where "A i = (if i = (1::nat) then S else T)" for i
   have "\<Union>(A ` I) = S \<union> T"
     using A_def I_def by auto
   then have "convex hull (\<Union>(A ` I)) = convex hull (S \<union> T)"
     by auto
   moreover have "convex hull \<Union>(A ` I) = sum A I"
     apply (subst convex_hull_finite_union_cones[of I A])
     using assms A_def I_def
     apply auto
     done
   moreover have "sum A I = S + T"
     using A_def I_def
     unfolding set_plus_def
     apply auto
     unfolding set_plus_def
     apply auto
     done
   ultimately show ?thesis by auto
 qed
 
 lemma rel_interior_convex_hull_union:
   fixes S :: "'a \<Rightarrow> 'n::euclidean_space set"
   assumes "finite I"
     and "\<forall>i\<in>I. convex (S i) \<and> S i \<noteq> {}"
   shows "rel_interior (convex hull (\<Union>(S ` I))) =
     {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>
       (\<forall>i\<in>I. s i \<in> rel_interior(S i))}"
   (is "?lhs = ?rhs")
 proof (cases "I = {}")
   case True
   then show ?thesis
     using convex_hull_empty rel_interior_empty by auto
 next
   case False
   define C0 where "C0 = convex hull (\<Union>(S ` I))"
   have "\<forall>i\<in>I. C0 \<ge> S i"
     unfolding C0_def using hull_subset[of "\<Union>(S ` I)"] by auto
   define K0 where "K0 = cone hull ({1 :: real} \<times> C0)"
   define K where "K i = cone hull ({1 :: real} \<times> S i)" for i
   have "\<forall>i\<in>I. K i \<noteq> {}"
     unfolding K_def using assms
     by (simp add: cone_hull_empty_iff[symmetric])
   {
     fix i
     assume "i \<in> I"
     then have "convex (K i)"
       unfolding K_def
       apply (subst convex_cone_hull)
       apply (subst convex_Times)
       using assms
       apply auto
       done
   }
   then have convK: "\<forall>i\<in>I. convex (K i)"
     by auto
   {
     fix i
     assume "i \<in> I"
     then have "K0 \<supseteq> K i"
       unfolding K0_def K_def
       apply (subst hull_mono)
       using \<open>\<forall>i\<in>I. C0 \<ge> S i\<close>
       apply auto
       done
   }
   then have "K0 \<supseteq> \<Union>(K ` I)" by auto
   moreover have "convex K0"
     unfolding K0_def
     apply (subst convex_cone_hull)
     apply (subst convex_Times)
     unfolding C0_def
     using convex_convex_hull
     apply auto
     done
   ultimately have geq: "K0 \<supseteq> convex hull (\<Union>(K ` I))"
     using hull_minimal[of _ "K0" "convex"] by blast
   have "\<forall>i\<in>I. K i \<supseteq> {1 :: real} \<times> S i"
     using K_def by (simp add: hull_subset)
   then have "\<Union>(K ` I) \<supseteq> {1 :: real} \<times> \<Union>(S ` I)"
     by auto
   then have "convex hull \<Union>(K ` I) \<supseteq> convex hull ({1 :: real} \<times> \<Union>(S ` I))"
     by (simp add: hull_mono)
   then have "convex hull \<Union>(K ` I) \<supseteq> {1 :: real} \<times> C0"
     unfolding C0_def
     using convex_hull_Times[of "{(1 :: real)}" "\<Union>(S ` I)"] convex_hull_singleton
     by auto
   moreover have "cone (convex hull (\<Union>(K ` I)))"
     apply (subst cone_convex_hull)
     using cone_Union[of "K ` I"]
     apply auto
     unfolding K_def
     using cone_cone_hull
     apply auto
     done
   ultimately have "convex hull (\<Union>(K ` I)) \<supseteq> K0"
     unfolding K0_def
     using hull_minimal[of _ "convex hull (\<Union>(K ` I))" "cone"]
     by blast
   then have "K0 = convex hull (\<Union>(K ` I))"
     using geq by auto
   also have "\<dots> = sum K I"
     apply (subst convex_hull_finite_union_cones[of I K])
     using assms
     apply blast
     using False
     apply blast
     unfolding K_def
     apply rule
     apply (subst convex_cone_hull)
     apply (subst convex_Times)
     using assms cone_cone_hull \<open>\<forall>i\<in>I. K i \<noteq> {}\<close> K_def
     apply auto
     done
   finally have "K0 = sum K I" by auto
   then have *: "rel_interior K0 = sum (\<lambda>i. (rel_interior (K i))) I"
     using rel_interior_sum_gen[of I K] convK by auto
   {
     fix x
     assume "x \<in> ?lhs"
     then have "(1::real, x) \<in> rel_interior K0"
       using K0_def C0_def rel_interior_convex_cone_aux[of C0 "1::real" x] convex_convex_hull
       by auto
     then obtain k where k: "(1::real, x) = sum k I \<and> (\<forall>i\<in>I. k i \<in> rel_interior (K i))"
       using \<open>finite I\<close> * set_sum_alt[of I "\<lambda>i. rel_interior (K i)"] by auto
     {
       fix i
       assume "i \<in> I"
       then have "convex (S i) \<and> k i \<in> rel_interior (cone hull {1} \<times> S i)"
         using k K_def assms by auto
       then have "\<exists>ci si. k i = (ci, ci *\<^sub>R si) \<and> 0 < ci \<and> si \<in> rel_interior (S i)"
         using rel_interior_convex_cone[of "S i"] by auto
     }
     then obtain c s where
       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)"
       by metis
     then have "x = (\<Sum>i\<in>I. c i *\<^sub>R s i) \<and> sum c I = 1"
       using k by (simp add: sum_prod)
     then have "x \<in> ?rhs"
       using k cs by auto
   }
   moreover
   {
     fix x
     assume "x \<in> ?rhs"
     then obtain c s where cs: "x = sum (\<lambda>i. c i *\<^sub>R s i) I \<and>
         (\<forall>i\<in>I. c i > 0) \<and> sum c I = 1 \<and> (\<forall>i\<in>I. s i \<in> rel_interior (S i))"
       by auto
     define k where "k i = (c i, c i *\<^sub>R s i)" for i
     {
       fix i assume "i \<in> I"
       then have "k i \<in> rel_interior (K i)"
         using k_def K_def assms cs rel_interior_convex_cone[of "S i"]
         by auto
     }
     then have "(1::real, x) \<in> rel_interior K0"
       using K0_def * set_sum_alt[of I "(\<lambda>i. rel_interior (K i))"] assms k_def cs
       apply auto
       apply (rule_tac x = k in exI)
       apply (simp add: sum_prod)
       done
     then have "x \<in> ?lhs"
       using K0_def C0_def rel_interior_convex_cone_aux[of C0 1 x]
       by auto
   }
   ultimately show ?thesis by blast
 qed
 
 
 lemma convex_le_Inf_differential:
   fixes f :: "real \<Rightarrow> real"
   assumes "convex_on I f"
     and "x \<in> interior I"
     and "y \<in> I"
   shows "f y \<ge> f x + Inf ((\<lambda>t. (f x - f t) / (x - t)) ` ({x<..} \<inter> I)) * (y - x)"
   (is "_ \<ge> _ + Inf (?F x) * (y - x)")
 proof (cases rule: linorder_cases)
   assume "x < y"
   moreover
   have "open (interior I)" by auto
   from openE[OF this \<open>x \<in> interior I\<close>]
   obtain e where e: "0 < e" "ball x e \<subseteq> interior I" .
   moreover define t where "t = min (x + e / 2) ((x + y) / 2)"
   ultimately have "x < t" "t < y" "t \<in> ball x e"
     by (auto simp: dist_real_def field_simps split: split_min)
   with \<open>x \<in> interior I\<close> e interior_subset[of I] have "t \<in> I" "x \<in> I" by auto
 
   have "open (interior I)" by auto
   from openE[OF this \<open>x \<in> interior I\<close>]
   obtain e where "0 < e" "ball x e \<subseteq> interior I" .
   moreover define K where "K = x - e / 2"
   with \<open>0 < e\<close> have "K \<in> ball x e" "K < x"
     by (auto simp: dist_real_def)
   ultimately have "K \<in> I" "K < x" "x \<in> I"
     using interior_subset[of I] \<open>x \<in> interior I\<close> by auto
 
   have "Inf (?F x) \<le> (f x - f y) / (x - y)"
   proof (intro bdd_belowI cInf_lower2)
     show "(f x - f t) / (x - t) \<in> ?F x"
       using \<open>t \<in> I\<close> \<open>x < t\<close> by auto
     show "(f x - f t) / (x - t) \<le> (f x - f y) / (x - y)"
       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>
       by (rule convex_on_diff)
   next
     fix y
     assume "y \<in> ?F x"
     with order_trans[OF convex_on_diff[OF \<open>convex_on I f\<close> \<open>K \<in> I\<close> _ \<open>K < x\<close> _]]
     show "(f K - f x) / (K - x) \<le> y" by auto
   qed
   then show ?thesis
     using \<open>x < y\<close> by (simp add: field_simps)
 next
   assume "y < x"
   moreover
   have "open (interior I)" by auto
   from openE[OF this \<open>x \<in> interior I\<close>]
   obtain e where e: "0 < e" "ball x e \<subseteq> interior I" .
   moreover define t where "t = x + e / 2"
   ultimately have "x < t" "t \<in> ball x e"
     by (auto simp: dist_real_def field_simps)
   with \<open>x \<in> interior I\<close> e interior_subset[of I] have "t \<in> I" "x \<in> I" by auto
 
   have "(f x - f y) / (x - y) \<le> Inf (?F x)"
   proof (rule cInf_greatest)
     have "(f x - f y) / (x - y) = (f y - f x) / (y - x)"
       using \<open>y < x\<close> by (auto simp: field_simps)
     also
     fix z
     assume "z \<in> ?F x"
     with order_trans[OF convex_on_diff[OF \<open>convex_on I f\<close> \<open>y \<in> I\<close> _ \<open>y < x\<close>]]
     have "(f y - f x) / (y - x) \<le> z"
       by auto
     finally show "(f x - f y) / (x - y) \<le> z" .
   next
     have "open (interior I)" by auto
     from openE[OF this \<open>x \<in> interior I\<close>]
     obtain e where e: "0 < e" "ball x e \<subseteq> interior I" .
     then have "x + e / 2 \<in> ball x e"
       by (auto simp: dist_real_def)
     with e interior_subset[of I] have "x + e / 2 \<in> {x<..} \<inter> I"
       by auto
     then show "?F x \<noteq> {}"
       by blast
   qed
   then show ?thesis
     using \<open>y < x\<close> by (simp add: field_simps)
 qed simp
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Explicit formulas for interior and relative interior of convex hull\<close>
 
 lemma at_within_cbox_finite:
   assumes "x \<in> box a b" "x \<notin> S" "finite S"
   shows "(at x within cbox a b - S) = at x"
 proof -
   have "interior (cbox a b - S) = box a b - S"
     using \<open>finite S\<close> by (simp add: interior_diff finite_imp_closed)
   then show ?thesis
     using at_within_interior assms by fastforce
 qed
 
 lemma affine_independent_convex_affine_hull:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent s" "t \<subseteq> s"
     shows "convex hull t = affine hull t \<inter> convex hull s"
 proof -
   have fin: "finite s" "finite t" using assms aff_independent_finite finite_subset by auto
     { fix u v x
       assume uv: "sum u t = 1" "\<forall>x\<in>s. 0 \<le> v x" "sum v s = 1"
                  "(\<Sum>x\<in>s. v x *\<^sub>R x) = (\<Sum>v\<in>t. u v *\<^sub>R v)" "x \<in> t"
       then have s: "s = (s - t) \<union> t" \<comment> \<open>split into separate cases\<close>
         using assms by auto
       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)"
                    "sum v t + sum v (s - t) = 1"
         using uv fin s
         by (auto simp: sum.union_disjoint [symmetric] Un_commute)
       have "(\<Sum>x\<in>s. if x \<in> t then v x - u x else v x) = 0"
            "(\<Sum>x\<in>s. (if x \<in> t then v x - u x else v x) *\<^sub>R x) = 0"
         using uv fin
         by (subst s, subst sum.union_disjoint, auto simp: algebra_simps sum_subtractf)+
     } note [simp] = this
   have "convex hull t \<subseteq> affine hull t"
     using convex_hull_subset_affine_hull by blast
   moreover have "convex hull t \<subseteq> convex hull s"
     using assms hull_mono by blast
   moreover have "affine hull t \<inter> convex hull s \<subseteq> convex hull t"
     using assms
     apply (simp add: convex_hull_finite affine_hull_finite fin affine_dependent_explicit)
     apply (drule_tac x=s in spec)
     apply (auto simp: fin)
     apply (rule_tac x=u in exI)
     apply (rename_tac v)
     apply (drule_tac x="\<lambda>x. if x \<in> t then v x - u x else v x" in spec)
     apply (force)+
     done
   ultimately show ?thesis
     by blast
 qed
 
 lemma affine_independent_span_eq:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent s" "card s = Suc (DIM ('a))"
     shows "affine hull s = UNIV"
 proof (cases "s = {}")
   case True then show ?thesis
     using assms by simp
 next
   case False
     then obtain a t where t: "a \<notin> t" "s = insert a t"
       by blast
     then have fin: "finite t" using assms
       by (metis finite_insert aff_independent_finite)
     show ?thesis
     using assms t fin
       apply (simp add: affine_dependent_iff_dependent affine_hull_insert_span_gen)
       apply (rule subset_antisym)
       apply force
       apply (rule Fun.vimage_subsetD)
       apply (metis add.commute diff_add_cancel surj_def)
       apply (rule card_ge_dim_independent)
       apply (auto simp: card_image inj_on_def dim_subset_UNIV)
       done
 qed
 
 lemma affine_independent_span_gt:
   fixes s :: "'a::euclidean_space set"
   assumes ind: "\<not> affine_dependent s" and dim: "DIM ('a) < card s"
     shows "affine hull s = UNIV"
   apply (rule affine_independent_span_eq [OF ind])
   apply (rule antisym)
   using assms
   apply auto
   apply (metis add_2_eq_Suc' not_less_eq_eq affine_dependent_biggerset aff_independent_finite)
   done
 
 lemma empty_interior_affine_hull:
   fixes s :: "'a::euclidean_space set"
   assumes "finite s" and dim: "card s \<le> DIM ('a)"
     shows "interior(affine hull s) = {}"
   using assms
   apply (induct s rule: finite_induct)
   apply (simp_all add:  affine_dependent_iff_dependent affine_hull_insert_span_gen interior_translation)
   apply (rule empty_interior_lowdim)
   by (auto simp: Suc_le_lessD card_image_le dual_order.trans intro!: dim_le_card'[THEN le_less_trans])
 
 lemma empty_interior_convex_hull:
   fixes s :: "'a::euclidean_space set"
   assumes "finite s" and dim: "card s \<le> DIM ('a)"
     shows "interior(convex hull s) = {}"
   by (metis Diff_empty Diff_eq_empty_iff convex_hull_subset_affine_hull
             interior_mono empty_interior_affine_hull [OF assms])
 
 lemma explicit_subset_rel_interior_convex_hull:
   fixes s :: "'a::euclidean_space set"
   shows "finite s
          \<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}
              \<subseteq> rel_interior (convex hull s)"
   by (force simp add:  rel_interior_convex_hull_union [where S="\<lambda>x. {x}" and I=s, simplified])
 
 lemma explicit_subset_rel_interior_convex_hull_minimal:
   fixes s :: "'a::euclidean_space set"
   shows "finite s
          \<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}
              \<subseteq> rel_interior (convex hull s)"
   by (force simp add:  rel_interior_convex_hull_union [where S="\<lambda>x. {x}" and I=s, simplified])
 
 lemma rel_interior_convex_hull_explicit:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent s"
   shows "rel_interior(convex hull s) =
          {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}"
          (is "?lhs = ?rhs")
 proof
   show "?rhs \<le> ?lhs"
     by (simp add: aff_independent_finite explicit_subset_rel_interior_convex_hull_minimal assms)
 next
   show "?lhs \<le> ?rhs"
   proof (cases "\<exists>a. s = {a}")
     case True then show "?lhs \<le> ?rhs"
       by force
   next
     case False
     have fs: "finite s"
       using assms by (simp add: aff_independent_finite)
     { fix a b and d::real
       assume ab: "a \<in> s" "b \<in> s" "a \<noteq> b"
       then have s: "s = (s - {a,b}) \<union> {a,b}" \<comment> \<open>split into separate cases\<close>
         by auto
       have "(\<Sum>x\<in>s. if x = a then - d else if x = b then d else 0) = 0"
            "(\<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"
         using ab fs
         by (subst s, subst sum.union_disjoint, auto)+
     } note [simp] = this
     { fix y
       assume y: "y \<in> convex hull s" "y \<notin> ?rhs"
       { fix u T a
         assume ua: "\<forall>x\<in>s. 0 \<le> u x" "sum u s = 1" "\<not> 0 < u a" "a \<in> s"
            and yT: "y = (\<Sum>x\<in>s. u x *\<^sub>R x)" "y \<in> T" "open T"
            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}"
         have ua0: "u a = 0"
           using ua by auto
         obtain b where b: "b\<in>s" "a \<noteq> b"
           using ua False by auto
         obtain e where e: "0 < e" "ball (\<Sum>x\<in>s. u x *\<^sub>R x) e \<subseteq> T"
           using yT by (auto elim: openE)
         with b obtain d where d: "0 < d" "norm(d *\<^sub>R (a-b)) < e"
           by (auto intro: that [of "e / 2 / norm(a-b)"])
         have "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> affine hull s"
           using yT y by (metis affine_hull_convex_hull hull_redundant_eq)
         then have "(\<Sum>x\<in>s. u x *\<^sub>R x) - d *\<^sub>R (a - b) \<in> affine hull s"
           using ua b by (auto simp: hull_inc intro: mem_affine_3_minus2)
         then have "y - d *\<^sub>R (a - b) \<in> T \<inter> affine hull s"
           using d e yT by auto
         then obtain v where "\<forall>x\<in>s. 0 \<le> v x"
                             "sum v s = 1"
                             "(\<Sum>x\<in>s. v x *\<^sub>R x) = (\<Sum>x\<in>s. u x *\<^sub>R x) - d *\<^sub>R (a - b)"
           using subsetD [OF sb] yT
           by auto
         then have False
           using assms
           apply (simp add: affine_dependent_explicit_finite fs)
           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)
           using ua b d
           apply (auto simp: algebra_simps sum_subtractf sum.distrib)
           done
       } note * = this
       have "y \<notin> rel_interior (convex hull s)"
         using y
         apply (simp add: mem_rel_interior affine_hull_convex_hull)
         apply (auto simp: convex_hull_finite [OF fs])
         apply (drule_tac x=u in spec)
         apply (auto intro: *)
         done
     } with rel_interior_subset show "?lhs \<le> ?rhs"
       by blast
   qed
 qed
 
 lemma interior_convex_hull_explicit_minimal:
   fixes s :: "'a::euclidean_space set"
   shows
    "\<not> affine_dependent s
         ==> interior(convex hull s) =
              (if card(s) \<le> DIM('a) then {}
               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})"
   apply (simp add: aff_independent_finite empty_interior_convex_hull, clarify)
   apply (rule trans [of _ "rel_interior(convex hull s)"])
   apply (simp add: affine_independent_span_gt rel_interior_interior)
   by (simp add: rel_interior_convex_hull_explicit)
 
 lemma interior_convex_hull_explicit:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent s"
   shows
    "interior(convex hull s) =
              (if card(s) \<le> DIM('a) then {}
               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})"
 proof -
   { fix u :: "'a \<Rightarrow> real" and a
     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"
     then have cs: "Suc 0 < card s"
       by (metis DIM_positive less_trans_Suc)
     obtain b where b: "b \<in> s" "a \<noteq> b"
     proof (cases "s \<le> {a}")
       case True
       then show thesis
         using cs subset_singletonD by fastforce
     next
       case False
       then show thesis
       by (blast intro: that)
     qed
     have "u a + u b \<le> sum u {a,b}"
       using a b by simp
     also have "... \<le> sum u s"
       apply (rule Groups_Big.sum_mono2)
       using a b u
       apply (auto simp: less_imp_le aff_independent_finite assms)
       done
     finally have "u a < 1"
       using \<open>b \<in> s\<close> u by fastforce
   } note [simp] = this
   show ?thesis
     using assms
     apply (auto simp: interior_convex_hull_explicit_minimal)
     apply (rule_tac x=u in exI)
     apply (auto simp: not_le)
     done
 qed
 
 lemma interior_closed_segment_ge2:
   fixes a :: "'a::euclidean_space"
   assumes "2 \<le> DIM('a)"
     shows  "interior(closed_segment a b) = {}"
 using assms unfolding segment_convex_hull
 proof -
   have "card {a, b} \<le> DIM('a)"
     using assms
     by (simp add: card_insert_if linear not_less_eq_eq numeral_2_eq_2)
   then show "interior (convex hull {a, b}) = {}"
     by (metis empty_interior_convex_hull finite.insertI finite.emptyI)
 qed
 
 lemma interior_open_segment:
   fixes a :: "'a::euclidean_space"
   shows  "interior(open_segment a b) =
                  (if 2 \<le> DIM('a) then {} else open_segment a b)"
 proof (simp add: not_le, intro conjI impI)
   assume "2 \<le> DIM('a)"
   then show "interior (open_segment a b) = {}"
     apply (simp add: segment_convex_hull open_segment_def)
     apply (metis Diff_subset interior_mono segment_convex_hull subset_empty interior_closed_segment_ge2)
     done
 next
   assume le2: "DIM('a) < 2"
   show "interior (open_segment a b) = open_segment a b"
   proof (cases "a = b")
     case True then show ?thesis by auto
   next
     case False
     with le2 have "affine hull (open_segment a b) = UNIV"
       apply simp
       apply (rule affine_independent_span_gt)
       apply (simp_all add: affine_dependent_def insert_Diff_if)
       done
     then show "interior (open_segment a b) = open_segment a b"
       using rel_interior_interior rel_interior_open_segment by blast
   qed
 qed
 
 lemma interior_closed_segment:
   fixes a :: "'a::euclidean_space"
   shows "interior(closed_segment a b) =
                  (if 2 \<le> DIM('a) then {} else open_segment a b)"
 proof (cases "a = b")
   case True then show ?thesis by simp
 next
   case False
   then have "closure (open_segment a b) = closed_segment a b"
     by simp
   then show ?thesis
     by (metis (no_types) convex_interior_closure convex_open_segment interior_open_segment)
 qed
 
 lemmas interior_segment = interior_closed_segment interior_open_segment
 
 lemma closed_segment_eq [simp]:
   fixes a :: "'a::euclidean_space"
   shows "closed_segment a b = closed_segment c d \<longleftrightarrow> {a,b} = {c,d}"
 proof
   assume abcd: "closed_segment a b = closed_segment c d"
   show "{a,b} = {c,d}"
   proof (cases "a=b \<or> c=d")
     case True with abcd show ?thesis by force
   next
     case False
     then have neq: "a \<noteq> b \<and> c \<noteq> d" by force
     have *: "closed_segment c d - {a, b} = rel_interior (closed_segment c d)"
       using neq abcd by (metis (no_types) open_segment_def rel_interior_closed_segment)
     have "b \<in> {c, d}"
     proof -
       have "insert b (closed_segment c d) = closed_segment c d"
         using abcd by blast
       then show ?thesis
         by (metis DiffD2 Diff_insert2 False * insertI1 insert_Diff_if open_segment_def rel_interior_closed_segment)
     qed
     moreover have "a \<in> {c, d}"
       by (metis Diff_iff False * abcd ends_in_segment(1) insertI1 open_segment_def rel_interior_closed_segment)
     ultimately show "{a, b} = {c, d}"
       using neq by fastforce
   qed
 next
   assume "{a,b} = {c,d}"
   then show "closed_segment a b = closed_segment c d"
     by (simp add: segment_convex_hull)
 qed
 
 lemma closed_open_segment_eq [simp]:
   fixes a :: "'a::euclidean_space"
   shows "closed_segment a b \<noteq> open_segment c d"
 by (metis DiffE closed_segment_neq_empty closure_closed_segment closure_open_segment ends_in_segment(1) insertI1 open_segment_def)
 
 lemma open_closed_segment_eq [simp]:
   fixes a :: "'a::euclidean_space"
   shows "open_segment a b \<noteq> closed_segment c d"
 using closed_open_segment_eq by blast
 
 lemma open_segment_eq [simp]:
   fixes a :: "'a::euclidean_space"
   shows "open_segment a b = open_segment c d \<longleftrightarrow> a = b \<and> c = d \<or> {a,b} = {c,d}"
         (is "?lhs = ?rhs")
 proof
   assume abcd: ?lhs
   show ?rhs
   proof (cases "a=b \<or> c=d")
     case True with abcd show ?thesis
       using finite_open_segment by fastforce
   next
     case False
     then have a2: "a \<noteq> b \<and> c \<noteq> d" by force
     with abcd show ?rhs
       unfolding open_segment_def
       by (metis (no_types) abcd closed_segment_eq closure_open_segment)
   qed
 next
   assume ?rhs
   then show ?lhs
     by (metis Diff_cancel convex_hull_singleton insert_absorb2 open_segment_def segment_convex_hull)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Similar results for closure and (relative or absolute) frontier\<close>
 
 lemma closure_convex_hull [simp]:
   fixes s :: "'a::euclidean_space set"
   shows "compact s ==> closure(convex hull s) = convex hull s"
   by (simp add: compact_imp_closed compact_convex_hull)
 
 lemma rel_frontier_convex_hull_explicit:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent s"
   shows "rel_frontier(convex hull s) =
          {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}"
 proof -
   have fs: "finite s"
     using assms by (simp add: aff_independent_finite)
   show ?thesis
     apply (simp add: rel_frontier_def finite_imp_compact rel_interior_convex_hull_explicit assms fs)
     apply (auto simp: convex_hull_finite fs)
     apply (drule_tac x=u in spec)
     apply (rule_tac x=u in exI)
     apply force
     apply (rename_tac v)
     apply (rule notE [OF assms])
     apply (simp add: affine_dependent_explicit)
     apply (rule_tac x=s in exI)
     apply (auto simp: fs)
     apply (rule_tac x = "\<lambda>x. u x - v x" in exI)
     apply (force simp: sum_subtractf scaleR_diff_left)
     done
 qed
 
 lemma frontier_convex_hull_explicit:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent s"
   shows "frontier(convex hull s) =
          {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>
              sum u s = 1 \<and> sum (\<lambda>x. u x *\<^sub>R x) s = y}"
 proof -
   have fs: "finite s"
     using assms by (simp add: aff_independent_finite)
   show ?thesis
   proof (cases "DIM ('a) < card s")
     case True
     with assms fs show ?thesis
       by (simp add: rel_frontier_def frontier_def rel_frontier_convex_hull_explicit [symmetric]
                     interior_convex_hull_explicit_minimal rel_interior_convex_hull_explicit)
   next
     case False
     then have "card s \<le> DIM ('a)"
       by linarith
     then show ?thesis
       using assms fs
       apply (simp add: frontier_def interior_convex_hull_explicit finite_imp_compact)
       apply (simp add: convex_hull_finite)
       done
   qed
 qed
 
 lemma rel_frontier_convex_hull_cases:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent s"
   shows "rel_frontier(convex hull s) = \<Union>{convex hull (s - {x}) |x. x \<in> s}"
 proof -
   have fs: "finite s"
     using assms by (simp add: aff_independent_finite)
   { fix u a
   have "\<forall>x\<in>s. 0 \<le> u x \<Longrightarrow> a \<in> s \<Longrightarrow> u a = 0 \<Longrightarrow> sum u s = 1 \<Longrightarrow>
             \<exists>x v. x \<in> s \<and>
                   (\<forall>x\<in>s - {x}. 0 \<le> v x) \<and>
                       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)"
     apply (rule_tac x=a in exI)
     apply (rule_tac x=u in exI)
     apply (simp add: Groups_Big.sum_diff1 fs)
     done }
   moreover
   { fix a u
     have "a \<in> s \<Longrightarrow> \<forall>x\<in>s - {a}. 0 \<le> u x \<Longrightarrow> sum u (s - {a}) = 1 \<Longrightarrow>
             \<exists>v. (\<forall>x\<in>s. 0 \<le> v x) \<and>
                  (\<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)"
     apply (rule_tac x="\<lambda>x. if x = a then 0 else u x" in exI)
     apply (auto simp: sum.If_cases Diff_eq if_smult fs)
     done }
   ultimately show ?thesis
     using assms
     apply (simp add: rel_frontier_convex_hull_explicit)
     apply (simp add: convex_hull_finite fs Union_SetCompr_eq, auto)
     done
 qed
 
 lemma frontier_convex_hull_eq_rel_frontier:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent s"
   shows "frontier(convex hull s) =
            (if card s \<le> DIM ('a) then convex hull s else rel_frontier(convex hull s))"
   using assms
   unfolding rel_frontier_def frontier_def
   by (simp add: affine_independent_span_gt rel_interior_interior
                 finite_imp_compact empty_interior_convex_hull aff_independent_finite)
 
 lemma frontier_convex_hull_cases:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent s"
   shows "frontier(convex hull s) =
            (if card s \<le> DIM ('a) then convex hull s else \<Union>{convex hull (s - {x}) |x. x \<in> s})"
 by (simp add: assms frontier_convex_hull_eq_rel_frontier rel_frontier_convex_hull_cases)
 
 lemma in_frontier_convex_hull:
   fixes s :: "'a::euclidean_space set"
   assumes "finite s" "card s \<le> Suc (DIM ('a))" "x \<in> s"
   shows   "x \<in> frontier(convex hull s)"
 proof (cases "affine_dependent s")
   case True
   with assms show ?thesis
     apply (auto simp: affine_dependent_def frontier_def finite_imp_compact hull_inc)
     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)
 next
   case False
   { assume "card s = Suc (card Basis)"
     then have cs: "Suc 0 < card s"
       by (simp add: DIM_positive)
     with subset_singletonD have "\<exists>y \<in> s. y \<noteq> x"
       by (cases "s \<le> {x}") fastforce+
   } note [dest!] = this
   show ?thesis using assms
     unfolding frontier_convex_hull_cases [OF False] Union_SetCompr_eq
     by (auto simp: le_Suc_eq hull_inc)
 qed
 
 lemma not_in_interior_convex_hull:
   fixes s :: "'a::euclidean_space set"
   assumes "finite s" "card s \<le> Suc (DIM ('a))" "x \<in> s"
   shows   "x \<notin> interior(convex hull s)"
 using in_frontier_convex_hull [OF assms]
 by (metis Diff_iff frontier_def)
 
 lemma interior_convex_hull_eq_empty:
   fixes s :: "'a::euclidean_space set"
   assumes "card s = Suc (DIM ('a))"
   shows   "interior(convex hull s) = {} \<longleftrightarrow> affine_dependent s"
 proof -
   { fix a b
     assume ab: "a \<in> interior (convex hull s)" "b \<in> s" "b \<in> affine hull (s - {b})"
     then have "interior(affine hull s) = {}" using assms
       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)
     then have False using ab
       by (metis convex_hull_subset_affine_hull equals0D interior_mono subset_eq)
   } then
   show ?thesis
     using assms
     apply auto
     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)
     apply (auto simp: affine_dependent_def)
     done
 qed
 
 
 subsection \<open>Coplanarity, and collinearity in terms of affine hull\<close>
 
 definition\<^marker>\<open>tag important\<close> coplanar  where
    "coplanar s \<equiv> \<exists>u v w. s \<subseteq> affine hull {u,v,w}"
 
 lemma collinear_affine_hull:
   "collinear s \<longleftrightarrow> (\<exists>u v. s \<subseteq> affine hull {u,v})"
 proof (cases "s={}")
   case True then show ?thesis
     by simp
 next
   case False
   then obtain x where x: "x \<in> s" by auto
   { fix u
     assume *: "\<And>x y. \<lbrakk>x\<in>s; y\<in>s\<rbrakk> \<Longrightarrow> \<exists>c. x - y = c *\<^sub>R u"
     have "\<exists>u v. s \<subseteq> {a *\<^sub>R u + b *\<^sub>R v |a b. a + b = 1}"
       apply (rule_tac x=x in exI)
       apply (rule_tac x="x+u" in exI, clarify)
       apply (erule exE [OF * [OF x]])
       apply (rename_tac c)
       apply (rule_tac x="1+c" in exI)
       apply (rule_tac x="-c" in exI)
       apply (simp add: algebra_simps)
       done
   } moreover
   { fix u v x y
     assume *: "s \<subseteq> {a *\<^sub>R u + b *\<^sub>R v |a b. a + b = 1}"
     have "x\<in>s \<Longrightarrow> y\<in>s \<Longrightarrow> \<exists>c. x - y = c *\<^sub>R (v-u)"
       apply (drule subsetD [OF *])+
       apply simp
       apply clarify
       apply (rename_tac r1 r2)
       apply (rule_tac x="r1-r2" in exI)
       apply (simp add: algebra_simps)
       apply (metis scaleR_left.add)
       done
   } ultimately
   show ?thesis
   unfolding collinear_def affine_hull_2
     by blast
 qed
 
 lemma collinear_closed_segment [simp]: "collinear (closed_segment a b)"
 by (metis affine_hull_convex_hull collinear_affine_hull hull_subset segment_convex_hull)
 
 lemma collinear_open_segment [simp]: "collinear (open_segment a b)"
   unfolding open_segment_def
   by (metis convex_hull_subset_affine_hull segment_convex_hull dual_order.trans
     convex_hull_subset_affine_hull Diff_subset collinear_affine_hull)
 
 lemma collinear_between_cases:
   fixes c :: "'a::euclidean_space"
   shows "collinear {a,b,c} \<longleftrightarrow> between (b,c) a \<or> between (c,a) b \<or> between (a,b) c"
          (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then obtain u v where uv: "\<And>x. x \<in> {a, b, c} \<Longrightarrow> \<exists>c. x = u + c *\<^sub>R v"
     by (auto simp: collinear_alt)
   show ?rhs
     using uv [of a] uv [of b] uv [of c] by (auto simp: between_1)
 next
   assume ?rhs
   then show ?lhs
     unfolding between_mem_convex_hull
     by (metis (no_types, hide_lams) collinear_closed_segment collinear_subset hull_redundant hull_subset insert_commute segment_convex_hull)
 qed
 
 
 lemma subset_continuous_image_segment_1:
   fixes f :: "'a::euclidean_space \<Rightarrow> real"
   assumes "continuous_on (closed_segment a b) f"
   shows "closed_segment (f a) (f b) \<subseteq> image f (closed_segment a b)"
 by (metis connected_segment convex_contains_segment ends_in_segment imageI
            is_interval_connected_1 is_interval_convex connected_continuous_image [OF assms])
 
 lemma continuous_injective_image_segment_1:
   fixes f :: "'a::euclidean_space \<Rightarrow> real"
   assumes contf: "continuous_on (closed_segment a b) f"
       and injf: "inj_on f (closed_segment a b)"
   shows "f ` (closed_segment a b) = closed_segment (f a) (f b)"
 proof
   show "closed_segment (f a) (f b) \<subseteq> f ` closed_segment a b"
     by (metis subset_continuous_image_segment_1 contf)
   show "f ` closed_segment a b \<subseteq> closed_segment (f a) (f b)"
   proof (cases "a = b")
     case True
     then show ?thesis by auto
   next
     case False
     then have fnot: "f a \<noteq> f b"
       using inj_onD injf by fastforce
     moreover
     have "f a \<notin> open_segment (f c) (f b)" if c: "c \<in> closed_segment a b" for c
     proof (clarsimp simp add: open_segment_def)
       assume fa: "f a \<in> closed_segment (f c) (f b)"
       moreover have "closed_segment (f c) (f b) \<subseteq> f ` closed_segment c b"
         by (meson closed_segment_subset contf continuous_on_subset convex_closed_segment ends_in_segment(2) subset_continuous_image_segment_1 that)
       ultimately have "f a \<in> f ` closed_segment c b"
         by blast
       then have a: "a \<in> closed_segment c b"
         by (meson ends_in_segment inj_on_image_mem_iff_alt injf subset_closed_segment that)
       have cb: "closed_segment c b \<subseteq> closed_segment a b"
         by (simp add: closed_segment_subset that)
       show "f a = f c"
       proof (rule between_antisym)
         show "between (f c, f b) (f a)"
           by (simp add: between_mem_segment fa)
         show "between (f a, f b) (f c)"
           by (metis a cb between_antisym between_mem_segment between_triv1 subset_iff)
       qed
     qed
     moreover
     have "f b \<notin> open_segment (f a) (f c)" if c: "c \<in> closed_segment a b" for c
     proof (clarsimp simp add: open_segment_def fnot eq_commute)
       assume fb: "f b \<in> closed_segment (f a) (f c)"
       moreover have "closed_segment (f a) (f c) \<subseteq> f ` closed_segment a c"
         by (meson contf continuous_on_subset ends_in_segment(1) subset_closed_segment subset_continuous_image_segment_1 that)
       ultimately have "f b \<in> f ` closed_segment a c"
         by blast
       then have b: "b \<in> closed_segment a c"
         by (meson ends_in_segment inj_on_image_mem_iff_alt injf subset_closed_segment that)
       have ca: "closed_segment a c \<subseteq> closed_segment a b"
         by (simp add: closed_segment_subset that)
       show "f b = f c"
       proof (rule between_antisym)
         show "between (f c, f a) (f b)"
           by (simp add: between_commute between_mem_segment fb)
         show "between (f b, f a) (f c)"
           by (metis b between_antisym between_commute between_mem_segment between_triv2 that)
       qed
     qed
     ultimately show ?thesis
       by (force simp: closed_segment_eq_real_ivl open_segment_eq_real_ivl split: if_split_asm)
   qed
 qed
 
 lemma continuous_injective_image_open_segment_1:
   fixes f :: "'a::euclidean_space \<Rightarrow> real"
   assumes contf: "continuous_on (closed_segment a b) f"
       and injf: "inj_on f (closed_segment a b)"
     shows "f ` (open_segment a b) = open_segment (f a) (f b)"
 proof -
   have "f ` (open_segment a b) = f ` (closed_segment a b) - {f a, f b}"
     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)
   also have "... = open_segment (f a) (f b)"
     using continuous_injective_image_segment_1 [OF assms]
     by (simp add: open_segment_def inj_on_image_set_diff [OF injf])
   finally show ?thesis .
 qed
 
 lemma collinear_imp_coplanar:
   "collinear s ==> coplanar s"
 by (metis collinear_affine_hull coplanar_def insert_absorb2)
 
 lemma collinear_small:
   assumes "finite s" "card s \<le> 2"
     shows "collinear s"
 proof -
   have "card s = 0 \<or> card s = 1 \<or> card s = 2"
     using assms by linarith
   then show ?thesis using assms
     using card_eq_SucD
     by auto (metis collinear_2 numeral_2_eq_2)
 qed
 
 lemma coplanar_small:
   assumes "finite s" "card s \<le> 3"
     shows "coplanar s"
 proof -
   have "card s \<le> 2 \<or> card s = Suc (Suc (Suc 0))"
     using assms by linarith
   then show ?thesis using assms
     apply safe
     apply (simp add: collinear_small collinear_imp_coplanar)
     apply (safe dest!: card_eq_SucD)
     apply (auto simp: coplanar_def)
     apply (metis hull_subset insert_subset)
     done
 qed
 
 lemma coplanar_empty: "coplanar {}"
   by (simp add: coplanar_small)
 
 lemma coplanar_sing: "coplanar {a}"
   by (simp add: coplanar_small)
 
 lemma coplanar_2: "coplanar {a,b}"
   by (auto simp: card_insert_if coplanar_small)
 
 lemma coplanar_3: "coplanar {a,b,c}"
   by (auto simp: card_insert_if coplanar_small)
 
 lemma collinear_affine_hull_collinear: "collinear(affine hull s) \<longleftrightarrow> collinear s"
   unfolding collinear_affine_hull
   by (metis affine_affine_hull subset_hull hull_hull hull_mono)
 
 lemma coplanar_affine_hull_coplanar: "coplanar(affine hull s) \<longleftrightarrow> coplanar s"
   unfolding coplanar_def
   by (metis affine_affine_hull subset_hull hull_hull hull_mono)
 
 lemma coplanar_linear_image:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes "coplanar s" "linear f" shows "coplanar(f ` s)"
 proof -
   { fix u v w
     assume "s \<subseteq> affine hull {u, v, w}"
     then have "f ` s \<subseteq> f ` (affine hull {u, v, w})"
       by (simp add: image_mono)
     then have "f ` s \<subseteq> affine hull (f ` {u, v, w})"
       by (metis assms(2) linear_conv_bounded_linear affine_hull_linear_image)
   } then
   show ?thesis
     by auto (meson assms(1) coplanar_def)
 qed
 
 lemma coplanar_translation_imp: "coplanar s \<Longrightarrow> coplanar ((\<lambda>x. a + x) ` s)"
   unfolding coplanar_def
   apply clarify
   apply (rule_tac x="u+a" in exI)
   apply (rule_tac x="v+a" in exI)
   apply (rule_tac x="w+a" in exI)
   using affine_hull_translation [of a "{u,v,w}" for u v w]
   apply (force simp: add.commute)
   done
 
 lemma coplanar_translation_eq: "coplanar((\<lambda>x. a + x) ` s) \<longleftrightarrow> coplanar s"
     by (metis (no_types) coplanar_translation_imp translation_galois)
 
 lemma coplanar_linear_image_eq:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "linear f" "inj f" shows "coplanar(f ` s) = coplanar s"
 proof
   assume "coplanar s"
   then show "coplanar (f ` s)"
     unfolding coplanar_def
     using affine_hull_linear_image [of f "{u,v,w}" for u v w]  assms
     by (meson coplanar_def coplanar_linear_image)
 next
   obtain g where g: "linear g" "g \<circ> f = id"
     using linear_injective_left_inverse [OF assms]
     by blast
   assume "coplanar (f ` s)"
   then obtain u v w where "f ` s \<subseteq> affine hull {u, v, w}"
     by (auto simp: coplanar_def)
   then have "g ` f ` s \<subseteq> g ` (affine hull {u, v, w})"
     by blast
   then have "s \<subseteq> g ` (affine hull {u, v, w})"
     using g by (simp add: Fun.image_comp)
   then show "coplanar s"
     unfolding coplanar_def
     using affine_hull_linear_image [of g "{u,v,w}" for u v w]  \<open>linear g\<close> linear_conv_bounded_linear
     by fastforce
 qed
 (*The HOL Light proof is simply
     MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE COPLANAR_LINEAR_IMAGE));;
 *)
 
 lemma coplanar_subset: "\<lbrakk>coplanar t; s \<subseteq> t\<rbrakk> \<Longrightarrow> coplanar s"
   by (meson coplanar_def order_trans)
 
 lemma affine_hull_3_imp_collinear: "c \<in> affine hull {a,b} \<Longrightarrow> collinear {a,b,c}"
   by (metis collinear_2 collinear_affine_hull_collinear hull_redundant insert_commute)
 
 lemma collinear_3_imp_in_affine_hull: "\<lbrakk>collinear {a,b,c}; a \<noteq> b\<rbrakk> \<Longrightarrow> c \<in> affine hull {a,b}"
   unfolding collinear_def
   apply clarify
   apply (frule_tac x=b in bspec, blast, drule_tac x=a in bspec, blast, erule exE)
   apply (drule_tac x=c in bspec, blast, drule_tac x=a in bspec, blast, erule exE)
   apply (rename_tac y x)
   apply (simp add: affine_hull_2)
   apply (rule_tac x="1 - x/y" in exI)
   apply (simp add: algebra_simps)
   done
 
 lemma collinear_3_affine_hull:
   assumes "a \<noteq> b"
     shows "collinear {a,b,c} \<longleftrightarrow> c \<in> affine hull {a,b}"
 using affine_hull_3_imp_collinear assms collinear_3_imp_in_affine_hull by blast
 
 lemma collinear_3_eq_affine_dependent:
   "collinear{a,b,c} \<longleftrightarrow> a = b \<or> a = c \<or> b = c \<or> affine_dependent {a,b,c}"
 apply (case_tac "a=b", simp)
 apply (case_tac "a=c")
 apply (simp add: insert_commute)
 apply (case_tac "b=c")
 apply (simp add: insert_commute)
 apply (auto simp: affine_dependent_def collinear_3_affine_hull insert_Diff_if)
 apply (metis collinear_3_affine_hull insert_commute)+
 done
 
 lemma affine_dependent_imp_collinear_3:
   "affine_dependent {a,b,c} \<Longrightarrow> collinear{a,b,c}"
 by (simp add: collinear_3_eq_affine_dependent)
 
 lemma collinear_3: "NO_MATCH 0 x \<Longrightarrow> collinear {x,y,z} \<longleftrightarrow> collinear {0, x-y, z-y}"
   by (auto simp add: collinear_def)
 
 lemma collinear_3_expand:
    "collinear{a,b,c} \<longleftrightarrow> a = c \<or> (\<exists>u. b = u *\<^sub>R a + (1 - u) *\<^sub>R c)"
 proof -
   have "collinear{a,b,c} = collinear{a,c,b}"
     by (simp add: insert_commute)
   also have "... = collinear {0, a - c, b - c}"
     by (simp add: collinear_3)
   also have "... \<longleftrightarrow> (a = c \<or> b = c \<or> (\<exists>ca. b - c = ca *\<^sub>R (a - c)))"
     by (simp add: collinear_lemma)
   also have "... \<longleftrightarrow> a = c \<or> (\<exists>u. b = u *\<^sub>R a + (1 - u) *\<^sub>R c)"
     by (cases "a = c \<or> b = c") (auto simp: algebra_simps)
   finally show ?thesis .
 qed
 
 lemma collinear_aff_dim: "collinear S \<longleftrightarrow> aff_dim S \<le> 1"
 proof
   assume "collinear S"
   then obtain u and v :: "'a" where "aff_dim S \<le> aff_dim {u,v}"
     by (metis \<open>collinear S\<close> aff_dim_affine_hull aff_dim_subset collinear_affine_hull)
   then show "aff_dim S \<le> 1"
     using order_trans by fastforce
 next
   assume "aff_dim S \<le> 1"
   then have le1: "aff_dim (affine hull S) \<le> 1"
     by simp
   obtain B where "B \<subseteq> S" and B: "\<not> affine_dependent B" "affine hull S = affine hull B"
     using affine_basis_exists [of S] by auto
   then have "finite B" "card B \<le> 2"
     using B le1 by (auto simp: affine_independent_iff_card)
   then have "collinear B"
     by (rule collinear_small)
   then show "collinear S"
     by (metis \<open>affine hull S = affine hull B\<close> collinear_affine_hull_collinear)
 qed
 
 lemma collinear_midpoint: "collinear{a,midpoint a b,b}"
   apply (auto simp: collinear_3 collinear_lemma)
   apply (drule_tac x="-1" in spec)
   apply (simp add: algebra_simps)
   done
 
 lemma midpoint_collinear:
   fixes a b c :: "'a::real_normed_vector"
   assumes "a \<noteq> c"
     shows "b = midpoint a c \<longleftrightarrow> collinear{a,b,c} \<and> dist a b = dist b c"
 proof -
   have *: "a - (u *\<^sub>R a + (1 - u) *\<^sub>R c) = (1 - u) *\<^sub>R (a - c)"
           "u *\<^sub>R a + (1 - u) *\<^sub>R c - c = u *\<^sub>R (a - c)"
           "\<bar>1 - u\<bar> = \<bar>u\<bar> \<longleftrightarrow> u = 1/2" for u::real
     by (auto simp: algebra_simps)
   have "b = midpoint a c \<Longrightarrow> collinear{a,b,c} "
     using collinear_midpoint by blast
   moreover have "collinear{a,b,c} \<Longrightarrow> b = midpoint a c \<longleftrightarrow> dist a b = dist b c"
     apply (auto simp: collinear_3_expand assms dist_midpoint)
     apply (simp add: dist_norm * assms midpoint_def del: divide_const_simps)
     apply (simp add: algebra_simps)
     done
   ultimately show ?thesis by blast
 qed
 
 lemma between_imp_collinear:
   fixes x :: "'a :: euclidean_space"
   assumes "between (a,b) x"
     shows "collinear {a,x,b}"
 proof (cases "x = a \<or> x = b \<or> a = b")
   case True with assms show ?thesis
     by (auto simp: dist_commute)
 next
   case False with assms show ?thesis
     apply (auto simp: collinear_3 collinear_lemma between_norm)
     apply (drule_tac x="-(norm(b - x) / norm(x - a))" in spec)
     apply (simp add: vector_add_divide_simps eq_vector_fraction_iff real_vector.scale_minus_right [symmetric])
     done
 qed
 
 lemma midpoint_between:
   fixes a b :: "'a::euclidean_space"
   shows "b = midpoint a c \<longleftrightarrow> between (a,c) b \<and> dist a b = dist b c"
 proof (cases "a = c")
   case True then show ?thesis
     by (auto simp: dist_commute)
 next
   case False
   show ?thesis
     apply (rule iffI)
     apply (simp add: between_midpoint(1) dist_midpoint)
     using False between_imp_collinear midpoint_collinear by blast
 qed
 
 lemma collinear_triples:
   assumes "a \<noteq> b"
     shows "collinear(insert a (insert b S)) \<longleftrightarrow> (\<forall>x \<in> S. collinear{a,b,x})"
           (is "?lhs = ?rhs")
 proof safe
   fix x
   assume ?lhs and "x \<in> S"
   then show "collinear {a, b, x}"
     using collinear_subset by force
 next
   assume ?rhs
   then have "\<forall>x \<in> S. collinear{a,x,b}"
     by (simp add: insert_commute)
   then have *: "\<exists>u. x = u *\<^sub>R a + (1 - u) *\<^sub>R b" if "x \<in> (insert a (insert b S))" for x
     using that assms collinear_3_expand by fastforce+
   show ?lhs
     unfolding collinear_def
     apply (rule_tac x="b-a" in exI)
     apply (clarify dest!: *)
     by (metis (no_types, hide_lams) add.commute diff_add_cancel diff_diff_eq2 real_vector.scale_right_diff_distrib scaleR_left.diff)
 qed
 
 lemma collinear_4_3:
   assumes "a \<noteq> b"
     shows "collinear {a,b,c,d} \<longleftrightarrow> collinear{a,b,c} \<and> collinear{a,b,d}"
   using collinear_triples [OF assms, of "{c,d}"] by (force simp:)
 
 lemma collinear_3_trans:
   assumes "collinear{a,b,c}" "collinear{b,c,d}" "b \<noteq> c"
     shows "collinear{a,b,d}"
 proof -
   have "collinear{b,c,a,d}"
     by (metis (full_types) assms collinear_4_3 insert_commute)
   then show ?thesis
     by (simp add: collinear_subset)
 qed
 
 lemma affine_hull_eq_empty [simp]: "affine hull S = {} \<longleftrightarrow> S = {}"
   using affine_hull_nonempty by blast
 
 lemma affine_hull_2_alt:
   fixes a b :: "'a::real_vector"
   shows "affine hull {a,b} = range (\<lambda>u. a + u *\<^sub>R (b - a))"
 apply (simp add: affine_hull_2, safe)
 apply (rule_tac x=v in image_eqI)
 apply (simp add: algebra_simps)
 apply (metis scaleR_add_left scaleR_one, simp)
 apply (rule_tac x="1-u" in exI)
 apply (simp add: algebra_simps)
 done
 
 lemma interior_convex_hull_3_minimal:
   fixes a :: "'a::euclidean_space"
   shows "\<lbrakk>\<not> collinear{a,b,c}; DIM('a) = 2\<rbrakk>
          \<Longrightarrow> interior(convex hull {a,b,c}) =
                 {v. \<exists>x y z. 0 < x \<and> 0 < y \<and> 0 < z \<and> x + y + z = 1 \<and>
                             x *\<^sub>R a + y *\<^sub>R b + z *\<^sub>R c = v}"
 apply (simp add: collinear_3_eq_affine_dependent interior_convex_hull_explicit_minimal, safe)
 apply (rule_tac x="u a" in exI, simp)
 apply (rule_tac x="u b" in exI, simp)
 apply (rule_tac x="u c" in exI, simp)
 apply (rename_tac uu x y z)
 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)
 apply simp
 done
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Basic lemmas about hyperplanes and halfspaces\<close>
 
 lemma halfspace_Int_eq:
      "{x. a \<bullet> x \<le> b} \<inter> {x. b \<le> a \<bullet> x} = {x. a \<bullet> x = b}"
      "{x. b \<le> a \<bullet> x} \<inter> {x. a \<bullet> x \<le> b} = {x. a \<bullet> x = b}"
   by auto
 
 lemma hyperplane_eq_Ex:
   assumes "a \<noteq> 0" obtains x where "a \<bullet> x = b"
   by (rule_tac x = "(b / (a \<bullet> a)) *\<^sub>R a" in that) (simp add: assms)
 
 lemma hyperplane_eq_empty:
      "{x. a \<bullet> x = b} = {} \<longleftrightarrow> a = 0 \<and> b \<noteq> 0"
   using hyperplane_eq_Ex apply auto[1]
   using inner_zero_right by blast
 
 lemma hyperplane_eq_UNIV:
    "{x. a \<bullet> x = b} = UNIV \<longleftrightarrow> a = 0 \<and> b = 0"
 proof -
   have "UNIV \<subseteq> {x. a \<bullet> x = b} \<Longrightarrow> a = 0 \<and> b = 0"
     apply (drule_tac c = "((b+1) / (a \<bullet> a)) *\<^sub>R a" in subsetD)
     apply simp_all
     by (metis add_cancel_right_right zero_neq_one)
   then show ?thesis by force
 qed
 
 lemma halfspace_eq_empty_lt:
    "{x. a \<bullet> x < b} = {} \<longleftrightarrow> a = 0 \<and> b \<le> 0"
 proof -
   have "{x. a \<bullet> x < b} \<subseteq> {} \<Longrightarrow> a = 0 \<and> b \<le> 0"
     apply (rule ccontr)
     apply (drule_tac c = "((b-1) / (a \<bullet> a)) *\<^sub>R a" in subsetD)
     apply force+
     done
   then show ?thesis by force
 qed
 
 lemma halfspace_eq_empty_gt:
    "{x. a \<bullet> x > b} = {} \<longleftrightarrow> a = 0 \<and> b \<ge> 0"
 using halfspace_eq_empty_lt [of "-a" "-b"]
 by simp
 
 lemma halfspace_eq_empty_le:
    "{x. a \<bullet> x \<le> b} = {} \<longleftrightarrow> a = 0 \<and> b < 0"
 proof -
   have "{x. a \<bullet> x \<le> b} \<subseteq> {} \<Longrightarrow> a = 0 \<and> b < 0"
     apply (rule ccontr)
     apply (drule_tac c = "((b-1) / (a \<bullet> a)) *\<^sub>R a" in subsetD)
     apply force+
     done
   then show ?thesis by force
 qed
 
 lemma halfspace_eq_empty_ge:
    "{x. a \<bullet> x \<ge> b} = {} \<longleftrightarrow> a = 0 \<and> b > 0"
 using halfspace_eq_empty_le [of "-a" "-b"]
 by simp
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Use set distance for an easy proof of separation properties\<close>
 
 proposition\<^marker>\<open>tag unimportant\<close> separation_closures:
   fixes S :: "'a::euclidean_space set"
   assumes "S \<inter> closure T = {}" "T \<inter> closure S = {}"
   obtains U V where "U \<inter> V = {}" "open U" "open V" "S \<subseteq> U" "T \<subseteq> V"
 proof (cases "S = {} \<or> T = {}")
   case True with that show ?thesis by auto
 next
   case False
   define f where "f \<equiv> \<lambda>x. setdist {x} T - setdist {x} S"
   have contf: "continuous_on UNIV f"
     unfolding f_def by (intro continuous_intros continuous_on_setdist)
   show ?thesis
   proof (rule_tac U = "{x. f x > 0}" and V = "{x. f x < 0}" in that)
     show "{x. 0 < f x} \<inter> {x. f x < 0} = {}"
       by auto
     show "open {x. 0 < f x}"
       by (simp add: open_Collect_less contf continuous_on_const)
     show "open {x. f x < 0}"
       by (simp add: open_Collect_less contf continuous_on_const)
     show "S \<subseteq> {x. 0 < f x}"
       apply (clarsimp simp add: f_def setdist_sing_in_set)
       using assms
       by (metis False IntI empty_iff le_less setdist_eq_0_sing_2 setdist_pos_le setdist_sym)
     show "T \<subseteq> {x. f x < 0}"
       apply (clarsimp simp add: f_def setdist_sing_in_set)
       using assms
       by (metis False IntI empty_iff le_less setdist_eq_0_sing_2 setdist_pos_le setdist_sym)
   qed
 qed
 
 lemma separation_normal:
   fixes S :: "'a::euclidean_space set"
   assumes "closed S" "closed T" "S \<inter> T = {}"
   obtains U V where "open U" "open V" "S \<subseteq> U" "T \<subseteq> V" "U \<inter> V = {}"
 using separation_closures [of S T]
 by (metis assms closure_closed disjnt_def inf_commute)
 
 lemma separation_normal_local:
   fixes S :: "'a::euclidean_space set"
   assumes US: "closedin (top_of_set U) S"
       and UT: "closedin (top_of_set U) T"
       and "S \<inter> T = {}"
   obtains S' T' where "openin (top_of_set U) S'"
                       "openin (top_of_set U) T'"
                       "S \<subseteq> S'"  "T \<subseteq> T'"  "S' \<inter> T' = {}"
 proof (cases "S = {} \<or> T = {}")
   case True with that show ?thesis
     using UT US by (blast dest: closedin_subset)
 next
   case False
   define f where "f \<equiv> \<lambda>x. setdist {x} T - setdist {x} S"
   have contf: "continuous_on U f"
     unfolding f_def by (intro continuous_intros)
   show ?thesis
   proof (rule_tac S' = "(U \<inter> f -` {0<..})" and T' = "(U \<inter> f -` {..<0})" in that)
     show "(U \<inter> f -` {0<..}) \<inter> (U \<inter> f -` {..<0}) = {}"
       by auto
     show "openin (top_of_set U) (U \<inter> f -` {0<..})"
       by (rule continuous_openin_preimage [where T=UNIV]) (simp_all add: contf)
   next
     show "openin (top_of_set U) (U \<inter> f -` {..<0})"
       by (rule continuous_openin_preimage [where T=UNIV]) (simp_all add: contf)
   next
     have "S \<subseteq> U" "T \<subseteq> U"
       using closedin_imp_subset assms by blast+
     then show "S \<subseteq> U \<inter> f -` {0<..}" "T \<subseteq> U \<inter> f -` {..<0}"
       using assms False by (force simp add: f_def setdist_sing_in_set intro!: setdist_gt_0_closedin)+
   qed
 qed
 
 lemma separation_normal_compact:
   fixes S :: "'a::euclidean_space set"
   assumes "compact S" "closed T" "S \<inter> T = {}"
   obtains U V where "open U" "compact(closure U)" "open V" "S \<subseteq> U" "T \<subseteq> V" "U \<inter> V = {}"
 proof -
   have "closed S" "bounded S"
     using assms by (auto simp: compact_eq_bounded_closed)
   then obtain r where "r>0" and r: "S \<subseteq> ball 0 r"
     by (auto dest!: bounded_subset_ballD)
   have **: "closed (T \<union> - ball 0 r)" "S \<inter> (T \<union> - ball 0 r) = {}"
     using assms r by blast+
   then show ?thesis
     apply (rule separation_normal [OF \<open>closed S\<close>])
     apply (rule_tac U=U and V=V in that)
     by auto (meson bounded_ball bounded_subset compl_le_swap2 disjoint_eq_subset_Compl)
 qed
 
 subsection\<open>Connectedness of the intersection of a chain\<close>
 
 proposition connected_chain:
   fixes \<F> :: "'a :: euclidean_space set set"
   assumes cc: "\<And>S. S \<in> \<F> \<Longrightarrow> compact S \<and> connected S"
       and linear: "\<And>S T. S \<in> \<F> \<and> T \<in> \<F> \<Longrightarrow> S \<subseteq> T \<or> T \<subseteq> S"
   shows "connected(\<Inter>\<F>)"
 proof (cases "\<F> = {}")
   case True then show ?thesis
     by auto
 next
   case False
   then have cf: "compact(\<Inter>\<F>)"
     by (simp add: cc compact_Inter)
   have False if AB: "closed A" "closed B" "A \<inter> B = {}"
                 and ABeq: "A \<union> B = \<Inter>\<F>" and "A \<noteq> {}" "B \<noteq> {}" for A B
   proof -
     obtain U V where "open U" "open V" "A \<subseteq> U" "B \<subseteq> V" "U \<inter> V = {}"
       using separation_normal [OF AB] by metis
     obtain K where "K \<in> \<F>" "compact K"
       using cc False by blast
     then obtain N where "open N" and "K \<subseteq> N"
       by blast
     let ?\<C> = "insert (U \<union> V) ((\<lambda>S. N - S) ` \<F>)"
     obtain \<D> where "\<D> \<subseteq> ?\<C>" "finite \<D>" "K \<subseteq> \<Union>\<D>"
     proof (rule compactE [OF \<open>compact K\<close>])
       show "K \<subseteq> \<Union>(insert (U \<union> V) ((-) N ` \<F>))"
         using \<open>K \<subseteq> N\<close> ABeq \<open>A \<subseteq> U\<close> \<open>B \<subseteq> V\<close> by auto
       show "\<And>B. B \<in> insert (U \<union> V) ((-) N ` \<F>) \<Longrightarrow> open B"
         by (auto simp:  \<open>open U\<close> \<open>open V\<close> open_Un \<open>open N\<close> cc compact_imp_closed open_Diff)
     qed
     then have "finite(\<D> - {U \<union> V})"
       by blast
     moreover have "\<D> - {U \<union> V} \<subseteq> (\<lambda>S. N - S) ` \<F>"
       using \<open>\<D> \<subseteq> ?\<C>\<close> by blast
     ultimately obtain \<G> where "\<G> \<subseteq> \<F>" "finite \<G>" and Deq: "\<D> - {U \<union> V} = (\<lambda>S. N-S) ` \<G>"
       using finite_subset_image by metis
     obtain J where "J \<in> \<F>" and J: "(\<Union>S\<in>\<G>. N - S) \<subseteq> N - J"
     proof (cases "\<G> = {}")
       case True
       with \<open>\<F> \<noteq> {}\<close> that show ?thesis
         by auto
     next
       case False
       have "\<And>S T. \<lbrakk>S \<in> \<G>; T \<in> \<G>\<rbrakk> \<Longrightarrow> S \<subseteq> T \<or> T \<subseteq> S"
         by (meson \<open>\<G> \<subseteq> \<F>\<close> in_mono local.linear)
       with \<open>finite \<G>\<close> \<open>\<G> \<noteq> {}\<close>
       have "\<exists>J \<in> \<G>. (\<Union>S\<in>\<G>. N - S) \<subseteq> N - J"
       proof induction
         case (insert X \<H>)
         show ?case
         proof (cases "\<H> = {}")
           case True then show ?thesis by auto
         next
           case False
           then have "\<And>S T. \<lbrakk>S \<in> \<H>; T \<in> \<H>\<rbrakk> \<Longrightarrow> S \<subseteq> T \<or> T \<subseteq> S"
             by (simp add: insert.prems)
           with insert.IH False obtain J where "J \<in> \<H>" and J: "(\<Union>Y\<in>\<H>. N - Y) \<subseteq> N - J"
             by metis
           have "N - J \<subseteq> N - X \<or> N - X \<subseteq> N - J"
             by (meson Diff_mono \<open>J \<in> \<H>\<close> insert.prems(2) insert_iff order_refl)
           then show ?thesis
           proof
             assume "N - J \<subseteq> N - X" with J show ?thesis
               by auto
           next
             assume "N - X \<subseteq> N - J"
             with J have "N - X \<union> \<Union> ((-) N ` \<H>) \<subseteq> N - J"
               by auto
             with \<open>J \<in> \<H>\<close> show ?thesis
               by blast
           qed
         qed
       qed simp
       with \<open>\<G> \<subseteq> \<F>\<close> show ?thesis by (blast intro: that)
     qed
     have "K \<subseteq> \<Union>(insert (U \<union> V) (\<D> - {U \<union> V}))"
       using \<open>K \<subseteq> \<Union>\<D>\<close> by auto
     also have "... \<subseteq> (U \<union> V) \<union> (N - J)"
       by (metis (no_types, hide_lams) Deq Un_subset_iff Un_upper2 J Union_insert order_trans sup_ge1)
     finally have "J \<inter> K \<subseteq> U \<union> V"
       by blast
     moreover have "connected(J \<inter> K)"
       by (metis Int_absorb1 \<open>J \<in> \<F>\<close> \<open>K \<in> \<F>\<close> cc inf.orderE local.linear)
     moreover have "U \<inter> (J \<inter> K) \<noteq> {}"
       using ABeq \<open>J \<in> \<F>\<close> \<open>K \<in> \<F>\<close> \<open>A \<noteq> {}\<close> \<open>A \<subseteq> U\<close> by blast
     moreover have "V \<inter> (J \<inter> K) \<noteq> {}"
       using ABeq \<open>J \<in> \<F>\<close> \<open>K \<in> \<F>\<close> \<open>B \<noteq> {}\<close> \<open>B \<subseteq> V\<close> by blast
     ultimately show False
         using connectedD [of "J \<inter> K" U V] \<open>open U\<close> \<open>open V\<close> \<open>U \<inter> V = {}\<close>  by auto
   qed
   with cf show ?thesis
     by (auto simp: connected_closed_set compact_imp_closed)
 qed
 
 lemma connected_chain_gen:
   fixes \<F> :: "'a :: euclidean_space set set"
   assumes X: "X \<in> \<F>" "compact X"
       and cc: "\<And>T. T \<in> \<F> \<Longrightarrow> closed T \<and> connected T"
       and linear: "\<And>S T. S \<in> \<F> \<and> T \<in> \<F> \<Longrightarrow> S \<subseteq> T \<or> T \<subseteq> S"
   shows "connected(\<Inter>\<F>)"
 proof -
   have "\<Inter>\<F> = (\<Inter>T\<in>\<F>. X \<inter> T)"
     using X by blast
   moreover have "connected (\<Inter>T\<in>\<F>. X \<inter> T)"
   proof (rule connected_chain)
     show "\<And>T. T \<in> (\<inter>) X ` \<F> \<Longrightarrow> compact T \<and> connected T"
       using cc X by auto (metis inf.absorb2 inf.orderE local.linear)
     show "\<And>S T. S \<in> (\<inter>) X ` \<F> \<and> T \<in> (\<inter>) X ` \<F> \<Longrightarrow> S \<subseteq> T \<or> T \<subseteq> S"
       using local.linear by blast
   qed
   ultimately show ?thesis
     by metis
 qed
 
 lemma connected_nest:
   fixes S :: "'a::linorder \<Rightarrow> 'b::euclidean_space set"
   assumes S: "\<And>n. compact(S n)" "\<And>n. connected(S n)"
     and nest: "\<And>m n. m \<le> n \<Longrightarrow> S n \<subseteq> S m"
   shows "connected(\<Inter> (range S))"
   apply (rule connected_chain)
   using S apply blast
   by (metis image_iff le_cases nest)
 
 lemma connected_nest_gen:
   fixes S :: "'a::linorder \<Rightarrow> 'b::euclidean_space set"
   assumes S: "\<And>n. closed(S n)" "\<And>n. connected(S n)" "compact(S k)"
     and nest: "\<And>m n. m \<le> n \<Longrightarrow> S n \<subseteq> S m"
   shows "connected(\<Inter> (range S))"
   apply (rule connected_chain_gen [of "S k"])
   using S apply auto
   by (meson le_cases nest subsetCE)
 
 subsection\<open>Proper maps, including projections out of compact sets\<close>
 
 lemma finite_indexed_bound:
   assumes A: "finite A" "\<And>x. x \<in> A \<Longrightarrow> \<exists>n::'a::linorder. P x n"
     shows "\<exists>m. \<forall>x \<in> A. \<exists>k\<le>m. P x k"
 using A
 proof (induction A)
   case empty then show ?case by force
 next
   case (insert a A)
     then obtain m n where "\<forall>x \<in> A. \<exists>k\<le>m. P x k" "P a n"
       by force
     then show ?case
       apply (rule_tac x="max m n" in exI, safe)
       using max.cobounded2 apply blast
       by (meson le_max_iff_disj)
 qed
 
 proposition proper_map:
   fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
   assumes "closedin (top_of_set S) K"
       and com: "\<And>U. \<lbrakk>U \<subseteq> T; compact U\<rbrakk> \<Longrightarrow> compact (S \<inter> f -` U)"
       and "f ` S \<subseteq> T"
     shows "closedin (top_of_set T) (f ` K)"
 proof -
   have "K \<subseteq> S"
     using assms closedin_imp_subset by metis
   obtain C where "closed C" and Keq: "K = S \<inter> C"
     using assms by (auto simp: closedin_closed)
   have *: "y \<in> f ` K" if "y \<in> T" and y: "y islimpt f ` K" for y
   proof -
     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"
       using \<open>y \<in> T\<close> y by (force simp: limpt_sequential_inj)
     then obtain X where X: "\<And>n. X n \<in> K \<and> h n = f (X n) \<and> h n \<noteq> y"
       by metis
     then have fX: "\<And>n. f (X n) = h n"
       by metis
     have "compact (C \<inter> (S \<inter> f -` insert y (range (\<lambda>i. f(X(n + i))))))" for n
       apply (rule closed_Int_compact [OF \<open>closed C\<close>])
       apply (rule com)
        using X \<open>K \<subseteq> S\<close> \<open>f ` S \<subseteq> T\<close> \<open>y \<in> T\<close> apply blast
       apply (rule compact_sequence_with_limit)
       apply (simp add: fX add.commute [of n] LIMSEQ_ignore_initial_segment [OF hlim])
       done
     then have comf: "compact {a \<in> K. f a \<in> insert y (range (\<lambda>i. f(X(n + i))))}" for n
       by (simp add: Keq Int_def conj_commute)
     have ne: "\<Inter>\<F> \<noteq> {}"
              if "finite \<F>"
                 and \<F>: "\<And>t. t \<in> \<F> \<Longrightarrow>
                            (\<exists>n. t = {a \<in> K. f a \<in> insert y (range (\<lambda>i. f (X (n + i))))})"
              for \<F>
     proof -
       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))))}"
         apply (rule exE)
         apply (rule finite_indexed_bound [OF \<open>finite \<F>\<close> \<F>], assumption, force)
         done
       have "X m \<in> \<Inter>\<F>"
         using X le_Suc_ex by (fastforce dest: m)
       then show ?thesis by blast
     qed
     have "\<Inter>{{a. a \<in> K \<and> f a \<in> insert y (range (\<lambda>i. f(X(n + i))))} |n. n \<in> UNIV}
                \<noteq> {}"
       apply (rule compact_fip_Heine_Borel)
        using comf apply force
       using ne  apply (simp add: subset_iff del: insert_iff)
       done
     then have "\<exists>x. x \<in> (\<Inter>n. {a \<in> K. f a \<in> insert y (range (\<lambda>i. f (X (n + i))))})"
       by blast
     then show ?thesis
       apply (simp add: image_iff fX)
       by (metis \<open>inj h\<close> le_add1 not_less_eq_eq rangeI range_ex1_eq)
   qed
   with assms closedin_subset show ?thesis
     by (force simp: closedin_limpt)
 qed
 
 
 lemma compact_continuous_image_eq:
   fixes f :: "'a::heine_borel \<Rightarrow> 'b::heine_borel"
   assumes f: "inj_on f S"
   shows "continuous_on S f \<longleftrightarrow> (\<forall>T. compact T \<and> T \<subseteq> S \<longrightarrow> compact(f ` T))"
            (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
     by (metis continuous_on_subset compact_continuous_image)
 next
   assume RHS: ?rhs
   obtain g where gf: "\<And>x. x \<in> S \<Longrightarrow> g (f x) = x"
     by (metis inv_into_f_f f)
   then have *: "(S \<inter> f -` U) = g ` U" if "U \<subseteq> f ` S" for U
     using that by fastforce
   have gfim: "g ` f ` S \<subseteq> S" using gf by auto
   have **: "compact (f ` S \<inter> g -` C)" if C: "C \<subseteq> S" "compact C" for C
   proof -
     obtain h where "h C \<in> C \<and> h C \<notin> S \<or> compact (f ` C)"
       by (force simp: C RHS)
     moreover have "f ` C = (f ` S \<inter> g -` C)"
       using C gf by auto
     ultimately show ?thesis
       using C by auto
   qed
   show ?lhs
     using proper_map [OF _ _ gfim] **
     by (simp add: continuous_on_closed * closedin_imp_subset)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Trivial fact: convexity equals connectedness for collinear sets\<close>
 
 lemma convex_connected_collinear:
   fixes S :: "'a::euclidean_space set"
   assumes "collinear S"
     shows "convex S \<longleftrightarrow> connected S"
 proof
   assume "convex S"
   then show "connected S"
     using convex_connected by blast
 next
   assume S: "connected S"
   show "convex S"
   proof (cases "S = {}")
     case True
     then show ?thesis by simp
   next
     case False
     then obtain a where "a \<in> S" by auto
     have "collinear (affine hull S)"
       by (simp add: assms collinear_affine_hull_collinear)
     then obtain z where "z \<noteq> 0" "\<And>x. x \<in> affine hull S \<Longrightarrow> \<exists>c. x - a = c *\<^sub>R z"
       by (meson \<open>a \<in> S\<close> collinear hull_inc)
     then obtain f where f: "\<And>x. x \<in> affine hull S \<Longrightarrow> x - a = f x *\<^sub>R z"
       by metis
     then have inj_f: "inj_on f (affine hull S)"
       by (metis diff_add_cancel inj_onI)
     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
     proof -
       have "f x *\<^sub>R z = x - a"
         by (simp add: f hull_inc x)
       moreover have "f y *\<^sub>R z = y - a"
         by (simp add: f hull_inc y)
       ultimately show ?thesis
         by (simp add: scaleR_left.diff)
     qed
     have cont_f: "continuous_on (affine hull S) f"
       apply (clarsimp simp: dist_norm continuous_on_iff diff)
       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)
     then have conn_fS: "connected (f ` S)"
       by (meson S connected_continuous_image continuous_on_subset hull_subset)
     show ?thesis
     proof (clarsimp simp: convex_contains_segment)
       fix x y z
       assume "x \<in> S" "y \<in> S" "z \<in> closed_segment x y"
       have False if "z \<notin> S"
       proof -
         have "f ` (closed_segment x y) = closed_segment (f x) (f y)"
           apply (rule continuous_injective_image_segment_1)
           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])
           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])
         then have fz: "f z \<in> closed_segment (f x) (f y)"
           using \<open>z \<in> closed_segment x y\<close> by blast
         have "z \<in> affine hull S"
           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)
         then have fz_notin: "f z \<notin> f ` S"
           using hull_subset inj_f inj_onD that by fastforce
         moreover have "{..<f z} \<inter> f ` S \<noteq> {}" "{f z<..} \<inter> f ` S \<noteq> {}"
         proof -
           have "{..<f z} \<inter> f ` {x,y} \<noteq> {}"  "{f z<..} \<inter> f ` {x,y} \<noteq> {}"
             using fz fz_notin \<open>x \<in> S\<close> \<open>y \<in> S\<close>
              apply (auto simp: closed_segment_eq_real_ivl split: if_split_asm)
              apply (metis image_eqI less_eq_real_def)+
             done
           then show "{..<f z} \<inter> f ` S \<noteq> {}" "{f z<..} \<inter> f ` S \<noteq> {}"
             using \<open>x \<in> S\<close> \<open>y \<in> S\<close> by blast+
         qed
         ultimately show False
           using connectedD [OF conn_fS, of "{..<f z}" "{f z<..}"] by force
       qed
       then show "z \<in> S" by meson
     qed
   qed
 qed
 
 lemma compact_convex_collinear_segment_alt:
   fixes S :: "'a::euclidean_space set"
   assumes "S \<noteq> {}" "compact S" "connected S" "collinear S"
   obtains a b where "S = closed_segment a b"
 proof -
   obtain \<xi> where "\<xi> \<in> S" using \<open>S \<noteq> {}\<close> by auto
   have "collinear (affine hull S)"
     by (simp add: assms collinear_affine_hull_collinear)
   then obtain z where "z \<noteq> 0" "\<And>x. x \<in> affine hull S \<Longrightarrow> \<exists>c. x - \<xi> = c *\<^sub>R z"
     by (meson \<open>\<xi> \<in> S\<close> collinear hull_inc)
   then obtain f where f: "\<And>x. x \<in> affine hull S \<Longrightarrow> x - \<xi> = f x *\<^sub>R z"
     by metis
   let ?g = "\<lambda>r. r *\<^sub>R z + \<xi>"
   have gf: "?g (f x) = x" if "x \<in> affine hull S" for x
     by (metis diff_add_cancel f that)
   then have inj_f: "inj_on f (affine hull S)"
     by (metis inj_onI)
   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
   proof -
     have "f x *\<^sub>R z = x - \<xi>"
       by (simp add: f hull_inc x)
     moreover have "f y *\<^sub>R z = y - \<xi>"
       by (simp add: f hull_inc y)
     ultimately show ?thesis
       by (simp add: scaleR_left.diff)
   qed
   have cont_f: "continuous_on (affine hull S) f"
     apply (clarsimp simp: dist_norm continuous_on_iff diff)
     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)
   then have "connected (f ` S)"
     by (meson \<open>connected S\<close> connected_continuous_image continuous_on_subset hull_subset)
   moreover have "compact (f ` S)"
     by (meson \<open>compact S\<close> compact_continuous_image_eq cont_f hull_subset inj_f)
   ultimately obtain x y where "f ` S = {x..y}"
     by (meson connected_compact_interval_1)
   then have fS_eq: "f ` S = closed_segment x y"
     using \<open>S \<noteq> {}\<close> closed_segment_eq_real_ivl by auto
   obtain a b where "a \<in> S" "f a = x" "b \<in> S" "f b = y"
     by (metis (full_types) ends_in_segment fS_eq imageE)
   have "f ` (closed_segment a b) = closed_segment (f a) (f b)"
     apply (rule continuous_injective_image_segment_1)
      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])
     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])
   then have "f ` (closed_segment a b) = f ` S"
     by (simp add: \<open>f a = x\<close> \<open>f b = y\<close> fS_eq)
   then have "?g ` f ` (closed_segment a b) = ?g ` f ` S"
     by simp
   moreover have "(\<lambda>x. f x *\<^sub>R z + \<xi>) ` closed_segment a b = closed_segment a b"
     apply safe
      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)
     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)
   ultimately have "closed_segment a b = S"
     using gf by (simp add: image_comp o_def hull_inc cong: image_cong)
   then show ?thesis
     using that by blast
 qed
 
 lemma compact_convex_collinear_segment:
   fixes S :: "'a::euclidean_space set"
   assumes "S \<noteq> {}" "compact S" "convex S" "collinear S"
   obtains a b where "S = closed_segment a b"
   using assms convex_connected_collinear compact_convex_collinear_segment_alt by blast
 
 
 lemma proper_map_from_compact:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes contf: "continuous_on S f" and imf: "f ` S \<subseteq> T" and "compact S"
           "closedin (top_of_set T) K"
   shows "compact (S \<inter> f -` K)"
 by (rule closedin_compact [OF \<open>compact S\<close>] continuous_closedin_preimage_gen assms)+
 
 lemma proper_map_fst:
   assumes "compact T" "K \<subseteq> S" "compact K"
     shows "compact (S \<times> T \<inter> fst -` K)"
 proof -
   have "(S \<times> T \<inter> fst -` K) = K \<times> T"
     using assms by auto
   then show ?thesis by (simp add: assms compact_Times)
 qed
 
 lemma closed_map_fst:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "compact T" "closedin (top_of_set (S \<times> T)) c"
    shows "closedin (top_of_set S) (fst ` c)"
 proof -
   have *: "fst ` (S \<times> T) \<subseteq> S"
     by auto
   show ?thesis
     using proper_map [OF _ _ *] by (simp add: proper_map_fst assms)
 qed
 
 lemma proper_map_snd:
   assumes "compact S" "K \<subseteq> T" "compact K"
     shows "compact (S \<times> T \<inter> snd -` K)"
 proof -
   have "(S \<times> T \<inter> snd -` K) = S \<times> K"
     using assms by auto
   then show ?thesis by (simp add: assms compact_Times)
 qed
 
 lemma closed_map_snd:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "compact S" "closedin (top_of_set (S \<times> T)) c"
    shows "closedin (top_of_set T) (snd ` c)"
 proof -
   have *: "snd ` (S \<times> T) \<subseteq> T"
     by auto
   show ?thesis
     using proper_map [OF _ _ *] by (simp add: proper_map_snd assms)
 qed
 
 lemma closedin_compact_projection:
   fixes S :: "'a::euclidean_space set" and T :: "'b::euclidean_space set"
   assumes "compact S" and clo: "closedin (top_of_set (S \<times> T)) U"
     shows "closedin (top_of_set T) {y. \<exists>x. x \<in> S \<and> (x, y) \<in> U}"
 proof -
   have "U \<subseteq> S \<times> T"
     by (metis clo closedin_imp_subset)
   then have "{y. \<exists>x. x \<in> S \<and> (x, y) \<in> U} = snd ` U"
     by force
   moreover have "closedin (top_of_set T) (snd ` U)"
     by (rule closed_map_snd [OF assms])
   ultimately show ?thesis
     by simp
 qed
 
 
 lemma closed_compact_projection:
   fixes S :: "'a::euclidean_space set"
     and T :: "('a * 'b::euclidean_space) set"
   assumes "compact S" and clo: "closed T"
     shows "closed {y. \<exists>x. x \<in> S \<and> (x, y) \<in> T}"
 proof -
   have *: "{y. \<exists>x. x \<in> S \<and> Pair x y \<in> T} =
         {y. \<exists>x. x \<in> S \<and> Pair x y \<in> ((S \<times> UNIV) \<inter> T)}"
     by auto
   show ?thesis
     apply (subst *)
     apply (rule closedin_closed_trans [OF _ closed_UNIV])
     apply (rule closedin_compact_projection [OF \<open>compact S\<close>])
     by (simp add: clo closedin_closed_Int)
 qed
 
 subsubsection\<^marker>\<open>tag unimportant\<close>\<open>Representing affine hull as a finite intersection of hyperplanes\<close>
 
 proposition\<^marker>\<open>tag unimportant\<close> affine_hull_convex_Int_nonempty_interior:
   fixes S :: "'a::real_normed_vector set"
   assumes "convex S" "S \<inter> interior T \<noteq> {}"
     shows "affine hull (S \<inter> T) = affine hull S"
 proof
   show "affine hull (S \<inter> T) \<subseteq> affine hull S"
     by (simp add: hull_mono)
 next
   obtain a where "a \<in> S" "a \<in> T" and at: "a \<in> interior T"
     using assms interior_subset by blast
   then obtain e where "e > 0" and e: "cball a e \<subseteq> T"
     using mem_interior_cball by blast
   have *: "x \<in> (+) a ` span ((\<lambda>x. x - a) ` (S \<inter> T))" if "x \<in> S" for x
   proof (cases "x = a")
     case True with that span_0 eq_add_iff image_def mem_Collect_eq show ?thesis
       by blast
   next
     case False
     define k where "k = min (1/2) (e / norm (x-a))"
     have k: "0 < k" "k < 1"
       using \<open>e > 0\<close> False by (auto simp: k_def)
     then have xa: "(x-a) = inverse k *\<^sub>R k *\<^sub>R (x-a)"
       by simp
     have "e / norm (x - a) \<ge> k"
       using k_def by linarith
     then have "a + k *\<^sub>R (x - a) \<in> cball a e"
       using \<open>0 < k\<close> False
       by (simp add: dist_norm) (simp add: field_simps)
     then have T: "a + k *\<^sub>R (x - a) \<in> T"
       using e by blast
     have S: "a + k *\<^sub>R (x - a) \<in> S"
       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]
       by (simp add: algebra_simps)
     have "inverse k *\<^sub>R k *\<^sub>R (x-a) \<in> span ((\<lambda>x. x - a) ` (S \<inter> T))"
       apply (rule span_mul)
       apply (rule span_base)
       apply (rule image_eqI [where x = "a + k *\<^sub>R (x - a)"])
       apply (auto simp: S T)
       done
     with xa image_iff show ?thesis  by fastforce
   qed
   show "affine hull S \<subseteq> affine hull (S \<inter> T)"
     apply (simp add: subset_hull)
     apply (simp add: \<open>a \<in> S\<close> \<open>a \<in> T\<close> hull_inc affine_hull_span_gen [of a])
     apply (force simp: *)
     done
 qed
 
 corollary affine_hull_convex_Int_open:
   fixes S :: "'a::real_normed_vector set"
   assumes "convex S" "open T" "S \<inter> T \<noteq> {}"
     shows "affine hull (S \<inter> T) = affine hull S"
 using affine_hull_convex_Int_nonempty_interior assms interior_eq by blast
 
 corollary affine_hull_affine_Int_nonempty_interior:
   fixes S :: "'a::real_normed_vector set"
   assumes "affine S" "S \<inter> interior T \<noteq> {}"
     shows "affine hull (S \<inter> T) = affine hull S"
 by (simp add: affine_hull_convex_Int_nonempty_interior affine_imp_convex assms)
 
 corollary affine_hull_affine_Int_open:
   fixes S :: "'a::real_normed_vector set"
   assumes "affine S" "open T" "S \<inter> T \<noteq> {}"
     shows "affine hull (S \<inter> T) = affine hull S"
 by (simp add: affine_hull_convex_Int_open affine_imp_convex assms)
 
 corollary affine_hull_convex_Int_openin:
   fixes S :: "'a::real_normed_vector set"
   assumes "convex S" "openin (top_of_set (affine hull S)) T" "S \<inter> T \<noteq> {}"
     shows "affine hull (S \<inter> T) = affine hull S"
 using assms unfolding openin_open
 by (metis affine_hull_convex_Int_open hull_subset inf.orderE inf_assoc)
 
 corollary affine_hull_openin:
   fixes S :: "'a::real_normed_vector set"
   assumes "openin (top_of_set (affine hull T)) S" "S \<noteq> {}"
     shows "affine hull S = affine hull T"
 using assms unfolding openin_open
 by (metis affine_affine_hull affine_hull_affine_Int_open hull_hull)
 
 corollary affine_hull_open:
   fixes S :: "'a::real_normed_vector set"
   assumes "open S" "S \<noteq> {}"
     shows "affine hull S = UNIV"
 by (metis affine_hull_convex_Int_nonempty_interior assms convex_UNIV hull_UNIV inf_top.left_neutral interior_open)
 
 lemma aff_dim_convex_Int_nonempty_interior:
   fixes S :: "'a::euclidean_space set"
   shows "\<lbrakk>convex S; S \<inter> interior T \<noteq> {}\<rbrakk> \<Longrightarrow> aff_dim(S \<inter> T) = aff_dim S"
 using aff_dim_affine_hull2 affine_hull_convex_Int_nonempty_interior by blast
 
 lemma aff_dim_convex_Int_open:
   fixes S :: "'a::euclidean_space set"
   shows "\<lbrakk>convex S; open T; S \<inter> T \<noteq> {}\<rbrakk> \<Longrightarrow>  aff_dim(S \<inter> T) = aff_dim S"
 using aff_dim_convex_Int_nonempty_interior interior_eq by blast
 
 lemma affine_hull_Diff:
   fixes S:: "'a::real_normed_vector set"
   assumes ope: "openin (top_of_set (affine hull S)) S" and "finite F" "F \<subset> S"
     shows "affine hull (S - F) = affine hull S"
 proof -
   have clo: "closedin (top_of_set S) F"
     using assms finite_imp_closedin by auto
   moreover have "S - F \<noteq> {}"
     using assms by auto
   ultimately show ?thesis
     by (metis ope closedin_def topspace_euclidean_subtopology affine_hull_openin openin_trans)
 qed
 
 lemma affine_hull_halfspace_lt:
   fixes a :: "'a::euclidean_space"
   shows "affine hull {x. a \<bullet> x < r} = (if a = 0 \<and> r \<le> 0 then {} else UNIV)"
 using halfspace_eq_empty_lt [of a r]
 by (simp add: open_halfspace_lt affine_hull_open)
 
 lemma affine_hull_halfspace_le:
   fixes a :: "'a::euclidean_space"
   shows "affine hull {x. a \<bullet> x \<le> r} = (if a = 0 \<and> r < 0 then {} else UNIV)"
 proof (cases "a = 0")
   case True then show ?thesis by simp
 next
   case False
   then have "affine hull closure {x. a \<bullet> x < r} = UNIV"
     using affine_hull_halfspace_lt closure_same_affine_hull by fastforce
   moreover have "{x. a \<bullet> x < r} \<subseteq> {x. a \<bullet> x \<le> r}"
     by (simp add: Collect_mono)
   ultimately show ?thesis using False antisym_conv hull_mono top_greatest
     by (metis affine_hull_halfspace_lt)
 qed
 
 lemma affine_hull_halfspace_gt:
   fixes a :: "'a::euclidean_space"
   shows "affine hull {x. a \<bullet> x > r} = (if a = 0 \<and> r \<ge> 0 then {} else UNIV)"
 using halfspace_eq_empty_gt [of r a]
 by (simp add: open_halfspace_gt affine_hull_open)
 
 lemma affine_hull_halfspace_ge:
   fixes a :: "'a::euclidean_space"
   shows "affine hull {x. a \<bullet> x \<ge> r} = (if a = 0 \<and> r > 0 then {} else UNIV)"
 using affine_hull_halfspace_le [of "-a" "-r"] by simp
 
 lemma aff_dim_halfspace_lt:
   fixes a :: "'a::euclidean_space"
   shows "aff_dim {x. a \<bullet> x < r} =
         (if a = 0 \<and> r \<le> 0 then -1 else DIM('a))"
 by simp (metis aff_dim_open halfspace_eq_empty_lt open_halfspace_lt)
 
 lemma aff_dim_halfspace_le:
   fixes a :: "'a::euclidean_space"
   shows "aff_dim {x. a \<bullet> x \<le> r} =
         (if a = 0 \<and> r < 0 then -1 else DIM('a))"
 proof -
   have "int (DIM('a)) = aff_dim (UNIV::'a set)"
     by (simp add: aff_dim_UNIV)
   then have "aff_dim (affine hull {x. a \<bullet> x \<le> r}) = DIM('a)" if "(a = 0 \<longrightarrow> r \<ge> 0)"
     using that by (simp add: affine_hull_halfspace_le not_less)
   then show ?thesis
     by (force simp: aff_dim_affine_hull)
 qed
 
 lemma aff_dim_halfspace_gt:
   fixes a :: "'a::euclidean_space"
   shows "aff_dim {x. a \<bullet> x > r} =
         (if a = 0 \<and> r \<ge> 0 then -1 else DIM('a))"
 by simp (metis aff_dim_open halfspace_eq_empty_gt open_halfspace_gt)
 
 lemma aff_dim_halfspace_ge:
   fixes a :: "'a::euclidean_space"
   shows "aff_dim {x. a \<bullet> x \<ge> r} =
         (if a = 0 \<and> r > 0 then -1 else DIM('a))"
 using aff_dim_halfspace_le [of "-a" "-r"] by simp
 
 proposition aff_dim_eq_hyperplane:
   fixes S :: "'a::euclidean_space set"
   shows "aff_dim S = DIM('a) - 1 \<longleftrightarrow> (\<exists>a b. a \<noteq> 0 \<and> affine hull S = {x. a \<bullet> x = b})"
 proof (cases "S = {}")
   case True then show ?thesis
     by (auto simp: dest: hyperplane_eq_Ex)
 next
   case False
   then obtain c where "c \<in> S" by blast
   show ?thesis
   proof (cases "c = 0")
     case True show ?thesis
       using span_zero [of S]
         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
           del: One_nat_def)
         apply (auto simp add: \<open>c = 0\<close>)
         done
   next
     case False
     have xc_im: "x \<in> (+) c ` {y. a \<bullet> y = 0}" if "a \<bullet> x = a \<bullet> c" for a x
     proof -
       have "\<exists>y. a \<bullet> y = 0 \<and> c + y = x"
         by (metis that add.commute diff_add_cancel inner_commute inner_diff_left right_minus_eq)
       then show "x \<in> (+) c ` {y. a \<bullet> y = 0}"
         by blast
     qed
     have 2: "span ((\<lambda>x. x - c) ` S) = {x. a \<bullet> x = 0}"
          if "(+) c ` span ((\<lambda>x. x - c) ` S) = {x. a \<bullet> x = b}" for a b
     proof -
       have "b = a \<bullet> c"
         using span_0 that by fastforce
       with that have "(+) c ` span ((\<lambda>x. x - c) ` S) = {x. a \<bullet> x = a \<bullet> c}"
         by simp
       then have "span ((\<lambda>x. x - c) ` S) = (\<lambda>x. x - c) ` {x. a \<bullet> x = a \<bullet> c}"
         by (metis (no_types) image_cong translation_galois uminus_add_conv_diff)
       also have "... = {x. a \<bullet> x = 0}"
         by (force simp: inner_distrib inner_diff_right
              intro: image_eqI [where x="x+c" for x])
       finally show ?thesis .
     qed
     show ?thesis
       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
                   del: One_nat_def cong: image_cong_simp, safe)
       apply (fastforce simp add: inner_distrib intro: xc_im)
       apply (force simp: intro!: 2)
       done
   qed
 qed
 
 corollary aff_dim_hyperplane [simp]:
   fixes a :: "'a::euclidean_space"
   shows "a \<noteq> 0 \<Longrightarrow> aff_dim {x. a \<bullet> x = r} = DIM('a) - 1"
 by (metis aff_dim_eq_hyperplane affine_hull_eq affine_hyperplane)
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Some stepping theorems\<close>
 
 lemma aff_dim_insert:
   fixes a :: "'a::euclidean_space"
   shows "aff_dim (insert a S) = (if a \<in> affine hull S then aff_dim S else aff_dim S + 1)"
 proof (cases "S = {}")
   case True then show ?thesis
     by simp
 next
   case False
   then obtain x s' where S: "S = insert x s'" "x \<notin> s'"
     by (meson Set.set_insert all_not_in_conv)
   show ?thesis using S
     apply (simp add: hull_redundant cong: aff_dim_affine_hull2)
     apply (simp add: affine_hull_insert_span_gen hull_inc)
     by (force simp add: span_zero insert_commute [of a] hull_inc aff_dim_eq_dim [of x] dim_insert
       cong: image_cong_simp)
 qed
 
 lemma affine_dependent_choose:
   fixes a :: "'a :: euclidean_space"
   assumes "\<not>(affine_dependent S)"
   shows "affine_dependent(insert a S) \<longleftrightarrow> a \<notin> S \<and> a \<in> affine hull S"
         (is "?lhs = ?rhs")
 proof safe
   assume "affine_dependent (insert a S)" and "a \<in> S"
   then show "False"
     using \<open>a \<in> S\<close> assms insert_absorb by fastforce
 next
   assume lhs: "affine_dependent (insert a S)"
   then have "a \<notin> S"
     by (metis (no_types) assms insert_absorb)
   moreover have "finite S"
     using affine_independent_iff_card assms by blast
   moreover have "aff_dim (insert a S) \<noteq> int (card S)"
     using \<open>finite S\<close> affine_independent_iff_card \<open>a \<notin> S\<close> lhs by fastforce
   ultimately show "a \<in> affine hull S"
     by (metis aff_dim_affine_independent aff_dim_insert assms)
 next
   assume "a \<notin> S" and "a \<in> affine hull S"
   show "affine_dependent (insert a S)"
     by (simp add: \<open>a \<in> affine hull S\<close> \<open>a \<notin> S\<close> affine_dependent_def)
 qed
 
 lemma affine_independent_insert:
   fixes a :: "'a :: euclidean_space"
   shows "\<lbrakk>\<not> affine_dependent S; a \<notin> affine hull S\<rbrakk> \<Longrightarrow> \<not> affine_dependent(insert a S)"
   by (simp add: affine_dependent_choose)
 
 lemma subspace_bounded_eq_trivial:
   fixes S :: "'a::real_normed_vector set"
   assumes "subspace S"
     shows "bounded S \<longleftrightarrow> S = {0}"
 proof -
   have "False" if "bounded S" "x \<in> S" "x \<noteq> 0" for x
   proof -
     obtain B where B: "\<And>y. y \<in> S \<Longrightarrow> norm y < B" "B > 0"
       using \<open>bounded S\<close> by (force simp: bounded_pos_less)
     have "(B / norm x) *\<^sub>R x \<in> S"
       using assms subspace_mul \<open>x \<in> S\<close> by auto
     moreover have "norm ((B / norm x) *\<^sub>R x) = B"
       using that B by (simp add: algebra_simps)
     ultimately show False using B by force
   qed
   then have "bounded S \<Longrightarrow> S = {0}"
     using assms subspace_0 by fastforce
   then show ?thesis
     by blast
 qed
 
 lemma affine_bounded_eq_trivial:
   fixes S :: "'a::real_normed_vector set"
   assumes "affine S"
     shows "bounded S \<longleftrightarrow> S = {} \<or> (\<exists>a. S = {a})"
 proof (cases "S = {}")
   case True then show ?thesis
     by simp
 next
   case False
   then obtain b where "b \<in> S" by blast
   with False assms show ?thesis
     apply safe
     using affine_diffs_subspace [OF assms \<open>b \<in> S\<close>]
     apply (metis (no_types, lifting) subspace_bounded_eq_trivial ab_left_minus bounded_translation
                 image_empty image_insert translation_invert)
     apply force
     done
 qed
 
 lemma affine_bounded_eq_lowdim:
   fixes S :: "'a::euclidean_space set"
   assumes "affine S"
     shows "bounded S \<longleftrightarrow> aff_dim S \<le> 0"
 apply safe
 using affine_bounded_eq_trivial assms apply fastforce
 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)
 
 
 lemma bounded_hyperplane_eq_trivial_0:
   fixes a :: "'a::euclidean_space"
   assumes "a \<noteq> 0"
   shows "bounded {x. a \<bullet> x = 0} \<longleftrightarrow> DIM('a) = 1"
 proof
   assume "bounded {x. a \<bullet> x = 0}"
   then have "aff_dim {x. a \<bullet> x = 0} \<le> 0"
     by (simp add: affine_bounded_eq_lowdim affine_hyperplane)
   with assms show "DIM('a) = 1"
     by (simp add: le_Suc_eq aff_dim_hyperplane)
 next
   assume "DIM('a) = 1"
   then show "bounded {x. a \<bullet> x = 0}"
     by (simp add: aff_dim_hyperplane affine_bounded_eq_lowdim affine_hyperplane assms)
 qed
 
 lemma bounded_hyperplane_eq_trivial:
   fixes a :: "'a::euclidean_space"
   shows "bounded {x. a \<bullet> x = r} \<longleftrightarrow> (if a = 0 then r \<noteq> 0 else DIM('a) = 1)"
 proof (simp add: bounded_hyperplane_eq_trivial_0, clarify)
   assume "r \<noteq> 0" "a \<noteq> 0"
   have "aff_dim {x. y \<bullet> x = 0} = aff_dim {x. a \<bullet> x = r}" if "y \<noteq> 0" for y::'a
     by (metis that \<open>a \<noteq> 0\<close> aff_dim_hyperplane)
   then show "bounded {x. a \<bullet> x = r} = (DIM('a) = Suc 0)"
     by (metis One_nat_def \<open>a \<noteq> 0\<close> affine_bounded_eq_lowdim affine_hyperplane bounded_hyperplane_eq_trivial_0)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>General case without assuming closure and getting non-strict separation\<close>
 
 proposition\<^marker>\<open>tag unimportant\<close> separating_hyperplane_closed_point_inset:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "closed S" "S \<noteq> {}" "z \<notin> S"
   obtains a b where "a \<in> S" "(a - z) \<bullet> z < b" "\<And>x. x \<in> S \<Longrightarrow> b < (a - z) \<bullet> x"
 proof -
   obtain y where "y \<in> S" and y: "\<And>u. u \<in> S \<Longrightarrow> dist z y \<le> dist z u"
     using distance_attains_inf [of S z] assms by auto
   then have *: "(y - z) \<bullet> z < (y - z) \<bullet> z + (norm (y - z))\<^sup>2 / 2"
     using \<open>y \<in> S\<close> \<open>z \<notin> S\<close> by auto
   show ?thesis
   proof (rule that [OF \<open>y \<in> S\<close> *])
     fix x
     assume "x \<in> S"
     have yz: "0 < (y - z) \<bullet> (y - z)"
       using \<open>y \<in> S\<close> \<open>z \<notin> S\<close> by auto
     { assume 0: "0 < ((z - y) \<bullet> (x - y))"
       with any_closest_point_dot [OF \<open>convex S\<close> \<open>closed S\<close>]
       have False
         using y \<open>x \<in> S\<close> \<open>y \<in> S\<close> not_less by blast
     }
     then have "0 \<le> ((y - z) \<bullet> (x - y))"
       by (force simp: not_less inner_diff_left)
     with yz have "0 < 2 * ((y - z) \<bullet> (x - y)) + (y - z) \<bullet> (y - z)"
       by (simp add: algebra_simps)
     then show "(y - z) \<bullet> z + (norm (y - z))\<^sup>2 / 2 < (y - z) \<bullet> x"
       by (simp add: field_simps inner_diff_left inner_diff_right dot_square_norm [symmetric])
   qed
 qed
 
 lemma separating_hyperplane_closed_0_inset:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "closed S" "S \<noteq> {}" "0 \<notin> S"
   obtains a b where "a \<in> S" "a \<noteq> 0" "0 < b" "\<And>x. x \<in> S \<Longrightarrow> a \<bullet> x > b"
 using separating_hyperplane_closed_point_inset [OF assms]
 by simp (metis \<open>0 \<notin> S\<close>)
 
 
 proposition\<^marker>\<open>tag unimportant\<close> separating_hyperplane_set_0_inspan:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "S \<noteq> {}" "0 \<notin> S"
   obtains a where "a \<in> span S" "a \<noteq> 0" "\<And>x. x \<in> S \<Longrightarrow> 0 \<le> a \<bullet> x"
 proof -
   define k where [abs_def]: "k c = {x. 0 \<le> c \<bullet> x}" for c :: 'a
   have *: "span S \<inter> frontier (cball 0 1) \<inter> \<Inter>f' \<noteq> {}"
           if f': "finite f'" "f' \<subseteq> k ` S" for f'
   proof -
     obtain C where "C \<subseteq> S" "finite C" and C: "f' = k ` C"
       using finite_subset_image [OF f'] by blast
     obtain a where "a \<in> S" "a \<noteq> 0"
       using \<open>S \<noteq> {}\<close> \<open>0 \<notin> S\<close> ex_in_conv by blast
     then have "norm (a /\<^sub>R (norm a)) = 1"
       by simp
     moreover have "a /\<^sub>R (norm a) \<in> span S"
       by (simp add: \<open>a \<in> S\<close> span_scale span_base)
     ultimately have ass: "a /\<^sub>R (norm a) \<in> span S \<inter> sphere 0 1"
       by simp
     show ?thesis
     proof (cases "C = {}")
       case True with C ass show ?thesis
         by auto
     next
       case False
       have "closed (convex hull C)"
         using \<open>finite C\<close> compact_eq_bounded_closed finite_imp_compact_convex_hull by auto
       moreover have "convex hull C \<noteq> {}"
         by (simp add: False)
       moreover have "0 \<notin> convex hull C"
         by (metis \<open>C \<subseteq> S\<close> \<open>convex S\<close> \<open>0 \<notin> S\<close> convex_hull_subset hull_same insert_absorb insert_subset)
       ultimately obtain a b
             where "a \<in> convex hull C" "a \<noteq> 0" "0 < b"
                   and ab: "\<And>x. x \<in> convex hull C \<Longrightarrow> a \<bullet> x > b"
         using separating_hyperplane_closed_0_inset by blast
       then have "a \<in> S"
         by (metis \<open>C \<subseteq> S\<close> assms(1) subsetCE subset_hull)
       moreover have "norm (a /\<^sub>R (norm a)) = 1"
         using \<open>a \<noteq> 0\<close> by simp
       moreover have "a /\<^sub>R (norm a) \<in> span S"
         by (simp add: \<open>a \<in> S\<close> span_scale span_base)
       ultimately have ass: "a /\<^sub>R (norm a) \<in> span S \<inter> sphere 0 1"
         by simp
       have aa: "a /\<^sub>R (norm a) \<in> (\<Inter>c\<in>C. {x. 0 \<le> c \<bullet> x})"
         apply (clarsimp simp add: field_split_simps)
         using ab \<open>0 < b\<close>
         by (metis hull_inc inner_commute less_eq_real_def less_trans)
       show ?thesis
         apply (simp add: C k_def)
         using ass aa Int_iff empty_iff by blast
     qed
   qed
   have "(span S \<inter> frontier(cball 0 1)) \<inter> (\<Inter> (k ` S)) \<noteq> {}"
     apply (rule compact_imp_fip)
     apply (blast intro: compact_cball)
     using closed_halfspace_ge k_def apply blast
     apply (metis *)
     done
   then show ?thesis
     unfolding set_eq_iff k_def
     by simp (metis inner_commute norm_eq_zero that zero_neq_one)
 qed
 
 
 lemma separating_hyperplane_set_point_inaff:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "S \<noteq> {}" and zno: "z \<notin> S"
   obtains a b where "(z + a) \<in> affine hull (insert z S)"
                 and "a \<noteq> 0" and "a \<bullet> z \<le> b"
                 and "\<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<ge> b"
 proof -
   from separating_hyperplane_set_0_inspan [of "image (\<lambda>x. -z + x) S"]
   have "convex ((+) (- z) ` S)"
     using \<open>convex S\<close> by simp
   moreover have "(+) (- z) ` S \<noteq> {}"
     by (simp add: \<open>S \<noteq> {}\<close>)
   moreover have "0 \<notin> (+) (- z) ` S"
     using zno by auto
   ultimately obtain a where "a \<in> span ((+) (- z) ` S)" "a \<noteq> 0"
                   and a:  "\<And>x. x \<in> ((+) (- z) ` S) \<Longrightarrow> 0 \<le> a \<bullet> x"
     using separating_hyperplane_set_0_inspan [of "image (\<lambda>x. -z + x) S"]
     by blast
   then have szx: "\<And>x. x \<in> S \<Longrightarrow> a \<bullet> z \<le> a \<bullet> x"
     by (metis (no_types, lifting) imageI inner_minus_right inner_right_distrib minus_add neg_le_0_iff_le neg_le_iff_le real_add_le_0_iff)
   show ?thesis
     apply (rule_tac a=a and b = "a  \<bullet> z" in that, simp_all)
     using \<open>a \<in> span ((+) (- z) ` S)\<close> affine_hull_insert_span_gen apply blast
     apply (simp_all add: \<open>a \<noteq> 0\<close> szx)
     done
 qed
 
 proposition\<^marker>\<open>tag unimportant\<close> supporting_hyperplane_rel_boundary:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "x \<in> S" and xno: "x \<notin> rel_interior S"
   obtains a where "a \<noteq> 0"
               and "\<And>y. y \<in> S \<Longrightarrow> a \<bullet> x \<le> a \<bullet> y"
               and "\<And>y. y \<in> rel_interior S \<Longrightarrow> a \<bullet> x < a \<bullet> y"
 proof -
   obtain a b where aff: "(x + a) \<in> affine hull (insert x (rel_interior S))"
                   and "a \<noteq> 0" and "a \<bullet> x \<le> b"
                   and ageb: "\<And>u. u \<in> (rel_interior S) \<Longrightarrow> a \<bullet> u \<ge> b"
     using separating_hyperplane_set_point_inaff [of "rel_interior S" x] assms
     by (auto simp: rel_interior_eq_empty convex_rel_interior)
   have le_ay: "a \<bullet> x \<le> a \<bullet> y" if "y \<in> S" for y
   proof -
     have con: "continuous_on (closure (rel_interior S)) ((\<bullet>) a)"
       by (rule continuous_intros continuous_on_subset | blast)+
     have y: "y \<in> closure (rel_interior S)"
       using \<open>convex S\<close> closure_def convex_closure_rel_interior \<open>y \<in> S\<close>
       by fastforce
     show ?thesis
       using continuous_ge_on_closure [OF con y] ageb \<open>a \<bullet> x \<le> b\<close>
       by fastforce
   qed
   have 3: "a \<bullet> x < a \<bullet> y" if "y \<in> rel_interior S" for y
   proof -
     obtain e where "0 < e" "y \<in> S" and e: "cball y e \<inter> affine hull S \<subseteq> S"
       using \<open>y \<in> rel_interior S\<close> by (force simp: rel_interior_cball)
     define y' where "y' = y - (e / norm a) *\<^sub>R ((x + a) - x)"
     have "y' \<in> cball y e"
       unfolding y'_def using \<open>0 < e\<close> by force
     moreover have "y' \<in> affine hull S"
       unfolding y'_def
       by (metis \<open>x \<in> S\<close> \<open>y \<in> S\<close> \<open>convex S\<close> aff affine_affine_hull hull_redundant
                 rel_interior_same_affine_hull hull_inc mem_affine_3_minus2)
     ultimately have "y' \<in> S"
       using e by auto
     have "a \<bullet> x \<le> a \<bullet> y"
       using le_ay \<open>a \<noteq> 0\<close> \<open>y \<in> S\<close> by blast
     moreover have "a \<bullet> x \<noteq> a \<bullet> y"
       using le_ay [OF \<open>y' \<in> S\<close>] \<open>a \<noteq> 0\<close>
       apply (simp add: y'_def inner_diff dot_square_norm power2_eq_square)
       by (metis \<open>0 < e\<close> add_le_same_cancel1 inner_commute inner_real_def inner_zero_left le_diff_eq norm_le_zero_iff real_mult_le_cancel_iff2)
     ultimately show ?thesis by force
   qed
   show ?thesis
     by (rule that [OF \<open>a \<noteq> 0\<close> le_ay 3])
 qed
 
 lemma supporting_hyperplane_relative_frontier:
   fixes S :: "'a::euclidean_space set"
   assumes "convex S" "x \<in> closure S" "x \<notin> rel_interior S"
   obtains a where "a \<noteq> 0"
               and "\<And>y. y \<in> closure S \<Longrightarrow> a \<bullet> x \<le> a \<bullet> y"
               and "\<And>y. y \<in> rel_interior S \<Longrightarrow> a \<bullet> x < a \<bullet> y"
 using supporting_hyperplane_rel_boundary [of "closure S" x]
 by (metis assms convex_closure convex_rel_interior_closure)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open> Some results on decomposing convex hulls: intersections, simplicial subdivision\<close>
 
 lemma
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent(s \<union> t)"
     shows convex_hull_Int_subset: "convex hull s \<inter> convex hull t \<subseteq> convex hull (s \<inter> t)" (is ?C)
       and affine_hull_Int_subset: "affine hull s \<inter> affine hull t \<subseteq> affine hull (s \<inter> t)" (is ?A)
 proof -
   have [simp]: "finite s" "finite t"
     using aff_independent_finite assms by blast+
     have "sum u (s \<inter> t) = 1 \<and>
           (\<Sum>v\<in>s \<inter> t. u v *\<^sub>R v) = (\<Sum>v\<in>s. u v *\<^sub>R v)"
       if [simp]:  "sum u s = 1"
                  "sum v t = 1"
          and eq: "(\<Sum>x\<in>t. v x *\<^sub>R x) = (\<Sum>x\<in>s. u x *\<^sub>R x)" for u v
     proof -
     define f where "f x = (if x \<in> s then u x else 0) - (if x \<in> t then v x else 0)" for x
     have "sum f (s \<union> t) = 0"
       apply (simp add: f_def sum_Un sum_subtractf)
       apply (simp add: sum.inter_restrict [symmetric] Int_commute)
       done
     moreover have "(\<Sum>x\<in>(s \<union> t). f x *\<^sub>R x) = 0"
       apply (simp add: f_def sum_Un scaleR_left_diff_distrib sum_subtractf)
       apply (simp add: if_smult sum.inter_restrict [symmetric] Int_commute eq
           cong del: if_weak_cong)
       done
     ultimately have "\<And>v. v \<in> s \<union> t \<Longrightarrow> f v = 0"
       using aff_independent_finite assms unfolding affine_dependent_explicit
       by blast
     then have u [simp]: "\<And>x. x \<in> s \<Longrightarrow> u x = (if x \<in> t then v x else 0)"
       by (simp add: f_def) presburger
     have "sum u (s \<inter> t) = sum u s"
       by (simp add: sum.inter_restrict)
     then have "sum u (s \<inter> t) = 1"
       using that by linarith
     moreover have "(\<Sum>v\<in>s \<inter> t. u v *\<^sub>R v) = (\<Sum>v\<in>s. u v *\<^sub>R v)"
       by (auto simp: if_smult sum.inter_restrict intro: sum.cong)
     ultimately show ?thesis
       by force
     qed
     then show ?A ?C
       by (auto simp: convex_hull_finite affine_hull_finite)
 qed
 
 
 proposition\<^marker>\<open>tag unimportant\<close> affine_hull_Int:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent(s \<union> t)"
     shows "affine hull (s \<inter> t) = affine hull s \<inter> affine hull t"
 apply (rule subset_antisym)
 apply (simp add: hull_mono)
 by (simp add: affine_hull_Int_subset assms)
 
 proposition\<^marker>\<open>tag unimportant\<close> convex_hull_Int:
   fixes s :: "'a::euclidean_space set"
   assumes "\<not> affine_dependent(s \<union> t)"
     shows "convex hull (s \<inter> t) = convex hull s \<inter> convex hull t"
 apply (rule subset_antisym)
 apply (simp add: hull_mono)
 by (simp add: convex_hull_Int_subset assms)
 
 proposition\<^marker>\<open>tag unimportant\<close>
   fixes s :: "'a::euclidean_space set set"
   assumes "\<not> affine_dependent (\<Union>s)"
     shows affine_hull_Inter: "affine hull (\<Inter>s) = (\<Inter>t\<in>s. affine hull t)" (is "?A")
       and convex_hull_Inter: "convex hull (\<Inter>s) = (\<Inter>t\<in>s. convex hull t)" (is "?C")
 proof -
   have "finite s"
     using aff_independent_finite assms finite_UnionD by blast
   then have "?A \<and> ?C" using assms
   proof (induction s rule: finite_induct)
     case empty then show ?case by auto
   next
     case (insert t F)
     then show ?case
     proof (cases "F={}")
       case True then show ?thesis by simp
     next
       case False
       with "insert.prems" have [simp]: "\<not> affine_dependent (t \<union> \<Inter>F)"
         by (auto intro: affine_dependent_subset)
       have [simp]: "\<not> affine_dependent (\<Union>F)"
         using affine_independent_subset insert.prems by fastforce
       show ?thesis
         by (simp add: affine_hull_Int convex_hull_Int insert.IH)
     qed
   qed
   then show "?A" "?C"
     by auto
 qed
 
 proposition\<^marker>\<open>tag unimportant\<close> in_convex_hull_exchange_unique:
   fixes S :: "'a::euclidean_space set"
   assumes naff: "\<not> affine_dependent S" and a: "a \<in> convex hull S"
       and S: "T \<subseteq> S" "T' \<subseteq> S"
       and x:  "x \<in> convex hull (insert a T)"
       and x': "x \<in> convex hull (insert a T')"
     shows "x \<in> convex hull (insert a (T \<inter> T'))"
 proof (cases "a \<in> S")
   case True
   then have "\<not> affine_dependent (insert a T \<union> insert a T')"
     using affine_dependent_subset assms by auto
   then have "x \<in> convex hull (insert a T \<inter> insert a T')"
     by (metis IntI convex_hull_Int x x')
   then show ?thesis
     by simp
 next
   case False
   then have anot: "a \<notin> T" "a \<notin> T'"
     using assms by auto
   have [simp]: "finite S"
     by (simp add: aff_independent_finite assms)
   then obtain b where b0: "\<And>s. s \<in> S \<Longrightarrow> 0 \<le> b s"
                   and b1: "sum b S = 1" and aeq: "a = (\<Sum>s\<in>S. b s *\<^sub>R s)"
     using a by (auto simp: convex_hull_finite)
   have fin [simp]: "finite T" "finite T'"
     using assms infinite_super \<open>finite S\<close> by blast+
   then obtain c c' where c0: "\<And>t. t \<in> insert a T \<Longrightarrow> 0 \<le> c t"
                      and c1: "sum c (insert a T) = 1"
                      and xeq: "x = (\<Sum>t \<in> insert a T. c t *\<^sub>R t)"
                      and c'0: "\<And>t. t \<in> insert a T' \<Longrightarrow> 0 \<le> c' t"
                      and c'1: "sum c' (insert a T') = 1"
                      and x'eq: "x = (\<Sum>t \<in> insert a T'. c' t *\<^sub>R t)"
     using x x' by (auto simp: convex_hull_finite)
   with fin anot
   have sumTT': "sum c T = 1 - c a" "sum c' T' = 1 - c' a"
    and wsumT: "(\<Sum>t \<in> T. c t *\<^sub>R t) = x - c a *\<^sub>R a"
     by simp_all
   have wsumT': "(\<Sum>t \<in> T'. c' t *\<^sub>R t) = x - c' a *\<^sub>R a"
     using x'eq fin anot by simp
   define cc  where "cc \<equiv> \<lambda>x. if x \<in> T then c x else 0"
   define cc' where "cc' \<equiv> \<lambda>x. if x \<in> T' then c' x else 0"
   define dd  where "dd \<equiv> \<lambda>x. cc x - cc' x + (c a - c' a) * b x"
   have sumSS': "sum cc S = 1 - c a" "sum cc' S = 1 - c' a"
     unfolding cc_def cc'_def  using S
     by (simp_all add: Int_absorb1 Int_absorb2 sum_subtractf sum.inter_restrict [symmetric] sumTT')
   have wsumSS: "(\<Sum>t \<in> S. cc t *\<^sub>R t) = x - c a *\<^sub>R a" "(\<Sum>t \<in> S. cc' t *\<^sub>R t) = x - c' a *\<^sub>R a"
     unfolding cc_def cc'_def  using S
     by (simp_all add: Int_absorb1 Int_absorb2 if_smult sum.inter_restrict [symmetric] wsumT wsumT' cong: if_cong)
   have sum_dd0: "sum dd S = 0"
     unfolding dd_def  using S
     by (simp add: sumSS' comm_monoid_add_class.sum.distrib sum_subtractf
                   algebra_simps sum_distrib_right [symmetric] b1)
   have "(\<Sum>v\<in>S. (b v * x) *\<^sub>R v) = x *\<^sub>R (\<Sum>v\<in>S. b v *\<^sub>R v)" for x
     by (simp add: pth_5 real_vector.scale_sum_right mult.commute)
   then have *: "(\<Sum>v\<in>S. (b v * x) *\<^sub>R v) = x *\<^sub>R a" for x
     using aeq by blast
   have "(\<Sum>v \<in> S. dd v *\<^sub>R v) = 0"
     unfolding dd_def using S
     by (simp add: * wsumSS sum.distrib sum_subtractf algebra_simps)
   then have dd0: "dd v = 0" if "v \<in> S" for v
     using naff that \<open>finite S\<close> sum_dd0 unfolding affine_dependent_explicit
     apply (simp only: not_ex)
     apply (drule_tac x=S in spec)
     apply (drule_tac x=dd in spec, simp)
     done
   consider "c' a \<le> c a" | "c a \<le> c' a" by linarith
   then show ?thesis
   proof cases
     case 1
     then have "sum cc S \<le> sum cc' S"
       by (simp add: sumSS')
     then have le: "cc x \<le> cc' x" if "x \<in> S" for x
       using dd0 [OF that] 1 b0 mult_left_mono that
       by (fastforce simp add: dd_def algebra_simps)
     have cc0: "cc x = 0" if "x \<in> S" "x \<notin> T \<inter> T'" for x
       using le [OF \<open>x \<in> S\<close>] that c0
       by (force simp: cc_def cc'_def split: if_split_asm)
     show ?thesis
     proof (simp add: convex_hull_finite, intro exI conjI)
       show "\<forall>x\<in>T \<inter> T'. 0 \<le> (cc(a := c a)) x"
         by (simp add: c0 cc_def)
       show "0 \<le> (cc(a := c a)) a"
         by (simp add: c0)
       have "sum (cc(a := c a)) (insert a (T \<inter> T')) = c a + sum (cc(a := c a)) (T \<inter> T')"
         by (simp add: anot)
       also have "... = c a + sum (cc(a := c a)) S"
         apply simp
         apply (rule sum.mono_neutral_left)
         using \<open>T \<subseteq> S\<close> apply (auto simp: \<open>a \<notin> S\<close> cc0)
         done
       also have "... = c a + (1 - c a)"
         by (metis \<open>a \<notin> S\<close> fun_upd_other sum.cong sumSS')
       finally show "sum (cc(a := c a)) (insert a (T \<inter> T')) = 1"
         by simp
       have "(\<Sum>x\<in>insert a (T \<inter> T'). (cc(a := c a)) x *\<^sub>R x) = c a *\<^sub>R a + (\<Sum>x \<in> T \<inter> T'. (cc(a := c a)) x *\<^sub>R x)"
         by (simp add: anot)
       also have "... = c a *\<^sub>R a + (\<Sum>x \<in> S. (cc(a := c a)) x *\<^sub>R x)"
         apply simp
         apply (rule sum.mono_neutral_left)
         using \<open>T \<subseteq> S\<close> apply (auto simp: \<open>a \<notin> S\<close> cc0)
         done
       also have "... = c a *\<^sub>R a + x - c a *\<^sub>R a"
         by (simp add: wsumSS \<open>a \<notin> S\<close> if_smult sum_delta_notmem)
       finally show "(\<Sum>x\<in>insert a (T \<inter> T'). (cc(a := c a)) x *\<^sub>R x) = x"
         by simp
     qed
   next
     case 2
     then have "sum cc' S \<le> sum cc S"
       by (simp add: sumSS')
     then have le: "cc' x \<le> cc x" if "x \<in> S" for x
       using dd0 [OF that] 2 b0 mult_left_mono that
       by (fastforce simp add: dd_def algebra_simps)
     have cc0: "cc' x = 0" if "x \<in> S" "x \<notin> T \<inter> T'" for x
       using le [OF \<open>x \<in> S\<close>] that c'0
       by (force simp: cc_def cc'_def split: if_split_asm)
     show ?thesis
     proof (simp add: convex_hull_finite, intro exI conjI)
       show "\<forall>x\<in>T \<inter> T'. 0 \<le> (cc'(a := c' a)) x"
         by (simp add: c'0 cc'_def)
       show "0 \<le> (cc'(a := c' a)) a"
         by (simp add: c'0)
       have "sum (cc'(a := c' a)) (insert a (T \<inter> T')) = c' a + sum (cc'(a := c' a)) (T \<inter> T')"
         by (simp add: anot)
       also have "... = c' a + sum (cc'(a := c' a)) S"
         apply simp
         apply (rule sum.mono_neutral_left)
         using \<open>T \<subseteq> S\<close> apply (auto simp: \<open>a \<notin> S\<close> cc0)
         done
       also have "... = c' a + (1 - c' a)"
         by (metis \<open>a \<notin> S\<close> fun_upd_other sum.cong sumSS')
       finally show "sum (cc'(a := c' a)) (insert a (T \<inter> T')) = 1"
         by simp
       have "(\<Sum>x\<in>insert a (T \<inter> T'). (cc'(a := c' a)) x *\<^sub>R x) = c' a *\<^sub>R a + (\<Sum>x \<in> T \<inter> T'. (cc'(a := c' a)) x *\<^sub>R x)"
         by (simp add: anot)
       also have "... = c' a *\<^sub>R a + (\<Sum>x \<in> S. (cc'(a := c' a)) x *\<^sub>R x)"
         apply simp
         apply (rule sum.mono_neutral_left)
         using \<open>T \<subseteq> S\<close> apply (auto simp: \<open>a \<notin> S\<close> cc0)
         done
       also have "... = c a *\<^sub>R a + x - c a *\<^sub>R a"
         by (simp add: wsumSS \<open>a \<notin> S\<close> if_smult sum_delta_notmem)
       finally show "(\<Sum>x\<in>insert a (T \<inter> T'). (cc'(a := c' a)) x *\<^sub>R x) = x"
         by simp
     qed
   qed
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> convex_hull_exchange_Int:
   fixes a  :: "'a::euclidean_space"
   assumes "\<not> affine_dependent S" "a \<in> convex hull S" "T \<subseteq> S" "T' \<subseteq> S"
   shows "(convex hull (insert a T)) \<inter> (convex hull (insert a T')) =
          convex hull (insert a (T \<inter> T'))"
 apply (rule subset_antisym)
   using in_convex_hull_exchange_unique assms apply blast
   by (metis hull_mono inf_le1 inf_le2 insert_inter_insert le_inf_iff)
 
 lemma Int_closed_segment:
   fixes b :: "'a::euclidean_space"
   assumes "b \<in> closed_segment a c \<or> \<not> collinear{a,b,c}"
     shows "closed_segment a b \<inter> closed_segment b c = {b}"
 proof (cases "c = a")
   case True
   then show ?thesis
     using assms collinear_3_eq_affine_dependent by fastforce
 next
   case False
   from assms show ?thesis
   proof
     assume "b \<in> closed_segment a c"
     moreover have "\<not> affine_dependent {a, c}"
       by (simp add: affine_independent_2)
     ultimately show ?thesis
       using False convex_hull_exchange_Int [of "{a,c}" b "{a}" "{c}"]
       by (simp add: segment_convex_hull insert_commute)
   next
     assume ncoll: "\<not> collinear {a, b, c}"
     have False if "closed_segment a b \<inter> closed_segment b c \<noteq> {b}"
     proof -
       have "b \<in> closed_segment a b" and "b \<in> closed_segment b c"
         by auto
       with that obtain d where "b \<noteq> d" "d \<in> closed_segment a b" "d \<in> closed_segment b c"
         by force
       then have d: "collinear {a, d, b}"  "collinear {b, d, c}"
         by (auto simp:  between_mem_segment between_imp_collinear)
       have "collinear {a, b, c}"
         apply (rule collinear_3_trans [OF _ _ \<open>b \<noteq> d\<close>])
         using d  by (auto simp: insert_commute)
       with ncoll show False ..
     qed
     then show ?thesis
       by blast
   qed
 qed
 
 lemma affine_hull_finite_intersection_hyperplanes:
   fixes s :: "'a::euclidean_space set"
   obtains f where
      "finite f"
      "of_nat (card f) + aff_dim s = DIM('a)"
      "affine hull s = \<Inter>f"
      "\<And>h. h \<in> f \<Longrightarrow> \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x = b}"
 proof -
   obtain b where "b \<subseteq> s"
              and indb: "\<not> affine_dependent b"
              and eq: "affine hull s = affine hull b"
     using affine_basis_exists by blast
   obtain c where indc: "\<not> affine_dependent c" and "b \<subseteq> c"
              and affc: "affine hull c = UNIV"
     by (metis extend_to_affine_basis affine_UNIV hull_same indb subset_UNIV)
   then have "finite c"
     by (simp add: aff_independent_finite)
   then have fbc: "finite b" "card b \<le> card c"
     using \<open>b \<subseteq> c\<close> infinite_super by (auto simp: card_mono)
   have imeq: "(\<lambda>x. affine hull x) ` ((\<lambda>a. c - {a}) ` (c - b)) = ((\<lambda>a. affine hull (c - {a})) ` (c - b))"
     by blast
   have card1: "card ((\<lambda>a. affine hull (c - {a})) ` (c - b)) = card (c - b)"
     apply (rule card_image [OF inj_onI])
     by (metis Diff_eq_empty_iff Diff_iff indc affine_dependent_def hull_subset insert_iff)
   have card2: "(card (c - b)) + aff_dim s = DIM('a)"
   proof -
     have aff: "aff_dim (UNIV::'a set) = aff_dim c"
       by (metis aff_dim_affine_hull affc)
     have "aff_dim b = aff_dim s"
       by (metis (no_types) aff_dim_affine_hull eq)
     then have "int (card b) = 1 + aff_dim s"
       by (simp add: aff_dim_affine_independent indb)
     then show ?thesis
       using fbc aff
       by (simp add: \<open>\<not> affine_dependent c\<close> \<open>b \<subseteq> c\<close> aff_dim_affine_independent aff_dim_UNIV card_Diff_subset of_nat_diff)
   qed
   show ?thesis
   proof (cases "c = b")
     case True show ?thesis
       apply (rule_tac f="{}" in that)
       using True affc
       apply (simp_all add: eq [symmetric])
       by (metis aff_dim_UNIV aff_dim_affine_hull)
   next
     case False
     have ind: "\<not> affine_dependent (\<Union>a\<in>c - b. c - {a})"
       by (rule affine_independent_subset [OF indc]) auto
     have affeq: "affine hull s = (\<Inter>x\<in>(\<lambda>a. c - {a}) ` (c - b). affine hull x)"
       using \<open>b \<subseteq> c\<close> False
       apply (subst affine_hull_Inter [OF ind, symmetric])
       apply (simp add: eq double_diff)
       done
     have *: "1 + aff_dim (c - {t}) = int (DIM('a))"
             if t: "t \<in> c" for t
     proof -
       have "insert t c = c"
         using t by blast
       then show ?thesis
         by (metis (full_types) add.commute aff_dim_affine_hull aff_dim_insert aff_dim_UNIV affc affine_dependent_def indc insert_Diff_single t)
     qed
     show ?thesis
       apply (rule_tac f = "(\<lambda>x. affine hull x) ` ((\<lambda>a. c - {a}) ` (c - b))" in that)
          using \<open>finite c\<close> apply blast
         apply (simp add: imeq card1 card2)
       apply (simp add: affeq, clarify)
       apply (metis DIM_positive One_nat_def Suc_leI add_diff_cancel_left' of_nat_1 aff_dim_eq_hyperplane of_nat_diff *)
       done
   qed
 qed
 
 lemma affine_hyperplane_sums_eq_UNIV_0:
   fixes S :: "'a :: euclidean_space set"
   assumes "affine S"
      and "0 \<in> S" and "w \<in> S"
      and "a \<bullet> w \<noteq> 0"
    shows "{x + y| x y. x \<in> S \<and> a \<bullet> y = 0} = UNIV"
 proof -
   have "subspace S"
     by (simp add: assms subspace_affine)
   have span1: "span {y. a \<bullet> y = 0} \<subseteq> span {x + y |x y. x \<in> S \<and> a \<bullet> y = 0}"
     apply (rule span_mono)
     using \<open>0 \<in> S\<close> add.left_neutral by force
   have "w \<notin> span {y. a \<bullet> y = 0}"
     using \<open>a \<bullet> w \<noteq> 0\<close> span_induct subspace_hyperplane by auto
   moreover have "w \<in> span {x + y |x y. x \<in> S \<and> a \<bullet> y = 0}"
     using \<open>w \<in> S\<close>
     by (metis (mono_tags, lifting) inner_zero_right mem_Collect_eq pth_d span_base)
   ultimately have span2: "span {y. a \<bullet> y = 0} \<noteq> span {x + y |x y. x \<in> S \<and> a \<bullet> y = 0}"
     by blast
   have "a \<noteq> 0" using assms inner_zero_left by blast
   then have "DIM('a) - 1 = dim {y. a \<bullet> y = 0}"
     by (simp add: dim_hyperplane)
   also have "... < dim {x + y |x y. x \<in> S \<and> a \<bullet> y = 0}"
     using span1 span2 by (blast intro: dim_psubset)
   finally have DIM_lt: "DIM('a) - 1 < dim {x + y |x y. x \<in> S \<and> a \<bullet> y = 0}" .
   have subs: "subspace {x + y| x y. x \<in> S \<and> a \<bullet> y = 0}"
     using subspace_sums [OF \<open>subspace S\<close> subspace_hyperplane] by simp
   moreover have "span {x + y| x y. x \<in> S \<and> a \<bullet> y = 0} = UNIV"
     apply (rule dim_eq_full [THEN iffD1])
     apply (rule antisym [OF dim_subset_UNIV])
     using DIM_lt apply simp
     done
   ultimately show ?thesis
     by (simp add: subs) (metis (lifting) span_eq_iff subs)
 qed
 
 proposition\<^marker>\<open>tag unimportant\<close> affine_hyperplane_sums_eq_UNIV:
   fixes S :: "'a :: euclidean_space set"
   assumes "affine S"
       and "S \<inter> {v. a \<bullet> v = b} \<noteq> {}"
       and "S - {v. a \<bullet> v = b} \<noteq> {}"
     shows "{x + y| x y. x \<in> S \<and> a \<bullet> y = b} = UNIV"
 proof (cases "a = 0")
   case True with assms show ?thesis
     by (auto simp: if_splits)
 next
   case False
   obtain c where "c \<in> S" and c: "a \<bullet> c = b"
     using assms by force
   with affine_diffs_subspace [OF \<open>affine S\<close>]
   have "subspace ((+) (- c) ` S)" by blast
   then have aff: "affine ((+) (- c) ` S)"
     by (simp add: subspace_imp_affine)
   have 0: "0 \<in> (+) (- c) ` S"
     by (simp add: \<open>c \<in> S\<close>)
   obtain d where "d \<in> S" and "a \<bullet> d \<noteq> b" and dc: "d-c \<in> (+) (- c) ` S"
     using assms by auto
   then have adc: "a \<bullet> (d - c) \<noteq> 0"
     by (simp add: c inner_diff_right)
   let ?U = "(+) (c+c) ` {x + y |x y. x \<in> (+) (- c) ` S \<and> a \<bullet> y = 0}"
   have "u + v \<in> (+) (c + c) ` {x + v |x v. x \<in> (+) (- c) ` S \<and> a \<bullet> v = 0}"
               if "u \<in> S" "b = a \<bullet> v" for u v
     apply (rule_tac x="u+v-c-c" in image_eqI)
     apply (simp_all add: algebra_simps)
     apply (rule_tac x="u-c" in exI)
     apply (rule_tac x="v-c" in exI)
     apply (simp add: algebra_simps that c)
     done
   moreover have "\<lbrakk>a \<bullet> v = 0; u \<in> S\<rbrakk>
        \<Longrightarrow> \<exists>x ya. v + (u + c) = x + ya \<and> x \<in> S \<and> a \<bullet> ya = b" for v u
     by (metis add.left_commute c inner_right_distrib pth_d)
   ultimately have "{x + y |x y. x \<in> S \<and> a \<bullet> y = b} = ?U"
     by (fastforce simp: algebra_simps)
   also have "... = range ((+) (c + c))"
     by (simp only: affine_hyperplane_sums_eq_UNIV_0 [OF aff 0 dc adc])
   also have "... = UNIV"
     by simp
   finally show ?thesis .
 qed
 
 lemma aff_dim_sums_Int_0:
   assumes "affine S"
       and "affine T"
       and "0 \<in> S" "0 \<in> T"
     shows "aff_dim {x + y| x y. x \<in> S \<and> y \<in> T} = (aff_dim S + aff_dim T) - aff_dim(S \<inter> T)"
 proof -
   have "0 \<in> {x + y |x y. x \<in> S \<and> y \<in> T}"
     using assms by force
   then have 0: "0 \<in> affine hull {x + y |x y. x \<in> S \<and> y \<in> T}"
     by (metis (lifting) hull_inc)
   have sub: "subspace S"  "subspace T"
     using assms by (auto simp: subspace_affine)
   show ?thesis
     using dim_sums_Int [OF sub] by (simp add: aff_dim_zero assms 0 hull_inc)
 qed
 
 proposition aff_dim_sums_Int:
   assumes "affine S"
       and "affine T"
       and "S \<inter> T \<noteq> {}"
     shows "aff_dim {x + y| x y. x \<in> S \<and> y \<in> T} = (aff_dim S + aff_dim T) - aff_dim(S \<inter> T)"
 proof -
   obtain a where a: "a \<in> S" "a \<in> T" using assms by force
   have aff: "affine ((+) (-a) ` S)"  "affine ((+) (-a) ` T)"
     using affine_translation [symmetric, of "- a"] assms by (simp_all cong: image_cong_simp)
   have zero: "0 \<in> ((+) (-a) ` S)"  "0 \<in> ((+) (-a) ` T)"
     using a assms by auto
   have "{x + y |x y. x \<in> (+) (- a) ` S \<and> y \<in> (+) (- a) ` T} =
       (+) (- 2 *\<^sub>R a) ` {x + y| x y. x \<in> S \<and> y \<in> T}"
     by (force simp: algebra_simps scaleR_2)
   moreover have "(+) (- a) ` S \<inter> (+) (- a) ` T = (+) (- a) ` (S \<inter> T)"
     by auto
   ultimately show ?thesis
     using aff_dim_sums_Int_0 [OF aff zero] aff_dim_translation_eq
     by (metis (lifting))
 qed
 
 lemma aff_dim_affine_Int_hyperplane:
   fixes a :: "'a::euclidean_space"
   assumes "affine S"
     shows "aff_dim(S \<inter> {x. a \<bullet> x = b}) =
              (if S \<inter> {v. a \<bullet> v = b} = {} then - 1
               else if S \<subseteq> {v. a \<bullet> v = b} then aff_dim S
               else aff_dim S - 1)"
 proof (cases "a = 0")
   case True with assms show ?thesis
     by auto
 next
   case False
   then have "aff_dim (S \<inter> {x. a \<bullet> x = b}) = aff_dim S - 1"
             if "x \<in> S" "a \<bullet> x \<noteq> b" and non: "S \<inter> {v. a \<bullet> v = b} \<noteq> {}" for x
   proof -
     have [simp]: "{x + y| x y. x \<in> S \<and> a \<bullet> y = b} = UNIV"
       using affine_hyperplane_sums_eq_UNIV [OF assms non] that  by blast
     show ?thesis
       using aff_dim_sums_Int [OF assms affine_hyperplane non]
       by (simp add: of_nat_diff False)
   qed
   then show ?thesis
     by (metis (mono_tags, lifting) inf.orderE aff_dim_empty_eq mem_Collect_eq subsetI)
 qed
 
 lemma aff_dim_lt_full:
   fixes S :: "'a::euclidean_space set"
   shows "aff_dim S < DIM('a) \<longleftrightarrow> (affine hull S \<noteq> UNIV)"
 by (metis (no_types) aff_dim_affine_hull aff_dim_le_DIM aff_dim_UNIV affine_hull_UNIV less_le)
 
 lemma aff_dim_openin:
   fixes S :: "'a::euclidean_space set"
   assumes ope: "openin (top_of_set T) S" and "affine T" "S \<noteq> {}"
   shows "aff_dim S = aff_dim T"
 proof -
   show ?thesis
   proof (rule order_antisym)
     show "aff_dim S \<le> aff_dim T"
       by (blast intro: aff_dim_subset [OF openin_imp_subset] ope)
   next
     obtain a where "a \<in> S"
       using \<open>S \<noteq> {}\<close> by blast
     have "S \<subseteq> T"
       using ope openin_imp_subset by auto
     then have "a \<in> T"
       using \<open>a \<in> S\<close> by auto
     then have subT': "subspace ((\<lambda>x. - a + x) ` T)"
       using affine_diffs_subspace \<open>affine T\<close> by auto
     then obtain B where Bsub: "B \<subseteq> ((\<lambda>x. - a + x) ` T)" and po: "pairwise orthogonal B"
                     and eq1: "\<And>x. x \<in> B \<Longrightarrow> norm x = 1" and "independent B"
                     and cardB: "card B = dim ((\<lambda>x. - a + x) ` T)"
                     and spanB: "span B = ((\<lambda>x. - a + x) ` T)"
       by (rule orthonormal_basis_subspace) auto
     obtain e where "0 < e" and e: "cball a e \<inter> T \<subseteq> S"
       by (meson \<open>a \<in> S\<close> openin_contains_cball ope)
     have "aff_dim T = aff_dim ((\<lambda>x. - a + x) ` T)"
       by (metis aff_dim_translation_eq)
     also have "... = dim ((\<lambda>x. - a + x) ` T)"
       using aff_dim_subspace subT' by blast
     also have "... = card B"
       by (simp add: cardB)
     also have "... = card ((\<lambda>x. e *\<^sub>R x) ` B)"
       using \<open>0 < e\<close>  by (force simp: inj_on_def card_image)
     also have "... \<le> dim ((\<lambda>x. - a + x) ` S)"
     proof (simp, rule independent_card_le_dim)
       have e': "cball 0 e \<inter> (\<lambda>x. x - a) ` T \<subseteq> (\<lambda>x. x - a) ` S"
         using e by (auto simp: dist_norm norm_minus_commute subset_eq)
       have "(\<lambda>x. e *\<^sub>R x) ` B \<subseteq> cball 0 e \<inter> (\<lambda>x. x - a) ` T"
         using Bsub \<open>0 < e\<close> eq1 subT' \<open>a \<in> T\<close> by (auto simp: subspace_def)
       then show "(\<lambda>x. e *\<^sub>R x) ` B \<subseteq> (\<lambda>x. x - a) ` S"
         using e' by blast
       show "independent ((\<lambda>x. e *\<^sub>R x) ` B)"
         using linear_scale_self \<open>independent B\<close>
         apply (rule linear_independent_injective_image)
         using \<open>0 < e\<close> inj_on_def by fastforce
     qed
     also have "... = aff_dim S"
       using \<open>a \<in> S\<close> aff_dim_eq_dim hull_inc by (force cong: image_cong_simp)
     finally show "aff_dim T \<le> aff_dim S" .
   qed
 qed
 
 lemma dim_openin:
   fixes S :: "'a::euclidean_space set"
   assumes ope: "openin (top_of_set T) S" and "subspace T" "S \<noteq> {}"
   shows "dim S = dim T"
 proof (rule order_antisym)
   show "dim S \<le> dim T"
     by (metis ope dim_subset openin_subset topspace_euclidean_subtopology)
 next
   have "dim T = aff_dim S"
     using aff_dim_openin
     by (metis aff_dim_subspace \<open>subspace T\<close> \<open>S \<noteq> {}\<close> ope subspace_affine)
   also have "... \<le> dim S"
     by (metis aff_dim_subset aff_dim_subspace dim_span span_superset
         subspace_span)
   finally show "dim T \<le> dim S" by simp
 qed
 
 subsection\<open>Lower-dimensional affine subsets are nowhere dense\<close>
 
 proposition dense_complement_subspace:
   fixes S :: "'a :: euclidean_space set"
   assumes dim_less: "dim T < dim S" and "subspace S" shows "closure(S - T) = S"
 proof -
   have "closure(S - U) = S" if "dim U < dim S" "U \<subseteq> S" for U
   proof -
     have "span U \<subset> span S"
       by (metis neq_iff psubsetI span_eq_dim span_mono that)
     then obtain a where "a \<noteq> 0" "a \<in> span S" and a: "\<And>y. y \<in> span U \<Longrightarrow> orthogonal a y"
       using orthogonal_to_subspace_exists_gen by metis
     show ?thesis
     proof
       have "closed S"
         by (simp add: \<open>subspace S\<close> closed_subspace)
       then show "closure (S - U) \<subseteq> S"
         by (simp add: closure_minimal)
       show "S \<subseteq> closure (S - U)"
       proof (clarsimp simp: closure_approachable)
         fix x and e::real
         assume "x \<in> S" "0 < e"
         show "\<exists>y\<in>S - U. dist y x < e"
         proof (cases "x \<in> U")
           case True
           let ?y = "x + (e/2 / norm a) *\<^sub>R a"
           show ?thesis
           proof
             show "dist ?y x < e"
               using \<open>0 < e\<close> by (simp add: dist_norm)
           next
             have "?y \<in> S"
               by (metis \<open>a \<in> span S\<close> \<open>x \<in> S\<close> assms(2) span_eq_iff subspace_add subspace_scale)
             moreover have "?y \<notin> U"
             proof -
               have "e/2 / norm a \<noteq> 0"
                 using \<open>0 < e\<close> \<open>a \<noteq> 0\<close> by auto
               then show ?thesis
                 by (metis True \<open>a \<noteq> 0\<close> a orthogonal_scaleR orthogonal_self real_vector.scale_eq_0_iff span_add_eq span_base)
             qed
             ultimately show "?y \<in> S - U" by blast
           qed
         next
           case False
           with \<open>0 < e\<close> \<open>x \<in> S\<close> show ?thesis by force
         qed
       qed
     qed
   qed
   moreover have "S - S \<inter> T = S-T"
     by blast
   moreover have "dim (S \<inter> T) < dim S"
     by (metis dim_less dim_subset inf.cobounded2 inf.orderE inf.strict_boundedE not_le)
   ultimately show ?thesis
     by force
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> dense_complement_affine:
   fixes S :: "'a :: euclidean_space set"
   assumes less: "aff_dim T < aff_dim S" and "affine S" shows "closure(S - T) = S"
 proof (cases "S \<inter> T = {}")
   case True
   then show ?thesis
     by (metis Diff_triv affine_hull_eq \<open>affine S\<close> closure_same_affine_hull closure_subset hull_subset subset_antisym)
 next
   case False
   then obtain z where z: "z \<in> S \<inter> T" by blast
   then have "subspace ((+) (- z) ` S)"
     by (meson IntD1 affine_diffs_subspace \<open>affine S\<close>)
   moreover have "int (dim ((+) (- z) ` T)) < int (dim ((+) (- z) ` S))"
 thm aff_dim_eq_dim
     using z less by (simp add: aff_dim_eq_dim_subtract [of z] hull_inc cong: image_cong_simp)
   ultimately have "closure(((+) (- z) ` S) - ((+) (- z) ` T)) = ((+) (- z) ` S)"
     by (simp add: dense_complement_subspace)
   then show ?thesis
     by (metis closure_translation translation_diff translation_invert)
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> dense_complement_openin_affine_hull:
   fixes S :: "'a :: euclidean_space set"
   assumes less: "aff_dim T < aff_dim S"
       and ope: "openin (top_of_set (affine hull S)) S"
     shows "closure(S - T) = closure S"
 proof -
   have "affine hull S - T \<subseteq> affine hull S"
     by blast
   then have "closure (S \<inter> closure (affine hull S - T)) = closure (S \<inter> (affine hull S - T))"
     by (rule closure_openin_Int_closure [OF ope])
   then show ?thesis
     by (metis Int_Diff aff_dim_affine_hull affine_affine_hull dense_complement_affine hull_subset inf.orderE less)
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> dense_complement_convex:
   fixes S :: "'a :: euclidean_space set"
   assumes "aff_dim T < aff_dim S" "convex S"
     shows "closure(S - T) = closure S"
 proof
   show "closure (S - T) \<subseteq> closure S"
     by (simp add: closure_mono)
   have "closure (rel_interior S - T) = closure (rel_interior S)"
     apply (rule dense_complement_openin_affine_hull)
     apply (simp add: assms rel_interior_aff_dim)
     using \<open>convex S\<close> rel_interior_rel_open rel_open by blast
   then show "closure S \<subseteq> closure (S - T)"
     by (metis Diff_mono \<open>convex S\<close> closure_mono convex_closure_rel_interior order_refl rel_interior_subset)
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> dense_complement_convex_closed:
   fixes S :: "'a :: euclidean_space set"
   assumes "aff_dim T < aff_dim S" "convex S" "closed S"
     shows "closure(S - T) = S"
   by (simp add: assms dense_complement_convex)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Parallel slices, etc\<close>
 
 text\<open> If we take a slice out of a set, we can do it perpendicularly,
   with the normal vector to the slice parallel to the affine hull.\<close>
 
 proposition\<^marker>\<open>tag unimportant\<close> affine_parallel_slice:
   fixes S :: "'a :: euclidean_space set"
   assumes "affine S"
       and "S \<inter> {x. a \<bullet> x \<le> b} \<noteq> {}"
       and "\<not> (S \<subseteq> {x. a \<bullet> x \<le> b})"
   obtains a' b' where "a' \<noteq> 0"
                    "S \<inter> {x. a' \<bullet> x \<le> b'} = S \<inter> {x. a \<bullet> x \<le> b}"
                    "S \<inter> {x. a' \<bullet> x = b'} = S \<inter> {x. a \<bullet> x = b}"
                    "\<And>w. w \<in> S \<Longrightarrow> (w + a') \<in> S"
 proof (cases "S \<inter> {x. a \<bullet> x = b} = {}")
   case True
   then obtain u v where "u \<in> S" "v \<in> S" "a \<bullet> u \<le> b" "a \<bullet> v > b"
     using assms by (auto simp: not_le)
   define \<eta> where "\<eta> = u + ((b - a \<bullet> u) / (a \<bullet> v - a \<bullet> u)) *\<^sub>R (v - u)"
   have "\<eta> \<in> S"
     by (simp add: \<eta>_def \<open>u \<in> S\<close> \<open>v \<in> S\<close> \<open>affine S\<close> mem_affine_3_minus)
   moreover have "a \<bullet> \<eta> = b"
     using \<open>a \<bullet> u \<le> b\<close> \<open>b < a \<bullet> v\<close>
     by (simp add: \<eta>_def algebra_simps) (simp add: field_simps)
   ultimately have False
     using True by force
   then show ?thesis ..
 next
   case False
   then obtain z where "z \<in> S" and z: "a \<bullet> z = b"
     using assms by auto
   with affine_diffs_subspace [OF \<open>affine S\<close>]
   have sub: "subspace ((+) (- z) ` S)" by blast
   then have aff: "affine ((+) (- z) ` S)" and span: "span ((+) (- z) ` S) = ((+) (- z) ` S)"
     by (auto simp: subspace_imp_affine)
   obtain a' a'' where a': "a' \<in> span ((+) (- z) ` S)" and a: "a = a' + a''"
                   and "\<And>w. w \<in> span ((+) (- z) ` S) \<Longrightarrow> orthogonal a'' w"
     using orthogonal_subspace_decomp_exists [of "(+) (- z) ` S" "a"] by metis
   then have "\<And>w. w \<in> S \<Longrightarrow> a'' \<bullet> (w-z) = 0"
     by (simp add: span_base orthogonal_def)
   then have a'': "\<And>w. w \<in> S \<Longrightarrow> a'' \<bullet> w = (a - a') \<bullet> z"
     by (simp add: a inner_diff_right)
   then have ba'': "\<And>w. w \<in> S \<Longrightarrow> a'' \<bullet> w = b - a' \<bullet> z"
     by (simp add: inner_diff_left z)
   have "\<And>w. w \<in> (+) (- z) ` S \<Longrightarrow> (w + a') \<in> (+) (- z) ` S"
     by (metis subspace_add a' span_eq_iff sub)
   then have Sclo: "\<And>w. w \<in> S \<Longrightarrow> (w + a') \<in> S"
     by fastforce
   show ?thesis
   proof (cases "a' = 0")
     case True
     with a assms True a'' diff_zero less_irrefl show ?thesis
       by auto
   next
     case False
     show ?thesis
       apply (rule_tac a' = "a'" and b' = "a' \<bullet> z" in that)
       apply (auto simp: a ba'' inner_left_distrib False Sclo)
       done
   qed
 qed
 
 lemma diffs_affine_hull_span:
   assumes "a \<in> S"
     shows "{x - a |x. x \<in> affine hull S} = span {x - a |x. x \<in> S}"
 proof -
   have *: "((\<lambda>x. x - a) ` (S - {a})) = {x. x + a \<in> S} - {0}"
     by (auto simp: algebra_simps)
   show ?thesis
     apply (simp add: affine_hull_span2 [OF assms] *)
     apply (auto simp: algebra_simps)
     done
 qed
 
 lemma aff_dim_dim_affine_diffs:
   fixes S :: "'a :: euclidean_space set"
   assumes "affine S" "a \<in> S"
     shows "aff_dim S = dim {x - a |x. x \<in> S}"
 proof -
   obtain B where aff: "affine hull B = affine hull S"
              and ind: "\<not> affine_dependent B"
              and card: "of_nat (card B) = aff_dim S + 1"
     using aff_dim_basis_exists by blast
   then have "B \<noteq> {}" using assms
     by (metis affine_hull_eq_empty ex_in_conv)
   then obtain c where "c \<in> B" by auto
   then have "c \<in> S"
     by (metis aff affine_hull_eq \<open>affine S\<close> hull_inc)
   have xy: "x - c = y - a \<longleftrightarrow> y = x + 1 *\<^sub>R (a - c)" for x y c and a::'a
     by (auto simp: algebra_simps)
   have *: "{x - c |x. x \<in> S} = {x - a |x. x \<in> S}"
     apply safe
     apply (simp_all only: xy)
     using mem_affine_3_minus [OF \<open>affine S\<close>] \<open>a \<in> S\<close> \<open>c \<in> S\<close> apply blast+
     done
   have affS: "affine hull S = S"
     by (simp add: \<open>affine S\<close>)
   have "aff_dim S = of_nat (card B) - 1"
     using card by simp
   also have "... = dim {x - c |x. x \<in> B}"
     by (simp add: affine_independent_card_dim_diffs [OF ind \<open>c \<in> B\<close>])
   also have "... = dim {x - c | x. x \<in> affine hull B}"
      by (simp add: diffs_affine_hull_span \<open>c \<in> B\<close> dim_span)
   also have "... = dim {x - a |x. x \<in> S}"
      by (simp add: affS aff *)
    finally show ?thesis .
 qed
 
 lemma aff_dim_linear_image_le:
   assumes "linear f"
     shows "aff_dim(f ` S) \<le> aff_dim S"
 proof -
   have "aff_dim (f ` T) \<le> aff_dim T" if "affine T" for T
   proof (cases "T = {}")
     case True then show ?thesis by (simp add: aff_dim_geq)
   next
     case False
     then obtain a where "a \<in> T" by auto
     have 1: "((\<lambda>x. x - f a) ` f ` T) = {x - f a |x. x \<in> f ` T}"
       by auto
     have 2: "{x - f a| x. x \<in> f ` T} = f ` {x - a| x. x \<in> T}"
       by (force simp: linear_diff [OF assms])
     have "aff_dim (f ` T) = int (dim {x - f a |x. x \<in> f ` T})"
       by (simp add: \<open>a \<in> T\<close> hull_inc aff_dim_eq_dim [of "f a"] 1 cong: image_cong_simp)
     also have "... = int (dim (f ` {x - a| x. x \<in> T}))"
       by (force simp: linear_diff [OF assms] 2)
     also have "... \<le> int (dim {x - a| x. x \<in> T})"
       by (simp add: dim_image_le [OF assms])
     also have "... \<le> aff_dim T"
       by (simp add: aff_dim_dim_affine_diffs [symmetric] \<open>a \<in> T\<close> \<open>affine T\<close>)
     finally show ?thesis .
   qed
   then
   have "aff_dim (f ` (affine hull S)) \<le> aff_dim (affine hull S)"
     using affine_affine_hull [of S] by blast
   then show ?thesis
     using affine_hull_linear_image assms linear_conv_bounded_linear by fastforce
 qed
 
 lemma aff_dim_injective_linear_image [simp]:
   assumes "linear f" "inj f"
     shows "aff_dim (f ` S) = aff_dim S"
 proof (rule antisym)
   show "aff_dim (f ` S) \<le> aff_dim S"
     by (simp add: aff_dim_linear_image_le assms(1))
 next
   obtain g where "linear g" "g \<circ> f = id"
     using assms(1) assms(2) linear_injective_left_inverse by blast
   then have "aff_dim S \<le> aff_dim(g ` f ` S)"
     by (simp add: image_comp)
   also have "... \<le> aff_dim (f ` S)"
     by (simp add: \<open>linear g\<close> aff_dim_linear_image_le)
   finally show "aff_dim S \<le> aff_dim (f ` S)" .
 qed
 
 
 lemma choose_affine_subset:
   assumes "affine S" "-1 \<le> d" and dle: "d \<le> aff_dim S"
   obtains T where "affine T" "T \<subseteq> S" "aff_dim T = d"
 proof (cases "d = -1 \<or> S={}")
   case True with assms show ?thesis
     by (metis aff_dim_empty affine_empty bot.extremum that eq_iff)
 next
   case False
   with assms obtain a where "a \<in> S" "0 \<le> d" by auto
   with assms have ss: "subspace ((+) (- a) ` S)"
     by (simp add: affine_diffs_subspace_subtract cong: image_cong_simp)
   have "nat d \<le> dim ((+) (- a) ` S)"
     by (metis aff_dim_subspace aff_dim_translation_eq dle nat_int nat_mono ss)
   then obtain T where "subspace T" and Tsb: "T \<subseteq> span ((+) (- a) ` S)"
                   and Tdim: "dim T = nat d"
     using choose_subspace_of_subspace [of "nat d" "(+) (- a) ` S"] by blast
   then have "affine T"
     using subspace_affine by blast
   then have "affine ((+) a ` T)"
     by (metis affine_hull_eq affine_hull_translation)
   moreover have "(+) a ` T \<subseteq> S"
   proof -
     have "T \<subseteq> (+) (- a) ` S"
       by (metis (no_types) span_eq_iff Tsb ss)
     then show "(+) a ` T \<subseteq> S"
       using add_ac by auto
   qed
   moreover have "aff_dim ((+) a ` T) = d"
     by (simp add: aff_dim_subspace Tdim \<open>0 \<le> d\<close> \<open>subspace T\<close> aff_dim_translation_eq)
   ultimately show ?thesis
     by (rule that)
 qed
 
 subsection\<open>Paracompactness\<close>
 
 proposition paracompact:
   fixes S :: "'a :: {metric_space,second_countable_topology} set"
   assumes "S \<subseteq> \<Union>\<C>" and opC: "\<And>T. T \<in> \<C> \<Longrightarrow> open T"
   obtains \<C>' where "S \<subseteq> \<Union> \<C>'"
                and "\<And>U. U \<in> \<C>' \<Longrightarrow> open U \<and> (\<exists>T. T \<in> \<C> \<and> U \<subseteq> T)"
                and "\<And>x. x \<in> S
                        \<Longrightarrow> \<exists>V. open V \<and> x \<in> V \<and> finite {U. U \<in> \<C>' \<and> (U \<inter> V \<noteq> {})}"
 proof (cases "S = {}")
   case True with that show ?thesis by blast
 next
   case False
   have "\<exists>T U. x \<in> U \<and> open U \<and> closure U \<subseteq> T \<and> T \<in> \<C>" if "x \<in> S" for x
   proof -
     obtain T where "x \<in> T" "T \<in> \<C>" "open T"
       using assms \<open>x \<in> S\<close> by blast
     then obtain e where "e > 0" "cball x e \<subseteq> T"
       by (force simp: open_contains_cball)
     then show ?thesis
       apply (rule_tac x = T in exI)
       apply (rule_tac x = "ball x e" in exI)
       using  \<open>T \<in> \<C>\<close>
       apply (simp add: closure_minimal)
       using closed_cball closure_minimal by blast
   qed
   then obtain F G where Gin: "x \<in> G x" and oG: "open (G x)"
                     and clos: "closure (G x) \<subseteq> F x" and Fin: "F x \<in> \<C>"
          if "x \<in> S" for x
     by metis
   then obtain \<F> where "\<F> \<subseteq> G ` S" "countable \<F>" "\<Union>\<F> = \<Union>(G ` S)"
     using Lindelof [of "G ` S"] by (metis image_iff)
   then obtain K where K: "K \<subseteq> S" "countable K" and eq: "\<Union>(G ` K) = \<Union>(G ` S)"
     by (metis countable_subset_image)
   with False Gin have "K \<noteq> {}" by force
   then obtain a :: "nat \<Rightarrow> 'a" where "range a = K"
     by (metis range_from_nat_into \<open>countable K\<close>)
   then have odif: "\<And>n. open (F (a n) - \<Union>{closure (G (a m)) |m. m < n})"
     using \<open>K \<subseteq> S\<close> Fin opC by (fastforce simp add:)
   let ?C = "range (\<lambda>n. F(a n) - \<Union>{closure(G(a m)) |m. m < n})"
   have enum_S: "\<exists>n. x \<in> F(a n) \<and> x \<in> G(a n)" if "x \<in> S" for x
   proof -
     have "\<exists>y \<in> K. x \<in> G y" using eq that Gin by fastforce
     then show ?thesis
       using clos K \<open>range a = K\<close> closure_subset by blast
   qed
   have 1: "S \<subseteq> Union ?C"
   proof
     fix x assume "x \<in> S"
     define n where "n \<equiv> LEAST n. x \<in> F(a n)"
     have n: "x \<in> F(a n)"
       using enum_S [OF \<open>x \<in> S\<close>] by (force simp: n_def intro: LeastI)
     have notn: "x \<notin> F(a m)" if "m < n" for m
       using that not_less_Least by (force simp: n_def)
     then have "x \<notin> \<Union>{closure (G (a m)) |m. m < n}"
       using n \<open>K \<subseteq> S\<close> \<open>range a = K\<close> clos notn by fastforce
     with n show "x \<in> Union ?C"
       by blast
   qed
   have 3: "\<exists>V. open V \<and> x \<in> V \<and> finite {U. U \<in> ?C \<and> (U \<inter> V \<noteq> {})}" if "x \<in> S" for x
   proof -
     obtain n where n: "x \<in> F(a n)" "x \<in> G(a n)"
       using \<open>x \<in> S\<close> enum_S by auto
     have "{U \<in> ?C. U \<inter> G (a n) \<noteq> {}} \<subseteq> (\<lambda>n. F(a n) - \<Union>{closure(G(a m)) |m. m < n}) ` atMost n"
     proof clarsimp
       fix k  assume "(F (a k) - \<Union>{closure (G (a m)) |m. m < k}) \<inter> G (a n) \<noteq> {}"
       then have "k \<le> n"
         by auto (metis closure_subset not_le subsetCE)
       then show "F (a k) - \<Union>{closure (G (a m)) |m. m < k}
                  \<in> (\<lambda>n. F (a n) - \<Union>{closure (G (a m)) |m. m < n}) ` {..n}"
         by force
     qed
     moreover have "finite ((\<lambda>n. F(a n) - \<Union>{closure(G(a m)) |m. m < n}) ` atMost n)"
       by force
     ultimately have *: "finite {U \<in> ?C. U \<inter> G (a n) \<noteq> {}}"
       using finite_subset by blast
     show ?thesis
       apply (rule_tac x="G (a n)" in exI)
       apply (intro conjI oG n *)
       using \<open>K \<subseteq> S\<close> \<open>range a = K\<close> apply blast
       done
   qed
   show ?thesis
     apply (rule that [OF 1 _ 3])
     using Fin \<open>K \<subseteq> S\<close> \<open>range a = K\<close>  apply (auto simp: odif)
     done
 qed
 
 corollary paracompact_closedin:
   fixes S :: "'a :: {metric_space,second_countable_topology} set"
   assumes cin: "closedin (top_of_set U) S"
       and oin: "\<And>T. T \<in> \<C> \<Longrightarrow> openin (top_of_set U) T"
       and "S \<subseteq> \<Union>\<C>"
   obtains \<C>' where "S \<subseteq> \<Union> \<C>'"
                and "\<And>V. V \<in> \<C>' \<Longrightarrow> openin (top_of_set U) V \<and> (\<exists>T. T \<in> \<C> \<and> V \<subseteq> T)"
                and "\<And>x. x \<in> U
                        \<Longrightarrow> \<exists>V. openin (top_of_set U) V \<and> x \<in> V \<and>
                                finite {X. X \<in> \<C>' \<and> (X \<inter> V \<noteq> {})}"
 proof -
   have "\<exists>Z. open Z \<and> (T = U \<inter> Z)" if "T \<in> \<C>" for T
     using oin [OF that] by (auto simp: openin_open)
   then obtain F where opF: "open (F T)" and intF: "U \<inter> F T = T" if "T \<in> \<C>" for T
     by metis
   obtain K where K: "closed K" "U \<inter> K = S"
     using cin by (auto simp: closedin_closed)
   have 1: "U \<subseteq> \<Union>(insert (- K) (F ` \<C>))"
     by clarsimp (metis Int_iff Union_iff \<open>U \<inter> K = S\<close> \<open>S \<subseteq> \<Union>\<C>\<close> subsetD intF)
   have 2: "\<And>T. T \<in> insert (- K) (F ` \<C>) \<Longrightarrow> open T"
     using \<open>closed K\<close> by (auto simp: opF)
   obtain \<D> where "U \<subseteq> \<Union>\<D>"
              and D1: "\<And>U. U \<in> \<D> \<Longrightarrow> open U \<and> (\<exists>T. T \<in> insert (- K) (F ` \<C>) \<and> U \<subseteq> T)"
              and D2: "\<And>x. x \<in> U \<Longrightarrow> \<exists>V. open V \<and> x \<in> V \<and> finite {U \<in> \<D>. U \<inter> V \<noteq> {}}"
     by (blast intro: paracompact [OF 1 2])
   let ?C = "{U \<inter> V |V. V \<in> \<D> \<and> (V \<inter> K \<noteq> {})}"
   show ?thesis
   proof (rule_tac \<C>' = "{U \<inter> V |V. V \<in> \<D> \<and> (V \<inter> K \<noteq> {})}" in that)
     show "S \<subseteq> \<Union>?C"
       using \<open>U \<inter> K = S\<close> \<open>U \<subseteq> \<Union>\<D>\<close> K by (blast dest!: subsetD)
     show "\<And>V. V \<in> ?C \<Longrightarrow> openin (top_of_set U) V \<and> (\<exists>T. T \<in> \<C> \<and> V \<subseteq> T)"
       using D1 intF by fastforce
     have *: "{X. (\<exists>V. X = U \<inter> V \<and> V \<in> \<D> \<and> V \<inter> K \<noteq> {}) \<and> X \<inter> (U \<inter> V) \<noteq> {}} \<subseteq>
              (\<lambda>x. U \<inter> x) ` {U \<in> \<D>. U \<inter> V \<noteq> {}}" for V
       by blast
     show "\<exists>V. openin (top_of_set U) V \<and> x \<in> V \<and> finite {X \<in> ?C. X \<inter> V \<noteq> {}}"
          if "x \<in> U" for x
       using D2 [OF that]
       apply clarify
       apply (rule_tac x="U \<inter> V" in exI)
       apply (auto intro: that finite_subset [OF *])
       done
     qed
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> paracompact_closed:
   fixes S :: "'a :: {metric_space,second_countable_topology} set"
   assumes "closed S"
       and opC: "\<And>T. T \<in> \<C> \<Longrightarrow> open T"
       and "S \<subseteq> \<Union>\<C>"
   obtains \<C>' where "S \<subseteq> \<Union>\<C>'"
                and "\<And>U. U \<in> \<C>' \<Longrightarrow> open U \<and> (\<exists>T. T \<in> \<C> \<and> U \<subseteq> T)"
                and "\<And>x. \<exists>V. open V \<and> x \<in> V \<and>
                                finite {U. U \<in> \<C>' \<and> (U \<inter> V \<noteq> {})}"
   by (rule paracompact_closedin [of UNIV S \<C>]) (auto simp: assms)
 
   
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Closed-graph characterization of continuity\<close>
 
 lemma continuous_closed_graph_gen:
   fixes T :: "'b::real_normed_vector set"
   assumes contf: "continuous_on S f" and fim: "f ` S \<subseteq> T"
     shows "closedin (top_of_set (S \<times> T)) ((\<lambda>x. Pair x (f x)) ` S)"
 proof -
   have eq: "((\<lambda>x. Pair x (f x)) ` S) =(S \<times> T \<inter> (\<lambda>z. (f \<circ> fst)z - snd z) -` {0})"
     using fim by auto
   show ?thesis
     apply (subst eq)
     apply (intro continuous_intros continuous_closedin_preimage continuous_on_subset [OF contf])
     by auto
 qed
 
 lemma continuous_closed_graph_eq:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "compact T" and fim: "f ` S \<subseteq> T"
   shows "continuous_on S f \<longleftrightarrow>
          closedin (top_of_set (S \<times> T)) ((\<lambda>x. Pair x (f x)) ` S)"
          (is "?lhs = ?rhs")
 proof -
   have "?lhs" if ?rhs
   proof (clarsimp simp add: continuous_on_closed_gen [OF fim])
     fix U
     assume U: "closedin (top_of_set T) U"
     have eq: "(S \<inter> f -` U) = fst ` (((\<lambda>x. Pair x (f x)) ` S) \<inter> (S \<times> U))"
       by (force simp: image_iff)
     show "closedin (top_of_set S) (S \<inter> f -` U)"
       by (simp add: U closedin_Int closedin_Times closed_map_fst [OF \<open>compact T\<close>] that eq)
   qed
   with continuous_closed_graph_gen assms show ?thesis by blast
 qed
 
 lemma continuous_closed_graph:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::real_normed_vector"
   assumes "closed S" and contf: "continuous_on S f"
   shows "closed ((\<lambda>x. Pair x (f x)) ` S)"
   apply (rule closedin_closed_trans)
    apply (rule continuous_closed_graph_gen [OF contf subset_UNIV])
   by (simp add: \<open>closed S\<close> closed_Times)
 
 lemma continuous_from_closed_graph:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes "compact T" and fim: "f ` S \<subseteq> T" and clo: "closed ((\<lambda>x. Pair x (f x)) ` S)"
   shows "continuous_on S f"
     using fim clo
     by (auto intro: closed_subset simp: continuous_closed_graph_eq [OF \<open>compact T\<close> fim])
 
 lemma continuous_on_Un_local_open:
   assumes opS: "openin (top_of_set (S \<union> T)) S"
       and opT: "openin (top_of_set (S \<union> T)) T"
       and contf: "continuous_on S f" and contg: "continuous_on T f"
     shows "continuous_on (S \<union> T) f"
   using pasting_lemma [of "{S,T}" "top_of_set (S \<union> T)" id euclidean "\<lambda>i. f" f] contf contg opS opT
   by (simp add: subtopology_subtopology) (metis inf.absorb2 openin_imp_subset)  
 
 lemma continuous_on_cases_local_open:
   assumes opS: "openin (top_of_set (S \<union> T)) S"
       and opT: "openin (top_of_set (S \<union> T)) T"
       and contf: "continuous_on S f" and contg: "continuous_on T g"
       and fg: "\<And>x. x \<in> S \<and> \<not>P x \<or> x \<in> T \<and> P x \<Longrightarrow> f x = g x"
     shows "continuous_on (S \<union> T) (\<lambda>x. if P x then f x else g x)"
 proof -
   have "\<And>x. x \<in> S \<Longrightarrow> (if P x then f x else g x) = f x"  "\<And>x. x \<in> T \<Longrightarrow> (if P x then f x else g x) = g x"
     by (simp_all add: fg)
   then have "continuous_on S (\<lambda>x. if P x then f x else g x)" "continuous_on T (\<lambda>x. if P x then f x else g x)"
     by (simp_all add: contf contg cong: continuous_on_cong)
   then show ?thesis
     by (rule continuous_on_Un_local_open [OF opS opT])
 qed
 
 lemma continuous_map_cases_le:
   assumes contp: "continuous_map X euclideanreal p"
     and contq: "continuous_map X euclideanreal q"
     and contf: "continuous_map (subtopology X {x. x \<in> topspace X \<and> p x \<le> q x}) Y f"
     and contg: "continuous_map (subtopology X {x. x \<in> topspace X \<and> q x \<le> p x}) Y g"
     and fg: "\<And>x. \<lbrakk>x \<in> topspace X; p x = q x\<rbrakk> \<Longrightarrow> f x = g x"
   shows "continuous_map X Y (\<lambda>x. if p x \<le> q x then f x else g x)"
 proof -
   have "continuous_map X Y (\<lambda>x. if q x - p x \<in> {0..} then f x else g x)"
   proof (rule continuous_map_cases_function)
     show "continuous_map X euclideanreal (\<lambda>x. q x - p x)"
       by (intro contp contq continuous_intros)
     show "continuous_map (subtopology X {x \<in> topspace X. q x - p x \<in> euclideanreal closure_of {0..}}) Y f"
       by (simp add: contf)
     show "continuous_map (subtopology X {x \<in> topspace X. q x - p x \<in> euclideanreal closure_of (topspace euclideanreal - {0..})}) Y g"
       by (simp add: contg flip: Compl_eq_Diff_UNIV)
   qed (auto simp: fg)
   then show ?thesis
     by simp
 qed
 
 lemma continuous_map_cases_lt:
   assumes contp: "continuous_map X euclideanreal p"
     and contq: "continuous_map X euclideanreal q"
     and contf: "continuous_map (subtopology X {x. x \<in> topspace X \<and> p x \<le> q x}) Y f"
     and contg: "continuous_map (subtopology X {x. x \<in> topspace X \<and> q x \<le> p x}) Y g"
     and fg: "\<And>x. \<lbrakk>x \<in> topspace X; p x = q x\<rbrakk> \<Longrightarrow> f x = g x"
   shows "continuous_map X Y (\<lambda>x. if p x < q x then f x else g x)"
 proof -
   have "continuous_map X Y (\<lambda>x. if q x - p x \<in> {0<..} then f x else g x)"
   proof (rule continuous_map_cases_function)
     show "continuous_map X euclideanreal (\<lambda>x. q x - p x)"
       by (intro contp contq continuous_intros)
     show "continuous_map (subtopology X {x \<in> topspace X. q x - p x \<in> euclideanreal closure_of {0<..}}) Y f"
       by (simp add: contf)
     show "continuous_map (subtopology X {x \<in> topspace X. q x - p x \<in> euclideanreal closure_of (topspace euclideanreal - {0<..})}) Y g"
       by (simp add: contg flip: Compl_eq_Diff_UNIV)
   qed (auto simp: fg)
   then show ?thesis
     by simp
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>The union of two collinear segments is another segment\<close>
 
 proposition\<^marker>\<open>tag unimportant\<close> in_convex_hull_exchange:
   fixes a :: "'a::euclidean_space"
   assumes a: "a \<in> convex hull S" and xS: "x \<in> convex hull S"
   obtains b where "b \<in> S" "x \<in> convex hull (insert a (S - {b}))"
 proof (cases "a \<in> S")
   case True
   with xS insert_Diff that  show ?thesis by fastforce
 next
   case False
   show ?thesis
   proof (cases "finite S \<and> card S \<le> Suc (DIM('a))")
     case True
     then obtain u where u0: "\<And>i. i \<in> S \<Longrightarrow> 0 \<le> u i" and u1: "sum u S = 1"
                     and ua: "(\<Sum>i\<in>S. u i *\<^sub>R i) = a"
         using a by (auto simp: convex_hull_finite)
     obtain v where v0: "\<And>i. i \<in> S \<Longrightarrow> 0 \<le> v i" and v1: "sum v S = 1"
                and vx: "(\<Sum>i\<in>S. v i *\<^sub>R i) = x"
       using True xS by (auto simp: convex_hull_finite)
     show ?thesis
     proof (cases "\<exists>b. b \<in> S \<and> v b = 0")
       case True
       then obtain b where b: "b \<in> S" "v b = 0"
         by blast
       show ?thesis
       proof
         have fin: "finite (insert a (S - {b}))"
           using sum.infinite v1 by fastforce
         show "x \<in> convex hull insert a (S - {b})"
           unfolding convex_hull_finite [OF fin] mem_Collect_eq
         proof (intro conjI exI ballI)
           have "(\<Sum>x \<in> insert a (S - {b}). if x = a then 0 else v x) =
                 (\<Sum>x \<in> S - {b}. if x = a then 0 else v x)"
             apply (rule sum.mono_neutral_right)
             using fin by auto
           also have "... = (\<Sum>x \<in> S - {b}. v x)"
             using b False by (auto intro!: sum.cong split: if_split_asm)
           also have "... = (\<Sum>x\<in>S. v x)"
             by (metis \<open>v b = 0\<close> diff_zero sum.infinite sum_diff1 u1 zero_neq_one)
           finally show "(\<Sum>x\<in>insert a (S - {b}). if x = a then 0 else v x) = 1"
             by (simp add: v1)
           show "\<And>x. x \<in> insert a (S - {b}) \<Longrightarrow> 0 \<le> (if x = a then 0 else v x)"
             by (auto simp: v0)
           have "(\<Sum>x \<in> insert a (S - {b}). (if x = a then 0 else v x) *\<^sub>R x) =
                 (\<Sum>x \<in> S - {b}. (if x = a then 0 else v x) *\<^sub>R x)"
             apply (rule sum.mono_neutral_right)
             using fin by auto
           also have "... = (\<Sum>x \<in> S - {b}. v x *\<^sub>R x)"
             using b False by (auto intro!: sum.cong split: if_split_asm)
           also have "... = (\<Sum>x\<in>S. v x *\<^sub>R x)"
             by (metis (no_types, lifting) b(2) diff_zero fin finite.emptyI finite_Diff2 finite_insert scale_eq_0_iff sum_diff1)
           finally show "(\<Sum>x\<in>insert a (S - {b}). (if x = a then 0 else v x) *\<^sub>R x) = x"
             by (simp add: vx)
         qed
       qed (rule \<open>b \<in> S\<close>)
     next
       case False
       have le_Max: "u i / v i \<le> Max ((\<lambda>i. u i / v i) ` S)" if "i \<in> S" for i
         by (simp add: True that)
       have "Max ((\<lambda>i. u i / v i) ` S) \<in> (\<lambda>i. u i / v i) ` S"
         using True v1 by (auto intro: Max_in)
       then obtain b where "b \<in> S" and beq: "Max ((\<lambda>b. u b / v b) ` S) = u b / v b"
         by blast
       then have "0 \<noteq> u b / v b"
         using le_Max beq divide_le_0_iff le_numeral_extra(2) sum_nonpos u1
         by (metis False eq_iff v0)
       then have  "0 < u b" "0 < v b"
         using False \<open>b \<in> S\<close> u0 v0 by force+
       have fin: "finite (insert a (S - {b}))"
         using sum.infinite v1 by fastforce
       show ?thesis
       proof
         show "x \<in> convex hull insert a (S - {b})"
           unfolding convex_hull_finite [OF fin] mem_Collect_eq
         proof (intro conjI exI ballI)
           have "(\<Sum>x \<in> insert a (S - {b}). if x=a then v b / u b else v x - (v b / u b) * u x) =
                 v b / u b + (\<Sum>x \<in> S - {b}. v x - (v b / u b) * u x)"
             using \<open>a \<notin> S\<close> \<open>b \<in> S\<close> True  apply simp
             apply (rule sum.cong, auto)
             done
           also have "... = v b / u b + (\<Sum>x \<in> S - {b}. v x) - (v b / u b) * (\<Sum>x \<in> S - {b}. u x)"
             by (simp add: Groups_Big.sum_subtractf sum_distrib_left)
           also have "... = (\<Sum>x\<in>S. v x)"
             using \<open>0 < u b\<close> True  by (simp add: Groups_Big.sum_diff1 u1 field_simps)
           finally show "sum (\<lambda>x. if x=a then v b / u b else v x - (v b / u b) * u x) (insert a (S - {b})) = 1"
             by (simp add: v1)
           show "0 \<le> (if i = a then v b / u b else v i - v b / u b * u i)"
             if "i \<in> insert a (S - {b})" for i
             using \<open>0 < u b\<close> \<open>0 < v b\<close> v0 [of i] le_Max [of i] beq that False
             by (auto simp: field_simps split: if_split_asm)
           have "(\<Sum>x\<in>insert a (S - {b}). (if x=a then v b / u b else v x - v b / u b * u x) *\<^sub>R x) =
                 (v b / u b) *\<^sub>R a + (\<Sum>x\<in>S - {b}. (v x - v b / u b * u x) *\<^sub>R x)"
             using \<open>a \<notin> S\<close> \<open>b \<in> S\<close> True  apply simp
             apply (rule sum.cong, auto)
             done
           also have "... = (v b / u b) *\<^sub>R a + (\<Sum>x \<in> S - {b}. v x *\<^sub>R x) - (v b / u b) *\<^sub>R (\<Sum>x \<in> S - {b}. u x *\<^sub>R x)"
             by (simp add: Groups_Big.sum_subtractf scaleR_left_diff_distrib sum_distrib_left scale_sum_right)
           also have "... = (\<Sum>x\<in>S. v x *\<^sub>R x)"
             using \<open>0 < u b\<close> True  by (simp add: ua vx Groups_Big.sum_diff1 algebra_simps)
           finally
           show "(\<Sum>x\<in>insert a (S - {b}). (if x=a then v b / u b else v x - v b / u b * u x) *\<^sub>R x) = x"
             by (simp add: vx)
         qed
       qed (rule \<open>b \<in> S\<close>)
     qed
   next
     case False
     obtain T where "finite T" "T \<subseteq> S" and caT: "card T \<le> Suc (DIM('a))" and xT: "x \<in> convex hull T"
       using xS by (auto simp: caratheodory [of S])
     with False obtain b where b: "b \<in> S" "b \<notin> T"
       by (metis antisym subsetI)
     show ?thesis
     proof
       show "x \<in> convex hull insert a (S - {b})"
         using  \<open>T \<subseteq> S\<close> b by (blast intro: subsetD [OF hull_mono xT])
     qed (rule \<open>b \<in> S\<close>)
   qed
 qed
 
 lemma convex_hull_exchange_Union:
   fixes a :: "'a::euclidean_space"
   assumes "a \<in> convex hull S"
   shows "convex hull S = (\<Union>b \<in> S. convex hull (insert a (S - {b})))" (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     by (blast intro: in_convex_hull_exchange [OF assms])
   show "?rhs \<subseteq> ?lhs"
   proof clarify
     fix x b
     assume"b \<in> S" "x \<in> convex hull insert a (S - {b})"
     then show "x \<in> convex hull S" if "b \<in> S"
       by (metis (no_types) that assms order_refl hull_mono hull_redundant insert_Diff_single insert_subset subsetCE)
   qed
 qed
 
 lemma Un_closed_segment:
   fixes a :: "'a::euclidean_space"
   assumes "b \<in> closed_segment a c"
     shows "closed_segment a b \<union> closed_segment b c = closed_segment a c"
 proof (cases "c = a")
   case True
   with assms show ?thesis by simp
 next
   case False
   with assms have "convex hull {a, b} \<union> convex hull {b, c} = (\<Union>ba\<in>{a, c}. convex hull insert b ({a, c} - {ba}))"
     by (auto simp: insert_Diff_if insert_commute)
   then show ?thesis
     using convex_hull_exchange_Union
     by (metis assms segment_convex_hull)
 qed
 
 lemma Un_open_segment:
   fixes a :: "'a::euclidean_space"
   assumes "b \<in> open_segment a c"
   shows "open_segment a b \<union> {b} \<union> open_segment b c = open_segment a c"
 proof -
   have b: "b \<in> closed_segment a c"
     by (simp add: assms open_closed_segment)
   have *: "open_segment a c \<subseteq> insert b (open_segment a b \<union> open_segment b c)"
           if "{b,c,a} \<union> open_segment a b \<union> open_segment b c = {c,a} \<union> open_segment a c"
   proof -
     have "insert a (insert c (insert b (open_segment a b \<union> open_segment b c))) = insert a (insert c (open_segment a c))"
       using that by (simp add: insert_commute)
     then show ?thesis
       by (metis (no_types) Diff_cancel Diff_eq_empty_iff Diff_insert2 open_segment_def)
   qed
   show ?thesis
     using Un_closed_segment [OF b]
     apply (simp add: closed_segment_eq_open)
       apply (rule equalityI)
     using assms
      apply (simp add: b subset_open_segment)
       using * by (simp add: insert_commute)
 qed
 
 subsection\<open>Covering an open set by a countable chain of compact sets\<close>
   
 proposition open_Union_compact_subsets:
   fixes S :: "'a::euclidean_space set"
   assumes "open S"
   obtains C where "\<And>n. compact(C n)" "\<And>n. C n \<subseteq> S"
                   "\<And>n. C n \<subseteq> interior(C(Suc n))"
                   "\<Union>(range C) = S"
                   "\<And>K. \<lbrakk>compact K; K \<subseteq> S\<rbrakk> \<Longrightarrow> \<exists>N. \<forall>n\<ge>N. K \<subseteq> (C n)"
 proof (cases "S = {}")
   case True
   then show ?thesis
     by (rule_tac C = "\<lambda>n. {}" in that) auto
 next
   case False
   then obtain a where "a \<in> S"
     by auto
   let ?C = "\<lambda>n. cball a (real n) - (\<Union>x \<in> -S. \<Union>e \<in> ball 0 (1 / real(Suc n)). {x + e})"
   have "\<exists>N. \<forall>n\<ge>N. K \<subseteq> (f n)"
         if "\<And>n. compact(f n)" and sub_int: "\<And>n. f n \<subseteq> interior (f(Suc n))"
             and eq: "\<Union>(range f) = S" and "compact K" "K \<subseteq> S" for f K
   proof -
     have *: "\<forall>n. f n \<subseteq> (\<Union>n. interior (f n))"
       by (meson Sup_upper2 UNIV_I \<open>\<And>n. f n \<subseteq> interior (f (Suc n))\<close> image_iff)
     have mono: "\<And>m n. m \<le> n \<Longrightarrow>f m \<subseteq> f n"
       by (meson dual_order.trans interior_subset lift_Suc_mono_le sub_int)
     obtain I where "finite I" and I: "K \<subseteq> (\<Union>i\<in>I. interior (f i))"
     proof (rule compactE_image [OF \<open>compact K\<close>])
       show "K \<subseteq> (\<Union>n. interior (f n))"
         using \<open>K \<subseteq> S\<close> \<open>\<Union>(f ` UNIV) = S\<close> * by blast
     qed auto
     { fix n
       assume n: "Max I \<le> n"
       have "(\<Union>i\<in>I. interior (f i)) \<subseteq> f n"
         by (rule UN_least) (meson dual_order.trans interior_subset mono I Max_ge [OF \<open>finite I\<close>] n)
       then have "K \<subseteq> f n"
         using I by auto
     }
     then show ?thesis
       by blast
   qed
   moreover have "\<exists>f. (\<forall>n. compact(f n)) \<and> (\<forall>n. (f n) \<subseteq> S) \<and> (\<forall>n. (f n) \<subseteq> interior(f(Suc n))) \<and>
                      ((\<Union>(range f) = S))"
   proof (intro exI conjI allI)
     show "\<And>n. compact (?C n)"
       by (auto simp: compact_diff open_sums)
     show "\<And>n. ?C n \<subseteq> S"
       by auto
     show "?C n \<subseteq> interior (?C (Suc n))" for n
     proof (simp add: interior_diff, rule Diff_mono)
       show "cball a (real n) \<subseteq> ball a (1 + real n)"
         by (simp add: cball_subset_ball_iff)
       have cl: "closed (\<Union>x\<in>- S. \<Union>e\<in>cball 0 (1 / (2 + real n)). {x + e})"
         using assms by (auto intro: closed_compact_sums)
       have "closure (\<Union>x\<in>- S. \<Union>y\<in>ball 0 (1 / (2 + real n)). {x + y})
             \<subseteq> (\<Union>x \<in> -S. \<Union>e \<in> cball 0 (1 / (2 + real n)). {x + e})"
         by (intro closure_minimal UN_mono ball_subset_cball order_refl cl)
       also have "... \<subseteq> (\<Union>x \<in> -S. \<Union>y\<in>ball 0 (1 / (1 + real n)). {x + y})"
         apply (intro UN_mono order_refl)
         apply (simp add: cball_subset_ball_iff field_split_simps)
         done
       finally show "closure (\<Union>x\<in>- S. \<Union>y\<in>ball 0 (1 / (2 + real n)). {x + y})
                     \<subseteq> (\<Union>x \<in> -S. \<Union>y\<in>ball 0 (1 / (1 + real n)). {x + y})" .
     qed
     have "S \<subseteq> \<Union> (range ?C)"
     proof
       fix x
       assume x: "x \<in> S"
       then obtain e where "e > 0" and e: "ball x e \<subseteq> S"
         using assms open_contains_ball by blast
       then obtain N1 where "N1 > 0" and N1: "real N1 > 1/e"
         using reals_Archimedean2
         by (metis divide_less_0_iff less_eq_real_def neq0_conv not_le of_nat_0 of_nat_1 of_nat_less_0_iff)
       obtain N2 where N2: "norm(x - a) \<le> real N2"
         by (meson real_arch_simple)
       have N12: "inverse((N1 + N2) + 1) \<le> inverse(N1)"
         using \<open>N1 > 0\<close> by (auto simp: field_split_simps)
       have "x \<noteq> y + z" if "y \<notin> S" "norm z < 1 / (1 + (real N1 + real N2))" for y z
       proof -
         have "e * real N1 < e * (1 + (real N1 + real N2))"
           by (simp add: \<open>0 < e\<close>)
         then have "1 / (1 + (real N1 + real N2)) < e"
           using N1 \<open>e > 0\<close>
           by (metis divide_less_eq less_trans mult.commute of_nat_add of_nat_less_0_iff of_nat_Suc)
         then have "x - z \<in> ball x e"
           using that by simp
         then have "x - z \<in> S"
           using e by blast
         with that show ?thesis
           by auto
       qed
       with N2 show "x \<in> \<Union> (range ?C)"
         by (rule_tac a = "N1+N2" in UN_I) (auto simp: dist_norm norm_minus_commute)
     qed
     then show "\<Union> (range ?C) = S" by auto
   qed
   ultimately show ?thesis
     using that by metis
 qed
 
 
 subsection\<open>Orthogonal complement\<close>
 
 definition\<^marker>\<open>tag important\<close> orthogonal_comp ("_\<^sup>\<bottom>" [80] 80)
   where "orthogonal_comp W \<equiv> {x. \<forall>y \<in> W. orthogonal y x}"
 
 proposition subspace_orthogonal_comp: "subspace (W\<^sup>\<bottom>)"
   unfolding subspace_def orthogonal_comp_def orthogonal_def
   by (auto simp: inner_right_distrib)
 
 lemma orthogonal_comp_anti_mono:
   assumes "A \<subseteq> B"
   shows "B\<^sup>\<bottom> \<subseteq> A\<^sup>\<bottom>"
 proof
   fix x assume x: "x \<in> B\<^sup>\<bottom>"
   show "x \<in> orthogonal_comp A" using x unfolding orthogonal_comp_def
     by (simp add: orthogonal_def, metis assms in_mono)
 qed
 
 lemma orthogonal_comp_null [simp]: "{0}\<^sup>\<bottom> = UNIV"
   by (auto simp: orthogonal_comp_def orthogonal_def)
 
 lemma orthogonal_comp_UNIV [simp]: "UNIV\<^sup>\<bottom> = {0}"
   unfolding orthogonal_comp_def orthogonal_def
   by auto (use inner_eq_zero_iff in blast)
 
 lemma orthogonal_comp_subset: "U \<subseteq> U\<^sup>\<bottom>\<^sup>\<bottom>"
   by (auto simp: orthogonal_comp_def orthogonal_def inner_commute)
 
 lemma subspace_sum_minimal:
   assumes "S \<subseteq> U" "T \<subseteq> U" "subspace U"
   shows "S + T \<subseteq> U"
 proof
   fix x
   assume "x \<in> S + T"
   then obtain xs xt where "xs \<in> S" "xt \<in> T" "x = xs+xt"
     by (meson set_plus_elim)
   then show "x \<in> U"
     by (meson assms subsetCE subspace_add)
 qed
 
 proposition subspace_sum_orthogonal_comp:
   fixes U :: "'a :: euclidean_space set"
   assumes "subspace U"
   shows "U + U\<^sup>\<bottom> = UNIV"
 proof -
   obtain B where "B \<subseteq> U"
     and ortho: "pairwise orthogonal B" "\<And>x. x \<in> B \<Longrightarrow> norm x = 1"
     and "independent B" "card B = dim U" "span B = U"
     using orthonormal_basis_subspace [OF assms] by metis
   then have "finite B"
     by (simp add: indep_card_eq_dim_span)
   have *: "\<forall>x\<in>B. \<forall>y\<in>B. x \<bullet> y = (if x=y then 1 else 0)"
     using ortho norm_eq_1 by (auto simp: orthogonal_def pairwise_def)
   { fix v
     let ?u = "\<Sum>b\<in>B. (v \<bullet> b) *\<^sub>R b"
     have "v = ?u + (v - ?u)"
       by simp
     moreover have "?u \<in> U"
       by (metis (no_types, lifting) \<open>span B = U\<close> assms subspace_sum span_base span_mul)
     moreover have "(v - ?u) \<in> U\<^sup>\<bottom>"
     proof (clarsimp simp: orthogonal_comp_def orthogonal_def)
       fix y
       assume "y \<in> U"
       with \<open>span B = U\<close> span_finite [OF \<open>finite B\<close>]
       obtain u where u: "y = (\<Sum>b\<in>B. u b *\<^sub>R b)"
         by auto
       have "b \<bullet> (v - ?u) = 0" if "b \<in> B" for b
         using that \<open>finite B\<close>
         by (simp add: * algebra_simps inner_sum_right if_distrib [of "(*)v" for v] inner_commute cong: if_cong)
       then show "y \<bullet> (v - ?u) = 0"
         by (simp add: u inner_sum_left)
     qed
     ultimately have "v \<in> U + U\<^sup>\<bottom>"
       using set_plus_intro by fastforce
   } then show ?thesis
     by auto
 qed
 
 lemma orthogonal_Int_0:
   assumes "subspace U"
   shows "U \<inter> U\<^sup>\<bottom> = {0}"
   using orthogonal_comp_def orthogonal_self
   by (force simp: assms subspace_0 subspace_orthogonal_comp)
 
 lemma orthogonal_comp_self:
   fixes U :: "'a :: euclidean_space set"
   assumes "subspace U"
   shows "U\<^sup>\<bottom>\<^sup>\<bottom> = U"
 proof
   have ssU': "subspace (U\<^sup>\<bottom>)"
     by (simp add: subspace_orthogonal_comp)
   have "u \<in> U" if "u \<in> U\<^sup>\<bottom>\<^sup>\<bottom>" for u
   proof -
     obtain v w where "u = v+w" "v \<in> U" "w \<in> U\<^sup>\<bottom>"
       using subspace_sum_orthogonal_comp [OF assms] set_plus_elim by blast
     then have "u-v \<in> U\<^sup>\<bottom>"
       by simp
     moreover have "v \<in> U\<^sup>\<bottom>\<^sup>\<bottom>"
       using \<open>v \<in> U\<close> orthogonal_comp_subset by blast
     then have "u-v \<in> U\<^sup>\<bottom>\<^sup>\<bottom>"
       by (simp add: subspace_diff subspace_orthogonal_comp that)
     ultimately have "u-v = 0"
       using orthogonal_Int_0 ssU' by blast
     with \<open>v \<in> U\<close> show ?thesis
       by auto
   qed
   then show "U\<^sup>\<bottom>\<^sup>\<bottom> \<subseteq> U"
     by auto
 qed (use orthogonal_comp_subset in auto)
 
 lemma ker_orthogonal_comp_adjoint:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes "linear f"
   shows "f -` {0} =  (range (adjoint f))\<^sup>\<bottom>"
   apply (auto simp: orthogonal_comp_def orthogonal_def)
   apply (simp add: adjoint_works assms(1) inner_commute)
   by (metis adjoint_works all_zero_iff assms(1) inner_commute)
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>A non-injective linear function maps into a hyperplane.\<close>
 
 lemma linear_surj_adj_imp_inj:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes "linear f" "surj (adjoint f)"
   shows "inj f"
 proof -
   have "\<exists>x. y = adjoint f x" for y
     using assms by (simp add: surjD)
   then show "inj f"
     using assms unfolding inj_on_def image_def
     by (metis (no_types) adjoint_works euclidean_eqI)
 qed
 
 \<comment> \<open>\<^url>\<open>https://mathonline.wikidot.com/injectivity-and-surjectivity-of-the-adjoint-of-a-linear-map\<close>\<close>
 lemma surj_adjoint_iff_inj [simp]:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes "linear f"
   shows  "surj (adjoint f) \<longleftrightarrow> inj f"
 proof
   assume "surj (adjoint f)"
   then show "inj f"
     by (simp add: assms linear_surj_adj_imp_inj)
 next
   assume "inj f"
   have "f -` {0} = {0}"
     using assms \<open>inj f\<close> linear_0 linear_injective_0 by fastforce
   moreover have "f -` {0} = range (adjoint f)\<^sup>\<bottom>"
     by (intro ker_orthogonal_comp_adjoint assms)
   ultimately have "range (adjoint f)\<^sup>\<bottom>\<^sup>\<bottom> = UNIV"
     by (metis orthogonal_comp_null)
   then show "surj (adjoint f)"
     using adjoint_linear \<open>linear f\<close>
     by (subst (asm) orthogonal_comp_self)
       (simp add: adjoint_linear linear_subspace_image)
 qed
 
 lemma inj_adjoint_iff_surj [simp]:
   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
   assumes "linear f"
   shows  "inj (adjoint f) \<longleftrightarrow> surj f"
 proof
   assume "inj (adjoint f)"
   have "(adjoint f) -` {0} = {0}"
     by (metis \<open>inj (adjoint f)\<close> adjoint_linear assms surj_adjoint_iff_inj ker_orthogonal_comp_adjoint orthogonal_comp_UNIV)
   then have "(range(f))\<^sup>\<bottom> = {0}"
     by (metis (no_types, hide_lams) adjoint_adjoint adjoint_linear assms ker_orthogonal_comp_adjoint set_zero)
   then show "surj f"
     by (metis \<open>inj (adjoint f)\<close> adjoint_adjoint adjoint_linear assms surj_adjoint_iff_inj)
 next
   assume "surj f"
   then have "range f = (adjoint f -` {0})\<^sup>\<bottom>"
     by (simp add: adjoint_adjoint adjoint_linear assms ker_orthogonal_comp_adjoint)
   then have "{0} = adjoint f -` {0}"
     using \<open>surj f\<close> adjoint_adjoint adjoint_linear assms ker_orthogonal_comp_adjoint by force
   then show "inj (adjoint f)"
     by (simp add: \<open>surj f\<close> adjoint_adjoint adjoint_linear assms linear_surj_adj_imp_inj)
 qed
 
 lemma linear_singular_into_hyperplane:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'n"
   assumes "linear f"
   shows "\<not> inj f \<longleftrightarrow> (\<exists>a. a \<noteq> 0 \<and> (\<forall>x. a \<bullet> f x = 0))" (is "_ = ?rhs")
 proof
   assume "\<not>inj f"
   then show ?rhs
     using all_zero_iff
     by (metis (no_types, hide_lams) adjoint_clauses(2) adjoint_linear assms
         linear_injective_0 linear_injective_imp_surjective linear_surj_adj_imp_inj)
 next
   assume ?rhs
   then show "\<not>inj f"
     by (metis assms linear_injective_isomorphism all_zero_iff)
 qed
 
 lemma linear_singular_image_hyperplane:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'n"
   assumes "linear f" "\<not>inj f"
   obtains a where "a \<noteq> 0" "\<And>S. f ` S \<subseteq> {x. a \<bullet> x = 0}"
   using assms by (fastforce simp add: linear_singular_into_hyperplane)
 
 end