src/HOL/Analysis/Convex.thy
author immler
Mon Jan 07 14:06:54 2019 +0100 (5 months ago)
changeset 69619 3f7d8e05e0f2
child 69661 a03a63b81f44
permissions -rw-r--r--
split off Convex.thy: material that does not require Topology_Euclidean_Space
     1 (* Title:      HOL/Analysis/Convex_Euclidean_Space.thy
     2    Author:     L C Paulson, University of Cambridge
     3    Author:     Robert Himmelmann, TU Muenchen
     4    Author:     Bogdan Grechuk, University of Edinburgh
     5    Author:     Armin Heller, TU Muenchen
     6    Author:     Johannes Hoelzl, TU Muenchen
     7 *)
     8 
     9 section \<open>Convex Sets and Functions\<close>
    10 
    11 theory Convex
    12 imports
    13   Linear_Algebra
    14   "HOL-Library.Set_Algebras"
    15 begin
    16 
    17 lemma substdbasis_expansion_unique:
    18   assumes d: "d \<subseteq> Basis"
    19   shows "(\<Sum>i\<in>d. f i *\<^sub>R i) = (x::'a::euclidean_space) \<longleftrightarrow>
    20     (\<forall>i\<in>Basis. (i \<in> d \<longrightarrow> f i = x \<bullet> i) \<and> (i \<notin> d \<longrightarrow> x \<bullet> i = 0))"
    21 proof -
    22   have *: "\<And>x a b P. x * (if P then a else b) = (if P then x * a else x * b)"
    23     by auto
    24   have **: "finite d"
    25     by (auto intro: finite_subset[OF assms])
    26   have ***: "\<And>i. i \<in> Basis \<Longrightarrow> (\<Sum>i\<in>d. f i *\<^sub>R i) \<bullet> i = (\<Sum>x\<in>d. if x = i then f x else 0)"
    27     using d
    28     by (auto intro!: sum.cong simp: inner_Basis inner_sum_left)
    29   show ?thesis
    30     unfolding euclidean_eq_iff[where 'a='a] by (auto simp: sum.delta[OF **] ***)
    31 qed
    32 
    33 lemma independent_substdbasis: "d \<subseteq> Basis \<Longrightarrow> independent d"
    34   by (rule independent_mono[OF independent_Basis])
    35 
    36 lemma sum_not_0: "sum f A \<noteq> 0 \<Longrightarrow> \<exists>a \<in> A. f a \<noteq> 0"
    37   by (rule ccontr) auto
    38 
    39 lemma subset_translation_eq [simp]:
    40     fixes a :: "'a::real_vector" shows "(+) a ` s \<subseteq> (+) a ` t \<longleftrightarrow> s \<subseteq> t"
    41   by auto
    42 
    43 lemma translate_inj_on:
    44   fixes A :: "'a::ab_group_add set"
    45   shows "inj_on (\<lambda>x. a + x) A"
    46   unfolding inj_on_def by auto
    47 
    48 lemma translation_assoc:
    49   fixes a b :: "'a::ab_group_add"
    50   shows "(\<lambda>x. b + x) ` ((\<lambda>x. a + x) ` S) = (\<lambda>x. (a + b) + x) ` S"
    51   by auto
    52 
    53 lemma translation_invert:
    54   fixes a :: "'a::ab_group_add"
    55   assumes "(\<lambda>x. a + x) ` A = (\<lambda>x. a + x) ` B"
    56   shows "A = B"
    57 proof -
    58   have "(\<lambda>x. -a + x) ` ((\<lambda>x. a + x) ` A) = (\<lambda>x. - a + x) ` ((\<lambda>x. a + x) ` B)"
    59     using assms by auto
    60   then show ?thesis
    61     using translation_assoc[of "-a" a A] translation_assoc[of "-a" a B] by auto
    62 qed
    63 
    64 lemma translation_galois:
    65   fixes a :: "'a::ab_group_add"
    66   shows "T = ((\<lambda>x. a + x) ` S) \<longleftrightarrow> S = ((\<lambda>x. (- a) + x) ` T)"
    67   using translation_assoc[of "-a" a S]
    68   apply auto
    69   using translation_assoc[of a "-a" T]
    70   apply auto
    71   done
    72 
    73 lemma translation_inverse_subset:
    74   assumes "((\<lambda>x. - a + x) ` V) \<le> (S :: 'n::ab_group_add set)"
    75   shows "V \<le> ((\<lambda>x. a + x) ` S)"
    76 proof -
    77   {
    78     fix x
    79     assume "x \<in> V"
    80     then have "x-a \<in> S" using assms by auto
    81     then have "x \<in> {a + v |v. v \<in> S}"
    82       apply auto
    83       apply (rule exI[of _ "x-a"], simp)
    84       done
    85     then have "x \<in> ((\<lambda>x. a+x) ` S)" by auto
    86   }
    87   then show ?thesis by auto
    88 qed
    89 
    90 subsection \<open>Convexity\<close>
    91 
    92 definition%important convex :: "'a::real_vector set \<Rightarrow> bool"
    93   where "convex s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u\<ge>0. \<forall>v\<ge>0. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> s)"
    94 
    95 lemma convexI:
    96   assumes "\<And>x y u v. x \<in> s \<Longrightarrow> y \<in> s \<Longrightarrow> 0 \<le> u \<Longrightarrow> 0 \<le> v \<Longrightarrow> u + v = 1 \<Longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> s"
    97   shows "convex s"
    98   using assms unfolding convex_def by fast
    99 
   100 lemma convexD:
   101   assumes "convex s" and "x \<in> s" and "y \<in> s" and "0 \<le> u" and "0 \<le> v" and "u + v = 1"
   102   shows "u *\<^sub>R x + v *\<^sub>R y \<in> s"
   103   using assms unfolding convex_def by fast
   104 
   105 lemma convex_alt: "convex s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u. 0 \<le> u \<and> u \<le> 1 \<longrightarrow> ((1 - u) *\<^sub>R x + u *\<^sub>R y) \<in> s)"
   106   (is "_ \<longleftrightarrow> ?alt")
   107 proof
   108   show "convex s" if alt: ?alt
   109   proof -
   110     {
   111       fix x y and u v :: real
   112       assume mem: "x \<in> s" "y \<in> s"
   113       assume "0 \<le> u" "0 \<le> v"
   114       moreover
   115       assume "u + v = 1"
   116       then have "u = 1 - v" by auto
   117       ultimately have "u *\<^sub>R x + v *\<^sub>R y \<in> s"
   118         using alt [rule_format, OF mem] by auto
   119     }
   120     then show ?thesis
   121       unfolding convex_def by auto
   122   qed
   123   show ?alt if "convex s"
   124     using that by (auto simp: convex_def)
   125 qed
   126 
   127 lemma convexD_alt:
   128   assumes "convex s" "a \<in> s" "b \<in> s" "0 \<le> u" "u \<le> 1"
   129   shows "((1 - u) *\<^sub>R a + u *\<^sub>R b) \<in> s"
   130   using assms unfolding convex_alt by auto
   131 
   132 lemma mem_convex_alt:
   133   assumes "convex S" "x \<in> S" "y \<in> S" "u \<ge> 0" "v \<ge> 0" "u + v > 0"
   134   shows "((u/(u+v)) *\<^sub>R x + (v/(u+v)) *\<^sub>R y) \<in> S"
   135   apply (rule convexD)
   136   using assms
   137        apply (simp_all add: zero_le_divide_iff add_divide_distrib [symmetric])
   138   done
   139 
   140 lemma convex_empty[intro,simp]: "convex {}"
   141   unfolding convex_def by simp
   142 
   143 lemma convex_singleton[intro,simp]: "convex {a}"
   144   unfolding convex_def by (auto simp: scaleR_left_distrib[symmetric])
   145 
   146 lemma convex_UNIV[intro,simp]: "convex UNIV"
   147   unfolding convex_def by auto
   148 
   149 lemma convex_Inter: "(\<And>s. s\<in>f \<Longrightarrow> convex s) \<Longrightarrow> convex(\<Inter>f)"
   150   unfolding convex_def by auto
   151 
   152 lemma convex_Int: "convex s \<Longrightarrow> convex t \<Longrightarrow> convex (s \<inter> t)"
   153   unfolding convex_def by auto
   154 
   155 lemma convex_INT: "(\<And>i. i \<in> A \<Longrightarrow> convex (B i)) \<Longrightarrow> convex (\<Inter>i\<in>A. B i)"
   156   unfolding convex_def by auto
   157 
   158 lemma convex_Times: "convex s \<Longrightarrow> convex t \<Longrightarrow> convex (s \<times> t)"
   159   unfolding convex_def by auto
   160 
   161 lemma convex_halfspace_le: "convex {x. inner a x \<le> b}"
   162   unfolding convex_def
   163   by (auto simp: inner_add intro!: convex_bound_le)
   164 
   165 lemma convex_halfspace_ge: "convex {x. inner a x \<ge> b}"
   166 proof -
   167   have *: "{x. inner a x \<ge> b} = {x. inner (-a) x \<le> -b}"
   168     by auto
   169   show ?thesis
   170     unfolding * using convex_halfspace_le[of "-a" "-b"] by auto
   171 qed
   172 
   173 lemma convex_halfspace_abs_le: "convex {x. \<bar>inner a x\<bar> \<le> b}"
   174 proof -
   175   have *: "{x. \<bar>inner a x\<bar> \<le> b} = {x. inner a x \<le> b} \<inter> {x. -b \<le> inner a x}"
   176     by auto
   177   show ?thesis
   178     unfolding * by (simp add: convex_Int convex_halfspace_ge convex_halfspace_le)
   179 qed
   180 
   181 lemma convex_hyperplane: "convex {x. inner a x = b}"
   182 proof -
   183   have *: "{x. inner a x = b} = {x. inner a x \<le> b} \<inter> {x. inner a x \<ge> b}"
   184     by auto
   185   show ?thesis using convex_halfspace_le convex_halfspace_ge
   186     by (auto intro!: convex_Int simp: *)
   187 qed
   188 
   189 lemma convex_halfspace_lt: "convex {x. inner a x < b}"
   190   unfolding convex_def
   191   by (auto simp: convex_bound_lt inner_add)
   192 
   193 lemma convex_halfspace_gt: "convex {x. inner a x > b}"
   194   using convex_halfspace_lt[of "-a" "-b"] by auto
   195 
   196 lemma convex_halfspace_Re_ge: "convex {x. Re x \<ge> b}"
   197   using convex_halfspace_ge[of b "1::complex"] by simp
   198 
   199 lemma convex_halfspace_Re_le: "convex {x. Re x \<le> b}"
   200   using convex_halfspace_le[of "1::complex" b] by simp
   201 
   202 lemma convex_halfspace_Im_ge: "convex {x. Im x \<ge> b}"
   203   using convex_halfspace_ge[of b \<i>] by simp
   204 
   205 lemma convex_halfspace_Im_le: "convex {x. Im x \<le> b}"
   206   using convex_halfspace_le[of \<i> b] by simp
   207 
   208 lemma convex_halfspace_Re_gt: "convex {x. Re x > b}"
   209   using convex_halfspace_gt[of b "1::complex"] by simp
   210 
   211 lemma convex_halfspace_Re_lt: "convex {x. Re x < b}"
   212   using convex_halfspace_lt[of "1::complex" b] by simp
   213 
   214 lemma convex_halfspace_Im_gt: "convex {x. Im x > b}"
   215   using convex_halfspace_gt[of b \<i>] by simp
   216 
   217 lemma convex_halfspace_Im_lt: "convex {x. Im x < b}"
   218   using convex_halfspace_lt[of \<i> b] by simp
   219 
   220 lemma convex_real_interval [iff]:
   221   fixes a b :: "real"
   222   shows "convex {a..}" and "convex {..b}"
   223     and "convex {a<..}" and "convex {..<b}"
   224     and "convex {a..b}" and "convex {a<..b}"
   225     and "convex {a..<b}" and "convex {a<..<b}"
   226 proof -
   227   have "{a..} = {x. a \<le> inner 1 x}"
   228     by auto
   229   then show 1: "convex {a..}"
   230     by (simp only: convex_halfspace_ge)
   231   have "{..b} = {x. inner 1 x \<le> b}"
   232     by auto
   233   then show 2: "convex {..b}"
   234     by (simp only: convex_halfspace_le)
   235   have "{a<..} = {x. a < inner 1 x}"
   236     by auto
   237   then show 3: "convex {a<..}"
   238     by (simp only: convex_halfspace_gt)
   239   have "{..<b} = {x. inner 1 x < b}"
   240     by auto
   241   then show 4: "convex {..<b}"
   242     by (simp only: convex_halfspace_lt)
   243   have "{a..b} = {a..} \<inter> {..b}"
   244     by auto
   245   then show "convex {a..b}"
   246     by (simp only: convex_Int 1 2)
   247   have "{a<..b} = {a<..} \<inter> {..b}"
   248     by auto
   249   then show "convex {a<..b}"
   250     by (simp only: convex_Int 3 2)
   251   have "{a..<b} = {a..} \<inter> {..<b}"
   252     by auto
   253   then show "convex {a..<b}"
   254     by (simp only: convex_Int 1 4)
   255   have "{a<..<b} = {a<..} \<inter> {..<b}"
   256     by auto
   257   then show "convex {a<..<b}"
   258     by (simp only: convex_Int 3 4)
   259 qed
   260 
   261 lemma convex_Reals: "convex \<real>"
   262   by (simp add: convex_def scaleR_conv_of_real)
   263 
   264 
   265 subsection%unimportant \<open>Explicit expressions for convexity in terms of arbitrary sums\<close>
   266 
   267 lemma convex_sum:
   268   fixes C :: "'a::real_vector set"
   269   assumes "finite s"
   270     and "convex C"
   271     and "(\<Sum> i \<in> s. a i) = 1"
   272   assumes "\<And>i. i \<in> s \<Longrightarrow> a i \<ge> 0"
   273     and "\<And>i. i \<in> s \<Longrightarrow> y i \<in> C"
   274   shows "(\<Sum> j \<in> s. a j *\<^sub>R y j) \<in> C"
   275   using assms(1,3,4,5)
   276 proof (induct arbitrary: a set: finite)
   277   case empty
   278   then show ?case by simp
   279 next
   280   case (insert i s) note IH = this(3)
   281   have "a i + sum a s = 1"
   282     and "0 \<le> a i"
   283     and "\<forall>j\<in>s. 0 \<le> a j"
   284     and "y i \<in> C"
   285     and "\<forall>j\<in>s. y j \<in> C"
   286     using insert.hyps(1,2) insert.prems by simp_all
   287   then have "0 \<le> sum a s"
   288     by (simp add: sum_nonneg)
   289   have "a i *\<^sub>R y i + (\<Sum>j\<in>s. a j *\<^sub>R y j) \<in> C"
   290   proof (cases "sum a s = 0")
   291     case True
   292     with \<open>a i + sum a s = 1\<close> have "a i = 1"
   293       by simp
   294     from sum_nonneg_0 [OF \<open>finite s\<close> _ True] \<open>\<forall>j\<in>s. 0 \<le> a j\<close> have "\<forall>j\<in>s. a j = 0"
   295       by simp
   296     show ?thesis using \<open>a i = 1\<close> and \<open>\<forall>j\<in>s. a j = 0\<close> and \<open>y i \<in> C\<close>
   297       by simp
   298   next
   299     case False
   300     with \<open>0 \<le> sum a s\<close> have "0 < sum a s"
   301       by simp
   302     then have "(\<Sum>j\<in>s. (a j / sum a s) *\<^sub>R y j) \<in> C"
   303       using \<open>\<forall>j\<in>s. 0 \<le> a j\<close> and \<open>\<forall>j\<in>s. y j \<in> C\<close>
   304       by (simp add: IH sum_divide_distrib [symmetric])
   305     from \<open>convex C\<close> and \<open>y i \<in> C\<close> and this and \<open>0 \<le> a i\<close>
   306       and \<open>0 \<le> sum a s\<close> and \<open>a i + sum a s = 1\<close>
   307     have "a i *\<^sub>R y i + sum a s *\<^sub>R (\<Sum>j\<in>s. (a j / sum a s) *\<^sub>R y j) \<in> C"
   308       by (rule convexD)
   309     then show ?thesis
   310       by (simp add: scaleR_sum_right False)
   311   qed
   312   then show ?case using \<open>finite s\<close> and \<open>i \<notin> s\<close>
   313     by simp
   314 qed
   315 
   316 lemma convex:
   317   "convex s \<longleftrightarrow> (\<forall>(k::nat) u x. (\<forall>i. 1\<le>i \<and> i\<le>k \<longrightarrow> 0 \<le> u i \<and> x i \<in>s) \<and> (sum u {1..k} = 1)
   318       \<longrightarrow> sum (\<lambda>i. u i *\<^sub>R x i) {1..k} \<in> s)"
   319 proof safe
   320   fix k :: nat
   321   fix u :: "nat \<Rightarrow> real"
   322   fix x
   323   assume "convex s"
   324     "\<forall>i. 1 \<le> i \<and> i \<le> k \<longrightarrow> 0 \<le> u i \<and> x i \<in> s"
   325     "sum u {1..k} = 1"
   326   with convex_sum[of "{1 .. k}" s] show "(\<Sum>j\<in>{1 .. k}. u j *\<^sub>R x j) \<in> s"
   327     by auto
   328 next
   329   assume *: "\<forall>k u x. (\<forall> i :: nat. 1 \<le> i \<and> i \<le> k \<longrightarrow> 0 \<le> u i \<and> x i \<in> s) \<and> sum u {1..k} = 1
   330     \<longrightarrow> (\<Sum>i = 1..k. u i *\<^sub>R (x i :: 'a)) \<in> s"
   331   {
   332     fix \<mu> :: real
   333     fix x y :: 'a
   334     assume xy: "x \<in> s" "y \<in> s"
   335     assume mu: "\<mu> \<ge> 0" "\<mu> \<le> 1"
   336     let ?u = "\<lambda>i. if (i :: nat) = 1 then \<mu> else 1 - \<mu>"
   337     let ?x = "\<lambda>i. if (i :: nat) = 1 then x else y"
   338     have "{1 :: nat .. 2} \<inter> - {x. x = 1} = {2}"
   339       by auto
   340     then have card: "card ({1 :: nat .. 2} \<inter> - {x. x = 1}) = 1"
   341       by simp
   342     then have "sum ?u {1 .. 2} = 1"
   343       using sum.If_cases[of "{(1 :: nat) .. 2}" "\<lambda> x. x = 1" "\<lambda> x. \<mu>" "\<lambda> x. 1 - \<mu>"]
   344       by auto
   345     with *[rule_format, of "2" ?u ?x] have s: "(\<Sum>j \<in> {1..2}. ?u j *\<^sub>R ?x j) \<in> s"
   346       using mu xy by auto
   347     have grarr: "(\<Sum>j \<in> {Suc (Suc 0)..2}. ?u j *\<^sub>R ?x j) = (1 - \<mu>) *\<^sub>R y"
   348       using sum_head_Suc[of "Suc (Suc 0)" 2 "\<lambda> j. (1 - \<mu>) *\<^sub>R y"] by auto
   349     from sum_head_Suc[of "Suc 0" 2 "\<lambda> j. ?u j *\<^sub>R ?x j", simplified this]
   350     have "(\<Sum>j \<in> {1..2}. ?u j *\<^sub>R ?x j) = \<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y"
   351       by auto
   352     then have "(1 - \<mu>) *\<^sub>R y + \<mu> *\<^sub>R x \<in> s"
   353       using s by (auto simp: add.commute)
   354   }
   355   then show "convex s"
   356     unfolding convex_alt by auto
   357 qed
   358 
   359 
   360 lemma convex_explicit:
   361   fixes s :: "'a::real_vector set"
   362   shows "convex s \<longleftrightarrow>
   363     (\<forall>t u. finite t \<and> t \<subseteq> s \<and> (\<forall>x\<in>t. 0 \<le> u x) \<and> sum u t = 1 \<longrightarrow> sum (\<lambda>x. u x *\<^sub>R x) t \<in> s)"
   364 proof safe
   365   fix t
   366   fix u :: "'a \<Rightarrow> real"
   367   assume "convex s"
   368     and "finite t"
   369     and "t \<subseteq> s" "\<forall>x\<in>t. 0 \<le> u x" "sum u t = 1"
   370   then show "(\<Sum>x\<in>t. u x *\<^sub>R x) \<in> s"
   371     using convex_sum[of t s u "\<lambda> x. x"] by auto
   372 next
   373   assume *: "\<forall>t. \<forall> u. finite t \<and> t \<subseteq> s \<and> (\<forall>x\<in>t. 0 \<le> u x) \<and>
   374     sum u t = 1 \<longrightarrow> (\<Sum>x\<in>t. u x *\<^sub>R x) \<in> s"
   375   show "convex s"
   376     unfolding convex_alt
   377   proof safe
   378     fix x y
   379     fix \<mu> :: real
   380     assume **: "x \<in> s" "y \<in> s" "0 \<le> \<mu>" "\<mu> \<le> 1"
   381     show "(1 - \<mu>) *\<^sub>R x + \<mu> *\<^sub>R y \<in> s"
   382     proof (cases "x = y")
   383       case False
   384       then show ?thesis
   385         using *[rule_format, of "{x, y}" "\<lambda> z. if z = x then 1 - \<mu> else \<mu>"] **
   386         by auto
   387     next
   388       case True
   389       then show ?thesis
   390         using *[rule_format, of "{x, y}" "\<lambda> z. 1"] **
   391         by (auto simp: field_simps real_vector.scale_left_diff_distrib)
   392     qed
   393   qed
   394 qed
   395 
   396 lemma convex_finite:
   397   assumes "finite s"
   398   shows "convex s \<longleftrightarrow> (\<forall>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> sum u s = 1 \<longrightarrow> sum (\<lambda>x. u x *\<^sub>R x) s \<in> s)"
   399   unfolding convex_explicit
   400   apply safe
   401   subgoal for u by (erule allE [where x=s], erule allE [where x=u]) auto
   402   subgoal for t u
   403   proof -
   404     have if_distrib_arg: "\<And>P f g x. (if P then f else g) x = (if P then f x else g x)"
   405       by simp
   406     assume sum: "\<forall>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> sum u s = 1 \<longrightarrow> (\<Sum>x\<in>s. u x *\<^sub>R x) \<in> s"
   407     assume *: "\<forall>x\<in>t. 0 \<le> u x" "sum u t = 1"
   408     assume "t \<subseteq> s"
   409     then have "s \<inter> t = t" by auto
   410     with sum[THEN spec[where x="\<lambda>x. if x\<in>t then u x else 0"]] * show "(\<Sum>x\<in>t. u x *\<^sub>R x) \<in> s"
   411       by (auto simp: assms sum.If_cases if_distrib if_distrib_arg)
   412   qed
   413   done
   414 
   415 
   416 subsection \<open>Functions that are convex on a set\<close>
   417 
   418 definition%important convex_on :: "'a::real_vector set \<Rightarrow> ('a \<Rightarrow> real) \<Rightarrow> bool"
   419   where "convex_on s f \<longleftrightarrow>
   420     (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u\<ge>0. \<forall>v\<ge>0. u + v = 1 \<longrightarrow> f (u *\<^sub>R x + v *\<^sub>R y) \<le> u * f x + v * f y)"
   421 
   422 lemma convex_onI [intro?]:
   423   assumes "\<And>t x y. t > 0 \<Longrightarrow> t < 1 \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow>
   424     f ((1 - t) *\<^sub>R x + t *\<^sub>R y) \<le> (1 - t) * f x + t * f y"
   425   shows "convex_on A f"
   426   unfolding convex_on_def
   427 proof clarify
   428   fix x y
   429   fix u v :: real
   430   assume A: "x \<in> A" "y \<in> A" "u \<ge> 0" "v \<ge> 0" "u + v = 1"
   431   from A(5) have [simp]: "v = 1 - u"
   432     by (simp add: algebra_simps)
   433   from A(1-4) show "f (u *\<^sub>R x + v *\<^sub>R y) \<le> u * f x + v * f y"
   434     using assms[of u y x]
   435     by (cases "u = 0 \<or> u = 1") (auto simp: algebra_simps)
   436 qed
   437 
   438 lemma convex_on_linorderI [intro?]:
   439   fixes A :: "('a::{linorder,real_vector}) set"
   440   assumes "\<And>t x y. t > 0 \<Longrightarrow> t < 1 \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x < y \<Longrightarrow>
   441     f ((1 - t) *\<^sub>R x + t *\<^sub>R y) \<le> (1 - t) * f x + t * f y"
   442   shows "convex_on A f"
   443 proof
   444   fix x y
   445   fix t :: real
   446   assume A: "x \<in> A" "y \<in> A" "t > 0" "t < 1"
   447   with assms [of t x y] assms [of "1 - t" y x]
   448   show "f ((1 - t) *\<^sub>R x + t *\<^sub>R y) \<le> (1 - t) * f x + t * f y"
   449     by (cases x y rule: linorder_cases) (auto simp: algebra_simps)
   450 qed
   451 
   452 lemma convex_onD:
   453   assumes "convex_on A f"
   454   shows "\<And>t x y. t \<ge> 0 \<Longrightarrow> t \<le> 1 \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow>
   455     f ((1 - t) *\<^sub>R x + t *\<^sub>R y) \<le> (1 - t) * f x + t * f y"
   456   using assms by (auto simp: convex_on_def)
   457 
   458 lemma convex_onD_Icc:
   459   assumes "convex_on {x..y} f" "x \<le> (y :: _ :: {real_vector,preorder})"
   460   shows "\<And>t. t \<ge> 0 \<Longrightarrow> t \<le> 1 \<Longrightarrow>
   461     f ((1 - t) *\<^sub>R x + t *\<^sub>R y) \<le> (1 - t) * f x + t * f y"
   462   using assms(2) by (intro convex_onD [OF assms(1)]) simp_all
   463 
   464 lemma convex_on_subset: "convex_on t f \<Longrightarrow> s \<subseteq> t \<Longrightarrow> convex_on s f"
   465   unfolding convex_on_def by auto
   466 
   467 lemma convex_on_add [intro]:
   468   assumes "convex_on s f"
   469     and "convex_on s g"
   470   shows "convex_on s (\<lambda>x. f x + g x)"
   471 proof -
   472   {
   473     fix x y
   474     assume "x \<in> s" "y \<in> s"
   475     moreover
   476     fix u v :: real
   477     assume "0 \<le> u" "0 \<le> v" "u + v = 1"
   478     ultimately
   479     have "f (u *\<^sub>R x + v *\<^sub>R y) + g (u *\<^sub>R x + v *\<^sub>R y) \<le> (u * f x + v * f y) + (u * g x + v * g y)"
   480       using assms unfolding convex_on_def by (auto simp: add_mono)
   481     then have "f (u *\<^sub>R x + v *\<^sub>R y) + g (u *\<^sub>R x + v *\<^sub>R y) \<le> u * (f x + g x) + v * (f y + g y)"
   482       by (simp add: field_simps)
   483   }
   484   then show ?thesis
   485     unfolding convex_on_def by auto
   486 qed
   487 
   488 lemma convex_on_cmul [intro]:
   489   fixes c :: real
   490   assumes "0 \<le> c"
   491     and "convex_on s f"
   492   shows "convex_on s (\<lambda>x. c * f x)"
   493 proof -
   494   have *: "u * (c * fx) + v * (c * fy) = c * (u * fx + v * fy)"
   495     for u c fx v fy :: real
   496     by (simp add: field_simps)
   497   show ?thesis using assms(2) and mult_left_mono [OF _ assms(1)]
   498     unfolding convex_on_def and * by auto
   499 qed
   500 
   501 lemma convex_lower:
   502   assumes "convex_on s f"
   503     and "x \<in> s"
   504     and "y \<in> s"
   505     and "0 \<le> u"
   506     and "0 \<le> v"
   507     and "u + v = 1"
   508   shows "f (u *\<^sub>R x + v *\<^sub>R y) \<le> max (f x) (f y)"
   509 proof -
   510   let ?m = "max (f x) (f y)"
   511   have "u * f x + v * f y \<le> u * max (f x) (f y) + v * max (f x) (f y)"
   512     using assms(4,5) by (auto simp: mult_left_mono add_mono)
   513   also have "\<dots> = max (f x) (f y)"
   514     using assms(6) by (simp add: distrib_right [symmetric])
   515   finally show ?thesis
   516     using assms unfolding convex_on_def by fastforce
   517 qed
   518 
   519 lemma convex_on_dist [intro]:
   520   fixes s :: "'a::real_normed_vector set"
   521   shows "convex_on s (\<lambda>x. dist a x)"
   522 proof (auto simp: convex_on_def dist_norm)
   523   fix x y
   524   assume "x \<in> s" "y \<in> s"
   525   fix u v :: real
   526   assume "0 \<le> u"
   527   assume "0 \<le> v"
   528   assume "u + v = 1"
   529   have "a = u *\<^sub>R a + v *\<^sub>R a"
   530     unfolding scaleR_left_distrib[symmetric] and \<open>u + v = 1\<close> by simp
   531   then have *: "a - (u *\<^sub>R x + v *\<^sub>R y) = (u *\<^sub>R (a - x)) + (v *\<^sub>R (a - y))"
   532     by (auto simp: algebra_simps)
   533   show "norm (a - (u *\<^sub>R x + v *\<^sub>R y)) \<le> u * norm (a - x) + v * norm (a - y)"
   534     unfolding * using norm_triangle_ineq[of "u *\<^sub>R (a - x)" "v *\<^sub>R (a - y)"]
   535     using \<open>0 \<le> u\<close> \<open>0 \<le> v\<close> by auto
   536 qed
   537 
   538 
   539 subsection%unimportant \<open>Arithmetic operations on sets preserve convexity\<close>
   540 
   541 lemma convex_linear_image:
   542   assumes "linear f"
   543     and "convex s"
   544   shows "convex (f ` s)"
   545 proof -
   546   interpret f: linear f by fact
   547   from \<open>convex s\<close> show "convex (f ` s)"
   548     by (simp add: convex_def f.scaleR [symmetric] f.add [symmetric])
   549 qed
   550 
   551 lemma convex_linear_vimage:
   552   assumes "linear f"
   553     and "convex s"
   554   shows "convex (f -` s)"
   555 proof -
   556   interpret f: linear f by fact
   557   from \<open>convex s\<close> show "convex (f -` s)"
   558     by (simp add: convex_def f.add f.scaleR)
   559 qed
   560 
   561 lemma convex_scaling:
   562   assumes "convex s"
   563   shows "convex ((\<lambda>x. c *\<^sub>R x) ` s)"
   564 proof -
   565   have "linear (\<lambda>x. c *\<^sub>R x)"
   566     by (simp add: linearI scaleR_add_right)
   567   then show ?thesis
   568     using \<open>convex s\<close> by (rule convex_linear_image)
   569 qed
   570 
   571 lemma convex_scaled:
   572   assumes "convex S"
   573   shows "convex ((\<lambda>x. x *\<^sub>R c) ` S)"
   574 proof -
   575   have "linear (\<lambda>x. x *\<^sub>R c)"
   576     by (simp add: linearI scaleR_add_left)
   577   then show ?thesis
   578     using \<open>convex S\<close> by (rule convex_linear_image)
   579 qed
   580 
   581 lemma convex_negations:
   582   assumes "convex S"
   583   shows "convex ((\<lambda>x. - x) ` S)"
   584 proof -
   585   have "linear (\<lambda>x. - x)"
   586     by (simp add: linearI)
   587   then show ?thesis
   588     using \<open>convex S\<close> by (rule convex_linear_image)
   589 qed
   590 
   591 lemma convex_sums:
   592   assumes "convex S"
   593     and "convex T"
   594   shows "convex (\<Union>x\<in> S. \<Union>y \<in> T. {x + y})"
   595 proof -
   596   have "linear (\<lambda>(x, y). x + y)"
   597     by (auto intro: linearI simp: scaleR_add_right)
   598   with assms have "convex ((\<lambda>(x, y). x + y) ` (S \<times> T))"
   599     by (intro convex_linear_image convex_Times)
   600   also have "((\<lambda>(x, y). x + y) ` (S \<times> T)) = (\<Union>x\<in> S. \<Union>y \<in> T. {x + y})"
   601     by auto
   602   finally show ?thesis .
   603 qed
   604 
   605 lemma convex_differences:
   606   assumes "convex S" "convex T"
   607   shows "convex (\<Union>x\<in> S. \<Union>y \<in> T. {x - y})"
   608 proof -
   609   have "{x - y| x y. x \<in> S \<and> y \<in> T} = {x + y |x y. x \<in> S \<and> y \<in> uminus ` T}"
   610     by (auto simp: diff_conv_add_uminus simp del: add_uminus_conv_diff)
   611   then show ?thesis
   612     using convex_sums[OF assms(1) convex_negations[OF assms(2)]] by auto
   613 qed
   614 
   615 lemma convex_translation:
   616   assumes "convex S"
   617   shows "convex ((\<lambda>x. a + x) ` S)"
   618 proof -
   619   have "(\<Union> x\<in> {a}. \<Union>y \<in> S. {x + y}) = (\<lambda>x. a + x) ` S"
   620     by auto
   621   then show ?thesis
   622     using convex_sums[OF convex_singleton[of a] assms] by auto
   623 qed
   624 
   625 lemma convex_affinity:
   626   assumes "convex S"
   627   shows "convex ((\<lambda>x. a + c *\<^sub>R x) ` S)"
   628 proof -
   629   have "(\<lambda>x. a + c *\<^sub>R x) ` S = (+) a ` (*\<^sub>R) c ` S"
   630     by auto
   631   then show ?thesis
   632     using convex_translation[OF convex_scaling[OF assms], of a c] by auto
   633 qed
   634 
   635 lemma pos_is_convex: "convex {0 :: real <..}"
   636   unfolding convex_alt
   637 proof safe
   638   fix y x \<mu> :: real
   639   assume *: "y > 0" "x > 0" "\<mu> \<ge> 0" "\<mu> \<le> 1"
   640   {
   641     assume "\<mu> = 0"
   642     then have "\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y = y"
   643       by simp
   644     then have "\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y > 0"
   645       using * by simp
   646   }
   647   moreover
   648   {
   649     assume "\<mu> = 1"
   650     then have "\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y > 0"
   651       using * by simp
   652   }
   653   moreover
   654   {
   655     assume "\<mu> \<noteq> 1" "\<mu> \<noteq> 0"
   656     then have "\<mu> > 0" "(1 - \<mu>) > 0"
   657       using * by auto
   658     then have "\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y > 0"
   659       using * by (auto simp: add_pos_pos)
   660   }
   661   ultimately show "(1 - \<mu>) *\<^sub>R y + \<mu> *\<^sub>R x > 0"
   662     by fastforce
   663 qed
   664 
   665 lemma convex_on_sum:
   666   fixes a :: "'a \<Rightarrow> real"
   667     and y :: "'a \<Rightarrow> 'b::real_vector"
   668     and f :: "'b \<Rightarrow> real"
   669   assumes "finite s" "s \<noteq> {}"
   670     and "convex_on C f"
   671     and "convex C"
   672     and "(\<Sum> i \<in> s. a i) = 1"
   673     and "\<And>i. i \<in> s \<Longrightarrow> a i \<ge> 0"
   674     and "\<And>i. i \<in> s \<Longrightarrow> y i \<in> C"
   675   shows "f (\<Sum> i \<in> s. a i *\<^sub>R y i) \<le> (\<Sum> i \<in> s. a i * f (y i))"
   676   using assms
   677 proof (induct s arbitrary: a rule: finite_ne_induct)
   678   case (singleton i)
   679   then have ai: "a i = 1"
   680     by auto
   681   then show ?case
   682     by auto
   683 next
   684   case (insert i s)
   685   then have "convex_on C f"
   686     by simp
   687   from this[unfolded convex_on_def, rule_format]
   688   have conv: "\<And>x y \<mu>. x \<in> C \<Longrightarrow> y \<in> C \<Longrightarrow> 0 \<le> \<mu> \<Longrightarrow> \<mu> \<le> 1 \<Longrightarrow>
   689       f (\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y) \<le> \<mu> * f x + (1 - \<mu>) * f y"
   690     by simp
   691   show ?case
   692   proof (cases "a i = 1")
   693     case True
   694     then have "(\<Sum> j \<in> s. a j) = 0"
   695       using insert by auto
   696     then have "\<And>j. j \<in> s \<Longrightarrow> a j = 0"
   697       using insert by (fastforce simp: sum_nonneg_eq_0_iff)
   698     then show ?thesis
   699       using insert by auto
   700   next
   701     case False
   702     from insert have yai: "y i \<in> C" "a i \<ge> 0"
   703       by auto
   704     have fis: "finite (insert i s)"
   705       using insert by auto
   706     then have ai1: "a i \<le> 1"
   707       using sum_nonneg_leq_bound[of "insert i s" a] insert by simp
   708     then have "a i < 1"
   709       using False by auto
   710     then have i0: "1 - a i > 0"
   711       by auto
   712     let ?a = "\<lambda>j. a j / (1 - a i)"
   713     have a_nonneg: "?a j \<ge> 0" if "j \<in> s" for j
   714       using i0 insert that by fastforce
   715     have "(\<Sum> j \<in> insert i s. a j) = 1"
   716       using insert by auto
   717     then have "(\<Sum> j \<in> s. a j) = 1 - a i"
   718       using sum.insert insert by fastforce
   719     then have "(\<Sum> j \<in> s. a j) / (1 - a i) = 1"
   720       using i0 by auto
   721     then have a1: "(\<Sum> j \<in> s. ?a j) = 1"
   722       unfolding sum_divide_distrib by simp
   723     have "convex C" using insert by auto
   724     then have asum: "(\<Sum> j \<in> s. ?a j *\<^sub>R y j) \<in> C"
   725       using insert convex_sum [OF \<open>finite s\<close> \<open>convex C\<close> a1 a_nonneg] by auto
   726     have asum_le: "f (\<Sum> j \<in> s. ?a j *\<^sub>R y j) \<le> (\<Sum> j \<in> s. ?a j * f (y j))"
   727       using a_nonneg a1 insert by blast
   728     have "f (\<Sum> j \<in> insert i s. a j *\<^sub>R y j) = f ((\<Sum> j \<in> s. a j *\<^sub>R y j) + a i *\<^sub>R y i)"
   729       using sum.insert[of s i "\<lambda> j. a j *\<^sub>R y j", OF \<open>finite s\<close> \<open>i \<notin> s\<close>] insert
   730       by (auto simp only: add.commute)
   731     also have "\<dots> = f (((1 - a i) * inverse (1 - a i)) *\<^sub>R (\<Sum> j \<in> s. a j *\<^sub>R y j) + a i *\<^sub>R y i)"
   732       using i0 by auto
   733     also have "\<dots> = f ((1 - a i) *\<^sub>R (\<Sum> j \<in> s. (a j * inverse (1 - a i)) *\<^sub>R y j) + a i *\<^sub>R y i)"
   734       using scaleR_right.sum[of "inverse (1 - a i)" "\<lambda> j. a j *\<^sub>R y j" s, symmetric]
   735       by (auto simp: algebra_simps)
   736     also have "\<dots> = f ((1 - a i) *\<^sub>R (\<Sum> j \<in> s. ?a j *\<^sub>R y j) + a i *\<^sub>R y i)"
   737       by (auto simp: divide_inverse)
   738     also have "\<dots> \<le> (1 - a i) *\<^sub>R f ((\<Sum> j \<in> s. ?a j *\<^sub>R y j)) + a i * f (y i)"
   739       using conv[of "y i" "(\<Sum> j \<in> s. ?a j *\<^sub>R y j)" "a i", OF yai(1) asum yai(2) ai1]
   740       by (auto simp: add.commute)
   741     also have "\<dots> \<le> (1 - a i) * (\<Sum> j \<in> s. ?a j * f (y j)) + a i * f (y i)"
   742       using add_right_mono [OF mult_left_mono [of _ _ "1 - a i",
   743             OF asum_le less_imp_le[OF i0]], of "a i * f (y i)"]
   744       by simp
   745     also have "\<dots> = (\<Sum> j \<in> s. (1 - a i) * ?a j * f (y j)) + a i * f (y i)"
   746       unfolding sum_distrib_left[of "1 - a i" "\<lambda> j. ?a j * f (y j)"]
   747       using i0 by auto
   748     also have "\<dots> = (\<Sum> j \<in> s. a j * f (y j)) + a i * f (y i)"
   749       using i0 by auto
   750     also have "\<dots> = (\<Sum> j \<in> insert i s. a j * f (y j))"
   751       using insert by auto
   752     finally show ?thesis
   753       by simp
   754   qed
   755 qed
   756 
   757 lemma convex_on_alt:
   758   fixes C :: "'a::real_vector set"
   759   assumes "convex C"
   760   shows "convex_on C f \<longleftrightarrow>
   761     (\<forall>x \<in> C. \<forall> y \<in> C. \<forall> \<mu> :: real. \<mu> \<ge> 0 \<and> \<mu> \<le> 1 \<longrightarrow>
   762       f (\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y) \<le> \<mu> * f x + (1 - \<mu>) * f y)"
   763 proof safe
   764   fix x y
   765   fix \<mu> :: real
   766   assume *: "convex_on C f" "x \<in> C" "y \<in> C" "0 \<le> \<mu>" "\<mu> \<le> 1"
   767   from this[unfolded convex_on_def, rule_format]
   768   have "0 \<le> u \<Longrightarrow> 0 \<le> v \<Longrightarrow> u + v = 1 \<Longrightarrow> f (u *\<^sub>R x + v *\<^sub>R y) \<le> u * f x + v * f y" for u v
   769     by auto
   770   from this [of "\<mu>" "1 - \<mu>", simplified] *
   771   show "f (\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y) \<le> \<mu> * f x + (1 - \<mu>) * f y"
   772     by auto
   773 next
   774   assume *: "\<forall>x\<in>C. \<forall>y\<in>C. \<forall>\<mu>. 0 \<le> \<mu> \<and> \<mu> \<le> 1 \<longrightarrow>
   775     f (\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y) \<le> \<mu> * f x + (1 - \<mu>) * f y"
   776   {
   777     fix x y
   778     fix u v :: real
   779     assume **: "x \<in> C" "y \<in> C" "u \<ge> 0" "v \<ge> 0" "u + v = 1"
   780     then have[simp]: "1 - u = v" by auto
   781     from *[rule_format, of x y u]
   782     have "f (u *\<^sub>R x + v *\<^sub>R y) \<le> u * f x + v * f y"
   783       using ** by auto
   784   }
   785   then show "convex_on C f"
   786     unfolding convex_on_def by auto
   787 qed
   788 
   789 lemma convex_on_diff:
   790   fixes f :: "real \<Rightarrow> real"
   791   assumes f: "convex_on I f"
   792     and I: "x \<in> I" "y \<in> I"
   793     and t: "x < t" "t < y"
   794   shows "(f x - f t) / (x - t) \<le> (f x - f y) / (x - y)"
   795     and "(f x - f y) / (x - y) \<le> (f t - f y) / (t - y)"
   796 proof -
   797   define a where "a \<equiv> (t - y) / (x - y)"
   798   with t have "0 \<le> a" "0 \<le> 1 - a"
   799     by (auto simp: field_simps)
   800   with f \<open>x \<in> I\<close> \<open>y \<in> I\<close> have cvx: "f (a * x + (1 - a) * y) \<le> a * f x + (1 - a) * f y"
   801     by (auto simp: convex_on_def)
   802   have "a * x + (1 - a) * y = a * (x - y) + y"
   803     by (simp add: field_simps)
   804   also have "\<dots> = t"
   805     unfolding a_def using \<open>x < t\<close> \<open>t < y\<close> by simp
   806   finally have "f t \<le> a * f x + (1 - a) * f y"
   807     using cvx by simp
   808   also have "\<dots> = a * (f x - f y) + f y"
   809     by (simp add: field_simps)
   810   finally have "f t - f y \<le> a * (f x - f y)"
   811     by simp
   812   with t show "(f x - f t) / (x - t) \<le> (f x - f y) / (x - y)"
   813     by (simp add: le_divide_eq divide_le_eq field_simps a_def)
   814   with t show "(f x - f y) / (x - y) \<le> (f t - f y) / (t - y)"
   815     by (simp add: le_divide_eq divide_le_eq field_simps)
   816 qed
   817 
   818 lemma pos_convex_function:
   819   fixes f :: "real \<Rightarrow> real"
   820   assumes "convex C"
   821     and leq: "\<And>x y. x \<in> C \<Longrightarrow> y \<in> C \<Longrightarrow> f' x * (y - x) \<le> f y - f x"
   822   shows "convex_on C f"
   823   unfolding convex_on_alt[OF assms(1)]
   824   using assms
   825 proof safe
   826   fix x y \<mu> :: real
   827   let ?x = "\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y"
   828   assume *: "convex C" "x \<in> C" "y \<in> C" "\<mu> \<ge> 0" "\<mu> \<le> 1"
   829   then have "1 - \<mu> \<ge> 0" by auto
   830   then have xpos: "?x \<in> C"
   831     using * unfolding convex_alt by fastforce
   832   have geq: "\<mu> * (f x - f ?x) + (1 - \<mu>) * (f y - f ?x) \<ge>
   833       \<mu> * f' ?x * (x - ?x) + (1 - \<mu>) * f' ?x * (y - ?x)"
   834     using add_mono [OF mult_left_mono [OF leq [OF xpos *(2)] \<open>\<mu> \<ge> 0\<close>]
   835         mult_left_mono [OF leq [OF xpos *(3)] \<open>1 - \<mu> \<ge> 0\<close>]]
   836     by auto
   837   then have "\<mu> * f x + (1 - \<mu>) * f y - f ?x \<ge> 0"
   838     by (auto simp: field_simps)
   839   then show "f (\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y) \<le> \<mu> * f x + (1 - \<mu>) * f y"
   840     using convex_on_alt by auto
   841 qed
   842 
   843 lemma atMostAtLeast_subset_convex:
   844   fixes C :: "real set"
   845   assumes "convex C"
   846     and "x \<in> C" "y \<in> C" "x < y"
   847   shows "{x .. y} \<subseteq> C"
   848 proof safe
   849   fix z assume z: "z \<in> {x .. y}"
   850   have less: "z \<in> C" if *: "x < z" "z < y"
   851   proof -
   852     let ?\<mu> = "(y - z) / (y - x)"
   853     have "0 \<le> ?\<mu>" "?\<mu> \<le> 1"
   854       using assms * by (auto simp: field_simps)
   855     then have comb: "?\<mu> * x + (1 - ?\<mu>) * y \<in> C"
   856       using assms iffD1[OF convex_alt, rule_format, of C y x ?\<mu>]
   857       by (simp add: algebra_simps)
   858     have "?\<mu> * x + (1 - ?\<mu>) * y = (y - z) * x / (y - x) + (1 - (y - z) / (y - x)) * y"
   859       by (auto simp: field_simps)
   860     also have "\<dots> = ((y - z) * x + (y - x - (y - z)) * y) / (y - x)"
   861       using assms by (simp only: add_divide_distrib) (auto simp: field_simps)
   862     also have "\<dots> = z"
   863       using assms by (auto simp: field_simps)
   864     finally show ?thesis
   865       using comb by auto
   866   qed
   867   show "z \<in> C"
   868     using z less assms by (auto simp: le_less)
   869 qed
   870 
   871 lemma f''_imp_f':
   872   fixes f :: "real \<Rightarrow> real"
   873   assumes "convex C"
   874     and f': "\<And>x. x \<in> C \<Longrightarrow> DERIV f x :> (f' x)"
   875     and f'': "\<And>x. x \<in> C \<Longrightarrow> DERIV f' x :> (f'' x)"
   876     and pos: "\<And>x. x \<in> C \<Longrightarrow> f'' x \<ge> 0"
   877     and x: "x \<in> C"
   878     and y: "y \<in> C"
   879   shows "f' x * (y - x) \<le> f y - f x"
   880   using assms
   881 proof -
   882   have less_imp: "f y - f x \<ge> f' x * (y - x)" "f' y * (x - y) \<le> f x - f y"
   883     if *: "x \<in> C" "y \<in> C" "y > x" for x y :: real
   884   proof -
   885     from * have ge: "y - x > 0" "y - x \<ge> 0"
   886       by auto
   887     from * have le: "x - y < 0" "x - y \<le> 0"
   888       by auto
   889     then obtain z1 where z1: "z1 > x" "z1 < y" "f y - f x = (y - x) * f' z1"
   890       using subsetD[OF atMostAtLeast_subset_convex[OF \<open>convex C\<close> \<open>x \<in> C\<close> \<open>y \<in> C\<close> \<open>x < y\<close>],
   891           THEN f', THEN MVT2[OF \<open>x < y\<close>, rule_format, unfolded atLeastAtMost_iff[symmetric]]]
   892       by auto
   893     then have "z1 \<in> C"
   894       using atMostAtLeast_subset_convex \<open>convex C\<close> \<open>x \<in> C\<close> \<open>y \<in> C\<close> \<open>x < y\<close>
   895       by fastforce
   896     from z1 have z1': "f x - f y = (x - y) * f' z1"
   897       by (simp add: field_simps)
   898     obtain z2 where z2: "z2 > x" "z2 < z1" "f' z1 - f' x = (z1 - x) * f'' z2"
   899       using subsetD[OF atMostAtLeast_subset_convex[OF \<open>convex C\<close> \<open>x \<in> C\<close> \<open>z1 \<in> C\<close> \<open>x < z1\<close>],
   900           THEN f'', THEN MVT2[OF \<open>x < z1\<close>, rule_format, unfolded atLeastAtMost_iff[symmetric]]] z1
   901       by auto
   902     obtain z3 where z3: "z3 > z1" "z3 < y" "f' y - f' z1 = (y - z1) * f'' z3"
   903       using subsetD[OF atMostAtLeast_subset_convex[OF \<open>convex C\<close> \<open>z1 \<in> C\<close> \<open>y \<in> C\<close> \<open>z1 < y\<close>],
   904           THEN f'', THEN MVT2[OF \<open>z1 < y\<close>, rule_format, unfolded atLeastAtMost_iff[symmetric]]] z1
   905       by auto
   906     have "f' y - (f x - f y) / (x - y) = f' y - f' z1"
   907       using * z1' by auto
   908     also have "\<dots> = (y - z1) * f'' z3"
   909       using z3 by auto
   910     finally have cool': "f' y - (f x - f y) / (x - y) = (y - z1) * f'' z3"
   911       by simp
   912     have A': "y - z1 \<ge> 0"
   913       using z1 by auto
   914     have "z3 \<in> C"
   915       using z3 * atMostAtLeast_subset_convex \<open>convex C\<close> \<open>x \<in> C\<close> \<open>z1 \<in> C\<close> \<open>x < z1\<close>
   916       by fastforce
   917     then have B': "f'' z3 \<ge> 0"
   918       using assms by auto
   919     from A' B' have "(y - z1) * f'' z3 \<ge> 0"
   920       by auto
   921     from cool' this have "f' y - (f x - f y) / (x - y) \<ge> 0"
   922       by auto
   923     from mult_right_mono_neg[OF this le(2)]
   924     have "f' y * (x - y) - (f x - f y) / (x - y) * (x - y) \<le> 0 * (x - y)"
   925       by (simp add: algebra_simps)
   926     then have "f' y * (x - y) - (f x - f y) \<le> 0"
   927       using le by auto
   928     then have res: "f' y * (x - y) \<le> f x - f y"
   929       by auto
   930     have "(f y - f x) / (y - x) - f' x = f' z1 - f' x"
   931       using * z1 by auto
   932     also have "\<dots> = (z1 - x) * f'' z2"
   933       using z2 by auto
   934     finally have cool: "(f y - f x) / (y - x) - f' x = (z1 - x) * f'' z2"
   935       by simp
   936     have A: "z1 - x \<ge> 0"
   937       using z1 by auto
   938     have "z2 \<in> C"
   939       using z2 z1 * atMostAtLeast_subset_convex \<open>convex C\<close> \<open>z1 \<in> C\<close> \<open>y \<in> C\<close> \<open>z1 < y\<close>
   940       by fastforce
   941     then have B: "f'' z2 \<ge> 0"
   942       using assms by auto
   943     from A B have "(z1 - x) * f'' z2 \<ge> 0"
   944       by auto
   945     with cool have "(f y - f x) / (y - x) - f' x \<ge> 0"
   946       by auto
   947     from mult_right_mono[OF this ge(2)]
   948     have "(f y - f x) / (y - x) * (y - x) - f' x * (y - x) \<ge> 0 * (y - x)"
   949       by (simp add: algebra_simps)
   950     then have "f y - f x - f' x * (y - x) \<ge> 0"
   951       using ge by auto
   952     then show "f y - f x \<ge> f' x * (y - x)" "f' y * (x - y) \<le> f x - f y"
   953       using res by auto
   954   qed
   955   show ?thesis
   956   proof (cases "x = y")
   957     case True
   958     with x y show ?thesis by auto
   959   next
   960     case False
   961     with less_imp x y show ?thesis
   962       by (auto simp: neq_iff)
   963   qed
   964 qed
   965 
   966 lemma f''_ge0_imp_convex:
   967   fixes f :: "real \<Rightarrow> real"
   968   assumes conv: "convex C"
   969     and f': "\<And>x. x \<in> C \<Longrightarrow> DERIV f x :> (f' x)"
   970     and f'': "\<And>x. x \<in> C \<Longrightarrow> DERIV f' x :> (f'' x)"
   971     and pos: "\<And>x. x \<in> C \<Longrightarrow> f'' x \<ge> 0"
   972   shows "convex_on C f"
   973   using f''_imp_f'[OF conv f' f'' pos] assms pos_convex_function
   974   by fastforce
   975 
   976 lemma minus_log_convex:
   977   fixes b :: real
   978   assumes "b > 1"
   979   shows "convex_on {0 <..} (\<lambda> x. - log b x)"
   980 proof -
   981   have "\<And>z. z > 0 \<Longrightarrow> DERIV (log b) z :> 1 / (ln b * z)"
   982     using DERIV_log by auto
   983   then have f': "\<And>z. z > 0 \<Longrightarrow> DERIV (\<lambda> z. - log b z) z :> - 1 / (ln b * z)"
   984     by (auto simp: DERIV_minus)
   985   have "\<And>z::real. z > 0 \<Longrightarrow> DERIV inverse z :> - (inverse z ^ Suc (Suc 0))"
   986     using less_imp_neq[THEN not_sym, THEN DERIV_inverse] by auto
   987   from this[THEN DERIV_cmult, of _ "- 1 / ln b"]
   988   have "\<And>z::real. z > 0 \<Longrightarrow>
   989     DERIV (\<lambda> z. (- 1 / ln b) * inverse z) z :> (- 1 / ln b) * (- (inverse z ^ Suc (Suc 0)))"
   990     by auto
   991   then have f''0: "\<And>z::real. z > 0 \<Longrightarrow>
   992     DERIV (\<lambda> z. - 1 / (ln b * z)) z :> 1 / (ln b * z * z)"
   993     unfolding inverse_eq_divide by (auto simp: mult.assoc)
   994   have f''_ge0: "\<And>z::real. z > 0 \<Longrightarrow> 1 / (ln b * z * z) \<ge> 0"
   995     using \<open>b > 1\<close> by (auto intro!: less_imp_le)
   996   from f''_ge0_imp_convex[OF pos_is_convex, unfolded greaterThan_iff, OF f' f''0 f''_ge0]
   997   show ?thesis
   998     by auto
   999 qed
  1000 
  1001 
  1002 subsection%unimportant \<open>Convexity of real functions\<close>
  1003 
  1004 lemma convex_on_realI:
  1005   assumes "connected A"
  1006     and "\<And>x. x \<in> A \<Longrightarrow> (f has_real_derivative f' x) (at x)"
  1007     and "\<And>x y. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<le> y \<Longrightarrow> f' x \<le> f' y"
  1008   shows "convex_on A f"
  1009 proof (rule convex_on_linorderI)
  1010   fix t x y :: real
  1011   assume t: "t > 0" "t < 1"
  1012   assume xy: "x \<in> A" "y \<in> A" "x < y"
  1013   define z where "z = (1 - t) * x + t * y"
  1014   with \<open>connected A\<close> and xy have ivl: "{x..y} \<subseteq> A"
  1015     using connected_contains_Icc by blast
  1016 
  1017   from xy t have xz: "z > x"
  1018     by (simp add: z_def algebra_simps)
  1019   have "y - z = (1 - t) * (y - x)"
  1020     by (simp add: z_def algebra_simps)
  1021   also from xy t have "\<dots> > 0"
  1022     by (intro mult_pos_pos) simp_all
  1023   finally have yz: "z < y"
  1024     by simp
  1025 
  1026   from assms xz yz ivl t have "\<exists>\<xi>. \<xi> > x \<and> \<xi> < z \<and> f z - f x = (z - x) * f' \<xi>"
  1027     by (intro MVT2) (auto intro!: assms(2))
  1028   then obtain \<xi> where \<xi>: "\<xi> > x" "\<xi> < z" "f' \<xi> = (f z - f x) / (z - x)"
  1029     by auto
  1030   from assms xz yz ivl t have "\<exists>\<eta>. \<eta> > z \<and> \<eta> < y \<and> f y - f z = (y - z) * f' \<eta>"
  1031     by (intro MVT2) (auto intro!: assms(2))
  1032   then obtain \<eta> where \<eta>: "\<eta> > z" "\<eta> < y" "f' \<eta> = (f y - f z) / (y - z)"
  1033     by auto
  1034 
  1035   from \<eta>(3) have "(f y - f z) / (y - z) = f' \<eta>" ..
  1036   also from \<xi> \<eta> ivl have "\<xi> \<in> A" "\<eta> \<in> A"
  1037     by auto
  1038   with \<xi> \<eta> have "f' \<eta> \<ge> f' \<xi>"
  1039     by (intro assms(3)) auto
  1040   also from \<xi>(3) have "f' \<xi> = (f z - f x) / (z - x)" .
  1041   finally have "(f y - f z) * (z - x) \<ge> (f z - f x) * (y - z)"
  1042     using xz yz by (simp add: field_simps)
  1043   also have "z - x = t * (y - x)"
  1044     by (simp add: z_def algebra_simps)
  1045   also have "y - z = (1 - t) * (y - x)"
  1046     by (simp add: z_def algebra_simps)
  1047   finally have "(f y - f z) * t \<ge> (f z - f x) * (1 - t)"
  1048     using xy by simp
  1049   then show "(1 - t) * f x + t * f y \<ge> f ((1 - t) *\<^sub>R x + t *\<^sub>R y)"
  1050     by (simp add: z_def algebra_simps)
  1051 qed
  1052 
  1053 lemma convex_on_inverse:
  1054   assumes "A \<subseteq> {0<..}"
  1055   shows "convex_on A (inverse :: real \<Rightarrow> real)"
  1056 proof (rule convex_on_subset[OF _ assms], intro convex_on_realI[of _ _ "\<lambda>x. -inverse (x^2)"])
  1057   fix u v :: real
  1058   assume "u \<in> {0<..}" "v \<in> {0<..}" "u \<le> v"
  1059   with assms show "-inverse (u^2) \<le> -inverse (v^2)"
  1060     by (intro le_imp_neg_le le_imp_inverse_le power_mono) (simp_all)
  1061 qed (insert assms, auto intro!: derivative_eq_intros simp: divide_simps power2_eq_square)
  1062 
  1063 lemma convex_onD_Icc':
  1064   assumes "convex_on {x..y} f" "c \<in> {x..y}"
  1065   defines "d \<equiv> y - x"
  1066   shows "f c \<le> (f y - f x) / d * (c - x) + f x"
  1067 proof (cases x y rule: linorder_cases)
  1068   case less
  1069   then have d: "d > 0"
  1070     by (simp add: d_def)
  1071   from assms(2) less have A: "0 \<le> (c - x) / d" "(c - x) / d \<le> 1"
  1072     by (simp_all add: d_def divide_simps)
  1073   have "f c = f (x + (c - x) * 1)"
  1074     by simp
  1075   also from less have "1 = ((y - x) / d)"
  1076     by (simp add: d_def)
  1077   also from d have "x + (c - x) * \<dots> = (1 - (c - x) / d) *\<^sub>R x + ((c - x) / d) *\<^sub>R y"
  1078     by (simp add: field_simps)
  1079   also have "f \<dots> \<le> (1 - (c - x) / d) * f x + (c - x) / d * f y"
  1080     using assms less by (intro convex_onD_Icc) simp_all
  1081   also from d have "\<dots> = (f y - f x) / d * (c - x) + f x"
  1082     by (simp add: field_simps)
  1083   finally show ?thesis .
  1084 qed (insert assms(2), simp_all)
  1085 
  1086 lemma convex_onD_Icc'':
  1087   assumes "convex_on {x..y} f" "c \<in> {x..y}"
  1088   defines "d \<equiv> y - x"
  1089   shows "f c \<le> (f x - f y) / d * (y - c) + f y"
  1090 proof (cases x y rule: linorder_cases)
  1091   case less
  1092   then have d: "d > 0"
  1093     by (simp add: d_def)
  1094   from assms(2) less have A: "0 \<le> (y - c) / d" "(y - c) / d \<le> 1"
  1095     by (simp_all add: d_def divide_simps)
  1096   have "f c = f (y - (y - c) * 1)"
  1097     by simp
  1098   also from less have "1 = ((y - x) / d)"
  1099     by (simp add: d_def)
  1100   also from d have "y - (y - c) * \<dots> = (1 - (1 - (y - c) / d)) *\<^sub>R x + (1 - (y - c) / d) *\<^sub>R y"
  1101     by (simp add: field_simps)
  1102   also have "f \<dots> \<le> (1 - (1 - (y - c) / d)) * f x + (1 - (y - c) / d) * f y"
  1103     using assms less by (intro convex_onD_Icc) (simp_all add: field_simps)
  1104   also from d have "\<dots> = (f x - f y) / d * (y - c) + f y"
  1105     by (simp add: field_simps)
  1106   finally show ?thesis .
  1107 qed (insert assms(2), simp_all)
  1108 
  1109 lemma convex_translation_eq [simp]: "convex ((\<lambda>x. a + x) ` s) \<longleftrightarrow> convex s"
  1110   by (metis convex_translation translation_galois)
  1111 
  1112 lemma convex_linear_image_eq [simp]:
  1113     fixes f :: "'a::real_vector \<Rightarrow> 'b::real_vector"
  1114     shows "\<lbrakk>linear f; inj f\<rbrakk> \<Longrightarrow> convex (f ` s) \<longleftrightarrow> convex s"
  1115     by (metis (no_types) convex_linear_image convex_linear_vimage inj_vimage_image_eq)
  1116 
  1117 lemma fst_linear: "linear fst"
  1118   unfolding linear_iff by (simp add: algebra_simps)
  1119 
  1120 lemma snd_linear: "linear snd"
  1121   unfolding linear_iff by (simp add: algebra_simps)
  1122 
  1123 lemma fst_snd_linear: "linear (\<lambda>(x,y). x + y)"
  1124   unfolding linear_iff by (simp add: algebra_simps)
  1125 
  1126 lemma vector_choose_size:
  1127   assumes "0 \<le> c"
  1128   obtains x :: "'a::{real_normed_vector, perfect_space}" where "norm x = c"
  1129 proof -
  1130   obtain a::'a where "a \<noteq> 0"
  1131     using UNIV_not_singleton UNIV_eq_I set_zero singletonI by fastforce
  1132   then show ?thesis
  1133     by (rule_tac x="scaleR (c / norm a) a" in that) (simp add: assms)
  1134 qed
  1135 
  1136 lemma vector_choose_dist:
  1137   assumes "0 \<le> c"
  1138   obtains y :: "'a::{real_normed_vector, perfect_space}" where "dist x y = c"
  1139 by (metis add_diff_cancel_left' assms dist_commute dist_norm vector_choose_size)
  1140 
  1141 lemma sum_delta_notmem:
  1142   assumes "x \<notin> s"
  1143   shows "sum (\<lambda>y. if (y = x) then P x else Q y) s = sum Q s"
  1144     and "sum (\<lambda>y. if (x = y) then P x else Q y) s = sum Q s"
  1145     and "sum (\<lambda>y. if (y = x) then P y else Q y) s = sum Q s"
  1146     and "sum (\<lambda>y. if (x = y) then P y else Q y) s = sum Q s"
  1147   apply (rule_tac [!] sum.cong)
  1148   using assms
  1149   apply auto
  1150   done
  1151 
  1152 lemma sum_delta'':
  1153   fixes s::"'a::real_vector set"
  1154   assumes "finite s"
  1155   shows "(\<Sum>x\<in>s. (if y = x then f x else 0) *\<^sub>R x) = (if y\<in>s then (f y) *\<^sub>R y else 0)"
  1156 proof -
  1157   have *: "\<And>x y. (if y = x then f x else (0::real)) *\<^sub>R x = (if x=y then (f x) *\<^sub>R x else 0)"
  1158     by auto
  1159   show ?thesis
  1160     unfolding * using sum.delta[OF assms, of y "\<lambda>x. f x *\<^sub>R x"] by auto
  1161 qed
  1162 
  1163 lemma if_smult: "(if P then x else (y::real)) *\<^sub>R v = (if P then x *\<^sub>R v else y *\<^sub>R v)"
  1164   by (fact if_distrib)
  1165 
  1166 lemma dist_triangle_eq:
  1167   fixes x y z :: "'a::real_inner"
  1168   shows "dist x z = dist x y + dist y z \<longleftrightarrow>
  1169     norm (x - y) *\<^sub>R (y - z) = norm (y - z) *\<^sub>R (x - y)"
  1170 proof -
  1171   have *: "x - y + (y - z) = x - z" by auto
  1172   show ?thesis unfolding dist_norm norm_triangle_eq[of "x - y" "y - z", unfolded *]
  1173     by (auto simp:norm_minus_commute)
  1174 qed
  1175 
  1176 
  1177 subsection \<open>Affine set and affine hull\<close>
  1178 
  1179 definition%important affine :: "'a::real_vector set \<Rightarrow> bool"
  1180   where "affine s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> s)"
  1181 
  1182 lemma affine_alt: "affine s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. \<forall>u::real. (1 - u) *\<^sub>R x + u *\<^sub>R y \<in> s)"
  1183   unfolding affine_def by (metis eq_diff_eq')
  1184 
  1185 lemma affine_empty [iff]: "affine {}"
  1186   unfolding affine_def by auto
  1187 
  1188 lemma affine_sing [iff]: "affine {x}"
  1189   unfolding affine_alt by (auto simp: scaleR_left_distrib [symmetric])
  1190 
  1191 lemma affine_UNIV [iff]: "affine UNIV"
  1192   unfolding affine_def by auto
  1193 
  1194 lemma affine_Inter [intro]: "(\<And>s. s\<in>f \<Longrightarrow> affine s) \<Longrightarrow> affine (\<Inter>f)"
  1195   unfolding affine_def by auto
  1196 
  1197 lemma affine_Int[intro]: "affine s \<Longrightarrow> affine t \<Longrightarrow> affine (s \<inter> t)"
  1198   unfolding affine_def by auto
  1199 
  1200 lemma affine_scaling: "affine s \<Longrightarrow> affine (image (\<lambda>x. c *\<^sub>R x) s)"
  1201   apply (clarsimp simp add: affine_def)
  1202   apply (rule_tac x="u *\<^sub>R x + v *\<^sub>R y" in image_eqI)
  1203   apply (auto simp: algebra_simps)
  1204   done
  1205 
  1206 lemma affine_affine_hull [simp]: "affine(affine hull s)"
  1207   unfolding hull_def
  1208   using affine_Inter[of "{t. affine t \<and> s \<subseteq> t}"] by auto
  1209 
  1210 lemma affine_hull_eq[simp]: "(affine hull s = s) \<longleftrightarrow> affine s"
  1211   by (metis affine_affine_hull hull_same)
  1212 
  1213 lemma affine_hyperplane: "affine {x. a \<bullet> x = b}"
  1214   by (simp add: affine_def algebra_simps) (metis distrib_right mult.left_neutral)
  1215 
  1216 
  1217 subsubsection%unimportant \<open>Some explicit formulations\<close>
  1218 
  1219 text "Formalized by Lars Schewe."
  1220 
  1221 lemma affine:
  1222   fixes V::"'a::real_vector set"
  1223   shows "affine V \<longleftrightarrow>
  1224          (\<forall>S u. finite S \<and> S \<noteq> {} \<and> S \<subseteq> V \<and> sum u S = 1 \<longrightarrow> (\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V)"
  1225 proof -
  1226   have "u *\<^sub>R x + v *\<^sub>R y \<in> V" if "x \<in> V" "y \<in> V" "u + v = (1::real)"
  1227     and *: "\<And>S u. \<lbrakk>finite S; S \<noteq> {}; S \<subseteq> V; sum u S = 1\<rbrakk> \<Longrightarrow> (\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V" for x y u v
  1228   proof (cases "x = y")
  1229     case True
  1230     then show ?thesis
  1231       using that by (metis scaleR_add_left scaleR_one)
  1232   next
  1233     case False
  1234     then show ?thesis
  1235       using that *[of "{x,y}" "\<lambda>w. if w = x then u else v"] by auto
  1236   qed
  1237   moreover have "(\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V"
  1238                 if *: "\<And>x y u v. \<lbrakk>x\<in>V; y\<in>V; u + v = 1\<rbrakk> \<Longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> V"
  1239                   and "finite S" "S \<noteq> {}" "S \<subseteq> V" "sum u S = 1" for S u
  1240   proof -
  1241     define n where "n = card S"
  1242     consider "card S = 0" | "card S = 1" | "card S = 2" | "card S > 2" by linarith
  1243     then show "(\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V"
  1244     proof cases
  1245       assume "card S = 1"
  1246       then obtain a where "S={a}"
  1247         by (auto simp: card_Suc_eq)
  1248       then show ?thesis
  1249         using that by simp
  1250     next
  1251       assume "card S = 2"
  1252       then obtain a b where "S = {a, b}"
  1253         by (metis Suc_1 card_1_singletonE card_Suc_eq)
  1254       then show ?thesis
  1255         using *[of a b] that
  1256         by (auto simp: sum_clauses(2))
  1257     next
  1258       assume "card S > 2"
  1259       then show ?thesis using that n_def
  1260       proof (induct n arbitrary: u S)
  1261         case 0
  1262         then show ?case by auto
  1263       next
  1264         case (Suc n u S)
  1265         have "sum u S = card S" if "\<not> (\<exists>x\<in>S. u x \<noteq> 1)"
  1266           using that unfolding card_eq_sum by auto
  1267         with Suc.prems obtain x where "x \<in> S" and x: "u x \<noteq> 1" by force
  1268         have c: "card (S - {x}) = card S - 1"
  1269           by (simp add: Suc.prems(3) \<open>x \<in> S\<close>)
  1270         have "sum u (S - {x}) = 1 - u x"
  1271           by (simp add: Suc.prems sum_diff1_ring \<open>x \<in> S\<close>)
  1272         with x have eq1: "inverse (1 - u x) * sum u (S - {x}) = 1"
  1273           by auto
  1274         have inV: "(\<Sum>y\<in>S - {x}. (inverse (1 - u x) * u y) *\<^sub>R y) \<in> V"
  1275         proof (cases "card (S - {x}) > 2")
  1276           case True
  1277           then have S: "S - {x} \<noteq> {}" "card (S - {x}) = n"
  1278             using Suc.prems c by force+
  1279           show ?thesis
  1280           proof (rule Suc.hyps)
  1281             show "(\<Sum>a\<in>S - {x}. inverse (1 - u x) * u a) = 1"
  1282               by (auto simp: eq1 sum_distrib_left[symmetric])
  1283           qed (use S Suc.prems True in auto)
  1284         next
  1285           case False
  1286           then have "card (S - {x}) = Suc (Suc 0)"
  1287             using Suc.prems c by auto
  1288           then obtain a b where ab: "(S - {x}) = {a, b}" "a\<noteq>b"
  1289             unfolding card_Suc_eq by auto
  1290           then show ?thesis
  1291             using eq1 \<open>S \<subseteq> V\<close>
  1292             by (auto simp: sum_distrib_left distrib_left intro!: Suc.prems(2)[of a b])
  1293         qed
  1294         have "u x + (1 - u x) = 1 \<Longrightarrow>
  1295           u x *\<^sub>R x + (1 - u x) *\<^sub>R ((\<Sum>y\<in>S - {x}. u y *\<^sub>R y) /\<^sub>R (1 - u x)) \<in> V"
  1296           by (rule Suc.prems) (use \<open>x \<in> S\<close> Suc.prems inV in \<open>auto simp: scaleR_right.sum\<close>)
  1297         moreover have "(\<Sum>a\<in>S. u a *\<^sub>R a) = u x *\<^sub>R x + (\<Sum>a\<in>S - {x}. u a *\<^sub>R a)"
  1298           by (meson Suc.prems(3) sum.remove \<open>x \<in> S\<close>)
  1299         ultimately show "(\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V"
  1300           by (simp add: x)
  1301       qed
  1302     qed (use \<open>S\<noteq>{}\<close> \<open>finite S\<close> in auto)
  1303   qed
  1304   ultimately show ?thesis
  1305     unfolding affine_def by meson
  1306 qed
  1307 
  1308 
  1309 lemma affine_hull_explicit:
  1310   "affine hull p = {y. \<exists>S u. finite S \<and> S \<noteq> {} \<and> S \<subseteq> p \<and> sum u S = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) S = y}"
  1311   (is "_ = ?rhs")
  1312 proof (rule hull_unique)
  1313   show "p \<subseteq> ?rhs"
  1314   proof (intro subsetI CollectI exI conjI)
  1315     show "\<And>x. sum (\<lambda>z. 1) {x} = 1"
  1316       by auto
  1317   qed auto
  1318   show "?rhs \<subseteq> T" if "p \<subseteq> T" "affine T" for T
  1319     using that unfolding affine by blast
  1320   show "affine ?rhs"
  1321     unfolding affine_def
  1322   proof clarify
  1323     fix u v :: real and sx ux sy uy
  1324     assume uv: "u + v = 1"
  1325       and x: "finite sx" "sx \<noteq> {}" "sx \<subseteq> p" "sum ux sx = (1::real)"
  1326       and y: "finite sy" "sy \<noteq> {}" "sy \<subseteq> p" "sum uy sy = (1::real)" 
  1327     have **: "(sx \<union> sy) \<inter> sx = sx" "(sx \<union> sy) \<inter> sy = sy"
  1328       by auto
  1329     show "\<exists>S w. finite S \<and> S \<noteq> {} \<and> S \<subseteq> p \<and>
  1330         sum w S = 1 \<and> (\<Sum>v\<in>S. w v *\<^sub>R v) = u *\<^sub>R (\<Sum>v\<in>sx. ux v *\<^sub>R v) + v *\<^sub>R (\<Sum>v\<in>sy. uy v *\<^sub>R v)"
  1331     proof (intro exI conjI)
  1332       show "finite (sx \<union> sy)"
  1333         using x y by auto
  1334       show "sum (\<lambda>i. (if i\<in>sx then u * ux i else 0) + (if i\<in>sy then v * uy i else 0)) (sx \<union> sy) = 1"
  1335         using x y uv
  1336         by (simp add: sum_Un sum.distrib sum.inter_restrict[symmetric] sum_distrib_left [symmetric] **)
  1337       have "(\<Sum>i\<in>sx \<union> sy. ((if i \<in> sx then u * ux i else 0) + (if i \<in> sy then v * uy i else 0)) *\<^sub>R i)
  1338           = (\<Sum>i\<in>sx. (u * ux i) *\<^sub>R i) + (\<Sum>i\<in>sy. (v * uy i) *\<^sub>R i)"
  1339         using x y
  1340         unfolding scaleR_left_distrib scaleR_zero_left if_smult
  1341         by (simp add: sum_Un sum.distrib sum.inter_restrict[symmetric]  **)
  1342       also have "\<dots> = u *\<^sub>R (\<Sum>v\<in>sx. ux v *\<^sub>R v) + v *\<^sub>R (\<Sum>v\<in>sy. uy v *\<^sub>R v)"
  1343         unfolding scaleR_scaleR[symmetric] scaleR_right.sum [symmetric] by blast
  1344       finally show "(\<Sum>i\<in>sx \<union> sy. ((if i \<in> sx then u * ux i else 0) + (if i \<in> sy then v * uy i else 0)) *\<^sub>R i) 
  1345                   = u *\<^sub>R (\<Sum>v\<in>sx. ux v *\<^sub>R v) + v *\<^sub>R (\<Sum>v\<in>sy. uy v *\<^sub>R v)" .
  1346     qed (use x y in auto)
  1347   qed
  1348 qed
  1349 
  1350 lemma affine_hull_finite:
  1351   assumes "finite S"
  1352   shows "affine hull S = {y. \<exists>u. sum u S = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) S = y}"
  1353 proof -
  1354   have *: "\<exists>h. sum h S = 1 \<and> (\<Sum>v\<in>S. h v *\<^sub>R v) = x" 
  1355     if "F \<subseteq> S" "finite F" "F \<noteq> {}" and sum: "sum u F = 1" and x: "(\<Sum>v\<in>F. u v *\<^sub>R v) = x" for x F u
  1356   proof -
  1357     have "S \<inter> F = F"
  1358       using that by auto
  1359     show ?thesis
  1360     proof (intro exI conjI)
  1361       show "(\<Sum>x\<in>S. if x \<in> F then u x else 0) = 1"
  1362         by (metis (mono_tags, lifting) \<open>S \<inter> F = F\<close> assms sum.inter_restrict sum)
  1363       show "(\<Sum>v\<in>S. (if v \<in> F then u v else 0) *\<^sub>R v) = x"
  1364         by (simp add: if_smult cong: if_cong) (metis (no_types) \<open>S \<inter> F = F\<close> assms sum.inter_restrict x)
  1365     qed
  1366   qed
  1367   show ?thesis
  1368     unfolding affine_hull_explicit using assms
  1369     by (fastforce dest: *)
  1370 qed
  1371 
  1372 
  1373 subsubsection%unimportant \<open>Stepping theorems and hence small special cases\<close>
  1374 
  1375 lemma affine_hull_empty[simp]: "affine hull {} = {}"
  1376   by simp
  1377 
  1378 lemma affine_hull_finite_step:
  1379   fixes y :: "'a::real_vector"
  1380   shows "finite S \<Longrightarrow>
  1381       (\<exists>u. sum u (insert a S) = w \<and> sum (\<lambda>x. u x *\<^sub>R x) (insert a S) = y) \<longleftrightarrow>
  1382       (\<exists>v u. sum u S = w - v \<and> sum (\<lambda>x. u x *\<^sub>R x) S = y - v *\<^sub>R a)" (is "_ \<Longrightarrow> ?lhs = ?rhs")
  1383 proof -
  1384   assume fin: "finite S"
  1385   show "?lhs = ?rhs"
  1386   proof
  1387     assume ?lhs
  1388     then obtain u where u: "sum u (insert a S) = w \<and> (\<Sum>x\<in>insert a S. u x *\<^sub>R x) = y"
  1389       by auto
  1390     show ?rhs
  1391     proof (cases "a \<in> S")
  1392       case True
  1393       then show ?thesis
  1394         using u by (simp add: insert_absorb) (metis diff_zero real_vector.scale_zero_left)
  1395     next
  1396       case False
  1397       show ?thesis
  1398         by (rule exI [where x="u a"]) (use u fin False in auto)
  1399     qed
  1400   next
  1401     assume ?rhs
  1402     then obtain v u where vu: "sum u S = w - v"  "(\<Sum>x\<in>S. u x *\<^sub>R x) = y - v *\<^sub>R a"
  1403       by auto
  1404     have *: "\<And>x M. (if x = a then v else M) *\<^sub>R x = (if x = a then v *\<^sub>R x else M *\<^sub>R x)"
  1405       by auto
  1406     show ?lhs
  1407     proof (cases "a \<in> S")
  1408       case True
  1409       show ?thesis
  1410         by (rule exI [where x="\<lambda>x. (if x=a then v else 0) + u x"])
  1411            (simp add: True scaleR_left_distrib sum.distrib sum_clauses fin vu * cong: if_cong)
  1412     next
  1413       case False
  1414       then show ?thesis
  1415         apply (rule_tac x="\<lambda>x. if x=a then v else u x" in exI) 
  1416         apply (simp add: vu sum_clauses(2)[OF fin] *)
  1417         by (simp add: sum_delta_notmem(3) vu)
  1418     qed
  1419   qed
  1420 qed
  1421 
  1422 lemma affine_hull_2:
  1423   fixes a b :: "'a::real_vector"
  1424   shows "affine hull {a,b} = {u *\<^sub>R a + v *\<^sub>R b| u v. (u + v = 1)}"
  1425   (is "?lhs = ?rhs")
  1426 proof -
  1427   have *:
  1428     "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::real)"
  1429     "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::'a)" by auto
  1430   have "?lhs = {y. \<exists>u. sum u {a, b} = 1 \<and> (\<Sum>v\<in>{a, b}. u v *\<^sub>R v) = y}"
  1431     using affine_hull_finite[of "{a,b}"] by auto
  1432   also have "\<dots> = {y. \<exists>v u. u b = 1 - v \<and> u b *\<^sub>R b = y - v *\<^sub>R a}"
  1433     by (simp add: affine_hull_finite_step[of "{b}" a])
  1434   also have "\<dots> = ?rhs" unfolding * by auto
  1435   finally show ?thesis by auto
  1436 qed
  1437 
  1438 lemma affine_hull_3:
  1439   fixes a b c :: "'a::real_vector"
  1440   shows "affine hull {a,b,c} = { u *\<^sub>R a + v *\<^sub>R b + w *\<^sub>R c| u v w. u + v + w = 1}"
  1441 proof -
  1442   have *:
  1443     "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::real)"
  1444     "\<And>x y z. z = x - y \<longleftrightarrow> y + z = (x::'a)" by auto
  1445   show ?thesis
  1446     apply (simp add: affine_hull_finite affine_hull_finite_step)
  1447     unfolding *
  1448     apply safe
  1449      apply (metis add.assoc)
  1450     apply (rule_tac x=u in exI, force)
  1451     done
  1452 qed
  1453 
  1454 lemma mem_affine:
  1455   assumes "affine S" "x \<in> S" "y \<in> S" "u + v = 1"
  1456   shows "u *\<^sub>R x + v *\<^sub>R y \<in> S"
  1457   using assms affine_def[of S] by auto
  1458 
  1459 lemma mem_affine_3:
  1460   assumes "affine S" "x \<in> S" "y \<in> S" "z \<in> S" "u + v + w = 1"
  1461   shows "u *\<^sub>R x + v *\<^sub>R y + w *\<^sub>R z \<in> S"
  1462 proof -
  1463   have "u *\<^sub>R x + v *\<^sub>R y + w *\<^sub>R z \<in> affine hull {x, y, z}"
  1464     using affine_hull_3[of x y z] assms by auto
  1465   moreover
  1466   have "affine hull {x, y, z} \<subseteq> affine hull S"
  1467     using hull_mono[of "{x, y, z}" "S"] assms by auto
  1468   moreover
  1469   have "affine hull S = S"
  1470     using assms affine_hull_eq[of S] by auto
  1471   ultimately show ?thesis by auto
  1472 qed
  1473 
  1474 lemma mem_affine_3_minus:
  1475   assumes "affine S" "x \<in> S" "y \<in> S" "z \<in> S"
  1476   shows "x + v *\<^sub>R (y-z) \<in> S"
  1477   using mem_affine_3[of S x y z 1 v "-v"] assms
  1478   by (simp add: algebra_simps)
  1479 
  1480 corollary mem_affine_3_minus2:
  1481     "\<lbrakk>affine S; x \<in> S; y \<in> S; z \<in> S\<rbrakk> \<Longrightarrow> x - v *\<^sub>R (y-z) \<in> S"
  1482   by (metis add_uminus_conv_diff mem_affine_3_minus real_vector.scale_minus_left)
  1483 
  1484 
  1485 subsubsection%unimportant \<open>Some relations between affine hull and subspaces\<close>
  1486 
  1487 lemma affine_hull_insert_subset_span:
  1488   "affine hull (insert a S) \<subseteq> {a + v| v . v \<in> span {x - a | x . x \<in> S}}"
  1489 proof -
  1490   have "\<exists>v T u. x = a + v \<and> (finite T \<and> T \<subseteq> {x - a |x. x \<in> S} \<and> (\<Sum>v\<in>T. u v *\<^sub>R v) = v)"
  1491     if "finite F" "F \<noteq> {}" "F \<subseteq> insert a S" "sum u F = 1" "(\<Sum>v\<in>F. u v *\<^sub>R v) = x"
  1492     for x F u
  1493   proof -
  1494     have *: "(\<lambda>x. x - a) ` (F - {a}) \<subseteq> {x - a |x. x \<in> S}"
  1495       using that by auto
  1496     show ?thesis
  1497     proof (intro exI conjI)
  1498       show "finite ((\<lambda>x. x - a) ` (F - {a}))"
  1499         by (simp add: that(1))
  1500       show "(\<Sum>v\<in>(\<lambda>x. x - a) ` (F - {a}). u(v+a) *\<^sub>R v) = x-a"
  1501         by (simp add: sum.reindex[unfolded inj_on_def] algebra_simps
  1502             sum_subtractf scaleR_left.sum[symmetric] sum_diff1 that)
  1503     qed (use \<open>F \<subseteq> insert a S\<close> in auto)
  1504   qed
  1505   then show ?thesis
  1506     unfolding affine_hull_explicit span_explicit by blast
  1507 qed
  1508 
  1509 lemma affine_hull_insert_span:
  1510   assumes "a \<notin> S"
  1511   shows "affine hull (insert a S) = {a + v | v . v \<in> span {x - a | x.  x \<in> S}}"
  1512 proof -
  1513   have *: "\<exists>G u. finite G \<and> G \<noteq> {} \<and> G \<subseteq> insert a S \<and> sum u G = 1 \<and> (\<Sum>v\<in>G. u v *\<^sub>R v) = y"
  1514     if "v \<in> span {x - a |x. x \<in> S}" "y = a + v" for y v
  1515   proof -
  1516     from that
  1517     obtain T u where u: "finite T" "T \<subseteq> {x - a |x. x \<in> S}" "a + (\<Sum>v\<in>T. u v *\<^sub>R v) = y"
  1518       unfolding span_explicit by auto
  1519     define F where "F = (\<lambda>x. x + a) ` T"
  1520     have F: "finite F" "F \<subseteq> S" "(\<Sum>v\<in>F. u (v - a) *\<^sub>R (v - a)) = y - a"
  1521       unfolding F_def using u by (auto simp: sum.reindex[unfolded inj_on_def])
  1522     have *: "F \<inter> {a} = {}" "F \<inter> - {a} = F"
  1523       using F assms by auto
  1524     show "\<exists>G u. finite G \<and> G \<noteq> {} \<and> G \<subseteq> insert a S \<and> sum u G = 1 \<and> (\<Sum>v\<in>G. u v *\<^sub>R v) = y"
  1525       apply (rule_tac x = "insert a F" in exI)
  1526       apply (rule_tac x = "\<lambda>x. if x=a then 1 - sum (\<lambda>x. u (x - a)) F else u (x - a)" in exI)
  1527       using assms F
  1528       apply (auto simp:  sum_clauses sum.If_cases if_smult sum_subtractf scaleR_left.sum algebra_simps *)
  1529       done
  1530   qed
  1531   show ?thesis
  1532     by (intro subset_antisym affine_hull_insert_subset_span) (auto simp: affine_hull_explicit dest!: *)
  1533 qed
  1534 
  1535 lemma affine_hull_span:
  1536   assumes "a \<in> S"
  1537   shows "affine hull S = {a + v | v. v \<in> span {x - a | x. x \<in> S - {a}}}"
  1538   using affine_hull_insert_span[of a "S - {a}", unfolded insert_Diff[OF assms]] by auto
  1539 
  1540 
  1541 subsubsection%unimportant \<open>Parallel affine sets\<close>
  1542 
  1543 definition affine_parallel :: "'a::real_vector set \<Rightarrow> 'a::real_vector set \<Rightarrow> bool"
  1544   where "affine_parallel S T \<longleftrightarrow> (\<exists>a. T = (\<lambda>x. a + x) ` S)"
  1545 
  1546 lemma affine_parallel_expl_aux:
  1547   fixes S T :: "'a::real_vector set"
  1548   assumes "\<And>x. x \<in> S \<longleftrightarrow> a + x \<in> T"
  1549   shows "T = (\<lambda>x. a + x) ` S"
  1550 proof -
  1551   have "x \<in> ((\<lambda>x. a + x) ` S)" if "x \<in> T" for x
  1552     using that
  1553     by (simp add: image_iff) (metis add.commute diff_add_cancel assms)
  1554   moreover have "T \<ge> (\<lambda>x. a + x) ` S"
  1555     using assms by auto
  1556   ultimately show ?thesis by auto
  1557 qed
  1558 
  1559 lemma affine_parallel_expl: "affine_parallel S T \<longleftrightarrow> (\<exists>a. \<forall>x. x \<in> S \<longleftrightarrow> a + x \<in> T)"
  1560   unfolding affine_parallel_def
  1561   using affine_parallel_expl_aux[of S _ T] by auto
  1562 
  1563 lemma affine_parallel_reflex: "affine_parallel S S"
  1564   unfolding affine_parallel_def
  1565   using image_add_0 by blast
  1566 
  1567 lemma affine_parallel_commut:
  1568   assumes "affine_parallel A B"
  1569   shows "affine_parallel B A"
  1570 proof -
  1571   from assms obtain a where B: "B = (\<lambda>x. a + x) ` A"
  1572     unfolding affine_parallel_def by auto
  1573   have [simp]: "(\<lambda>x. x - a) = plus (- a)" by (simp add: fun_eq_iff)
  1574   from B show ?thesis
  1575     using translation_galois [of B a A]
  1576     unfolding affine_parallel_def by auto
  1577 qed
  1578 
  1579 lemma affine_parallel_assoc:
  1580   assumes "affine_parallel A B"
  1581     and "affine_parallel B C"
  1582   shows "affine_parallel A C"
  1583 proof -
  1584   from assms obtain ab where "B = (\<lambda>x. ab + x) ` A"
  1585     unfolding affine_parallel_def by auto
  1586   moreover
  1587   from assms obtain bc where "C = (\<lambda>x. bc + x) ` B"
  1588     unfolding affine_parallel_def by auto
  1589   ultimately show ?thesis
  1590     using translation_assoc[of bc ab A] unfolding affine_parallel_def by auto
  1591 qed
  1592 
  1593 lemma affine_translation_aux:
  1594   fixes a :: "'a::real_vector"
  1595   assumes "affine ((\<lambda>x. a + x) ` S)"
  1596   shows "affine S"
  1597 proof -
  1598   {
  1599     fix x y u v
  1600     assume xy: "x \<in> S" "y \<in> S" "(u :: real) + v = 1"
  1601     then have "(a + x) \<in> ((\<lambda>x. a + x) ` S)" "(a + y) \<in> ((\<lambda>x. a + x) ` S)"
  1602       by auto
  1603     then have h1: "u *\<^sub>R  (a + x) + v *\<^sub>R (a + y) \<in> (\<lambda>x. a + x) ` S"
  1604       using xy assms unfolding affine_def by auto
  1605     have "u *\<^sub>R (a + x) + v *\<^sub>R (a + y) = (u + v) *\<^sub>R a + (u *\<^sub>R x + v *\<^sub>R y)"
  1606       by (simp add: algebra_simps)
  1607     also have "\<dots> = a + (u *\<^sub>R x + v *\<^sub>R y)"
  1608       using \<open>u + v = 1\<close> by auto
  1609     ultimately have "a + (u *\<^sub>R x + v *\<^sub>R y) \<in> (\<lambda>x. a + x) ` S"
  1610       using h1 by auto
  1611     then have "u *\<^sub>R x + v *\<^sub>R y \<in> S" by auto
  1612   }
  1613   then show ?thesis unfolding affine_def by auto
  1614 qed
  1615 
  1616 lemma affine_translation:
  1617   fixes a :: "'a::real_vector"
  1618   shows "affine S \<longleftrightarrow> affine ((\<lambda>x. a + x) ` S)"
  1619 proof -
  1620   have "affine S \<Longrightarrow> affine ((\<lambda>x. a + x) ` S)"
  1621     using affine_translation_aux[of "-a" "((\<lambda>x. a + x) ` S)"]
  1622     using translation_assoc[of "-a" a S] by auto
  1623   then show ?thesis using affine_translation_aux by auto
  1624 qed
  1625 
  1626 lemma parallel_is_affine:
  1627   fixes S T :: "'a::real_vector set"
  1628   assumes "affine S" "affine_parallel S T"
  1629   shows "affine T"
  1630 proof -
  1631   from assms obtain a where "T = (\<lambda>x. a + x) ` S"
  1632     unfolding affine_parallel_def by auto
  1633   then show ?thesis
  1634     using affine_translation assms by auto
  1635 qed
  1636 
  1637 lemma subspace_imp_affine: "subspace s \<Longrightarrow> affine s"
  1638   unfolding subspace_def affine_def by auto
  1639 
  1640 
  1641 subsubsection%unimportant \<open>Subspace parallel to an affine set\<close>
  1642 
  1643 lemma subspace_affine: "subspace S \<longleftrightarrow> affine S \<and> 0 \<in> S"
  1644 proof -
  1645   have h0: "subspace S \<Longrightarrow> affine S \<and> 0 \<in> S"
  1646     using subspace_imp_affine[of S] subspace_0 by auto
  1647   {
  1648     assume assm: "affine S \<and> 0 \<in> S"
  1649     {
  1650       fix c :: real
  1651       fix x
  1652       assume x: "x \<in> S"
  1653       have "c *\<^sub>R x = (1-c) *\<^sub>R 0 + c *\<^sub>R x" by auto
  1654       moreover
  1655       have "(1 - c) *\<^sub>R 0 + c *\<^sub>R x \<in> S"
  1656         using affine_alt[of S] assm x by auto
  1657       ultimately have "c *\<^sub>R x \<in> S" by auto
  1658     }
  1659     then have h1: "\<forall>c. \<forall>x \<in> S. c *\<^sub>R x \<in> S" by auto
  1660 
  1661     {
  1662       fix x y
  1663       assume xy: "x \<in> S" "y \<in> S"
  1664       define u where "u = (1 :: real)/2"
  1665       have "(1/2) *\<^sub>R (x+y) = (1/2) *\<^sub>R (x+y)"
  1666         by auto
  1667       moreover
  1668       have "(1/2) *\<^sub>R (x+y)=(1/2) *\<^sub>R x + (1-(1/2)) *\<^sub>R y"
  1669         by (simp add: algebra_simps)
  1670       moreover
  1671       have "(1 - u) *\<^sub>R x + u *\<^sub>R y \<in> S"
  1672         using affine_alt[of S] assm xy by auto
  1673       ultimately
  1674       have "(1/2) *\<^sub>R (x+y) \<in> S"
  1675         using u_def by auto
  1676       moreover
  1677       have "x + y = 2 *\<^sub>R ((1/2) *\<^sub>R (x+y))"
  1678         by auto
  1679       ultimately
  1680       have "x + y \<in> S"
  1681         using h1[rule_format, of "(1/2) *\<^sub>R (x+y)" "2"] by auto
  1682     }
  1683     then have "\<forall>x \<in> S. \<forall>y \<in> S. x + y \<in> S"
  1684       by auto
  1685     then have "subspace S"
  1686       using h1 assm unfolding subspace_def by auto
  1687   }
  1688   then show ?thesis using h0 by metis
  1689 qed
  1690 
  1691 lemma affine_diffs_subspace:
  1692   assumes "affine S" "a \<in> S"
  1693   shows "subspace ((\<lambda>x. (-a)+x) ` S)"
  1694 proof -
  1695   have [simp]: "(\<lambda>x. x - a) = plus (- a)" by (simp add: fun_eq_iff)
  1696   have "affine ((\<lambda>x. (-a)+x) ` S)"
  1697     using  affine_translation assms by auto
  1698   moreover have "0 \<in> ((\<lambda>x. (-a)+x) ` S)"
  1699     using assms exI[of "(\<lambda>x. x\<in>S \<and> -a+x = 0)" a] by auto
  1700   ultimately show ?thesis using subspace_affine by auto
  1701 qed
  1702 
  1703 lemma parallel_subspace_explicit:
  1704   assumes "affine S"
  1705     and "a \<in> S"
  1706   assumes "L \<equiv> {y. \<exists>x \<in> S. (-a) + x = y}"
  1707   shows "subspace L \<and> affine_parallel S L"
  1708 proof -
  1709   from assms have "L = plus (- a) ` S" by auto
  1710   then have par: "affine_parallel S L"
  1711     unfolding affine_parallel_def ..
  1712   then have "affine L" using assms parallel_is_affine by auto
  1713   moreover have "0 \<in> L"
  1714     using assms by auto
  1715   ultimately show ?thesis
  1716     using subspace_affine par by auto
  1717 qed
  1718 
  1719 lemma parallel_subspace_aux:
  1720   assumes "subspace A"
  1721     and "subspace B"
  1722     and "affine_parallel A B"
  1723   shows "A \<supseteq> B"
  1724 proof -
  1725   from assms obtain a where a: "\<forall>x. x \<in> A \<longleftrightarrow> a + x \<in> B"
  1726     using affine_parallel_expl[of A B] by auto
  1727   then have "-a \<in> A"
  1728     using assms subspace_0[of B] by auto
  1729   then have "a \<in> A"
  1730     using assms subspace_neg[of A "-a"] by auto
  1731   then show ?thesis
  1732     using assms a unfolding subspace_def by auto
  1733 qed
  1734 
  1735 lemma parallel_subspace:
  1736   assumes "subspace A"
  1737     and "subspace B"
  1738     and "affine_parallel A B"
  1739   shows "A = B"
  1740 proof
  1741   show "A \<supseteq> B"
  1742     using assms parallel_subspace_aux by auto
  1743   show "A \<subseteq> B"
  1744     using assms parallel_subspace_aux[of B A] affine_parallel_commut by auto
  1745 qed
  1746 
  1747 lemma affine_parallel_subspace:
  1748   assumes "affine S" "S \<noteq> {}"
  1749   shows "\<exists>!L. subspace L \<and> affine_parallel S L"
  1750 proof -
  1751   have ex: "\<exists>L. subspace L \<and> affine_parallel S L"
  1752     using assms parallel_subspace_explicit by auto
  1753   {
  1754     fix L1 L2
  1755     assume ass: "subspace L1 \<and> affine_parallel S L1" "subspace L2 \<and> affine_parallel S L2"
  1756     then have "affine_parallel L1 L2"
  1757       using affine_parallel_commut[of S L1] affine_parallel_assoc[of L1 S L2] by auto
  1758     then have "L1 = L2"
  1759       using ass parallel_subspace by auto
  1760   }
  1761   then show ?thesis using ex by auto
  1762 qed
  1763 
  1764 
  1765 subsection \<open>Cones\<close>
  1766 
  1767 definition%important cone :: "'a::real_vector set \<Rightarrow> bool"
  1768   where "cone s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>c\<ge>0. c *\<^sub>R x \<in> s)"
  1769 
  1770 lemma cone_empty[intro, simp]: "cone {}"
  1771   unfolding cone_def by auto
  1772 
  1773 lemma cone_univ[intro, simp]: "cone UNIV"
  1774   unfolding cone_def by auto
  1775 
  1776 lemma cone_Inter[intro]: "\<forall>s\<in>f. cone s \<Longrightarrow> cone (\<Inter>f)"
  1777   unfolding cone_def by auto
  1778 
  1779 lemma subspace_imp_cone: "subspace S \<Longrightarrow> cone S"
  1780   by (simp add: cone_def subspace_scale)
  1781 
  1782 
  1783 subsubsection \<open>Conic hull\<close>
  1784 
  1785 lemma cone_cone_hull: "cone (cone hull s)"
  1786   unfolding hull_def by auto
  1787 
  1788 lemma cone_hull_eq: "cone hull s = s \<longleftrightarrow> cone s"
  1789   apply (rule hull_eq)
  1790   using cone_Inter
  1791   unfolding subset_eq
  1792   apply auto
  1793   done
  1794 
  1795 lemma mem_cone:
  1796   assumes "cone S" "x \<in> S" "c \<ge> 0"
  1797   shows "c *\<^sub>R x \<in> S"
  1798   using assms cone_def[of S] by auto
  1799 
  1800 lemma cone_contains_0:
  1801   assumes "cone S"
  1802   shows "S \<noteq> {} \<longleftrightarrow> 0 \<in> S"
  1803 proof -
  1804   {
  1805     assume "S \<noteq> {}"
  1806     then obtain a where "a \<in> S" by auto
  1807     then have "0 \<in> S"
  1808       using assms mem_cone[of S a 0] by auto
  1809   }
  1810   then show ?thesis by auto
  1811 qed
  1812 
  1813 lemma cone_0: "cone {0}"
  1814   unfolding cone_def by auto
  1815 
  1816 lemma cone_Union[intro]: "(\<forall>s\<in>f. cone s) \<longrightarrow> cone (\<Union>f)"
  1817   unfolding cone_def by blast
  1818 
  1819 lemma cone_iff:
  1820   assumes "S \<noteq> {}"
  1821   shows "cone S \<longleftrightarrow> 0 \<in> S \<and> (\<forall>c. c > 0 \<longrightarrow> ((*\<^sub>R) c) ` S = S)"
  1822 proof -
  1823   {
  1824     assume "cone S"
  1825     {
  1826       fix c :: real
  1827       assume "c > 0"
  1828       {
  1829         fix x
  1830         assume "x \<in> S"
  1831         then have "x \<in> ((*\<^sub>R) c) ` S"
  1832           unfolding image_def
  1833           using \<open>cone S\<close> \<open>c>0\<close> mem_cone[of S x "1/c"]
  1834             exI[of "(\<lambda>t. t \<in> S \<and> x = c *\<^sub>R t)" "(1 / c) *\<^sub>R x"]
  1835           by auto
  1836       }
  1837       moreover
  1838       {
  1839         fix x
  1840         assume "x \<in> ((*\<^sub>R) c) ` S"
  1841         then have "x \<in> S"
  1842           using \<open>cone S\<close> \<open>c > 0\<close>
  1843           unfolding cone_def image_def \<open>c > 0\<close> by auto
  1844       }
  1845       ultimately have "((*\<^sub>R) c) ` S = S" by auto
  1846     }
  1847     then have "0 \<in> S \<and> (\<forall>c. c > 0 \<longrightarrow> ((*\<^sub>R) c) ` S = S)"
  1848       using \<open>cone S\<close> cone_contains_0[of S] assms by auto
  1849   }
  1850   moreover
  1851   {
  1852     assume a: "0 \<in> S \<and> (\<forall>c. c > 0 \<longrightarrow> ((*\<^sub>R) c) ` S = S)"
  1853     {
  1854       fix x
  1855       assume "x \<in> S"
  1856       fix c1 :: real
  1857       assume "c1 \<ge> 0"
  1858       then have "c1 = 0 \<or> c1 > 0" by auto
  1859       then have "c1 *\<^sub>R x \<in> S" using a \<open>x \<in> S\<close> by auto
  1860     }
  1861     then have "cone S" unfolding cone_def by auto
  1862   }
  1863   ultimately show ?thesis by blast
  1864 qed
  1865 
  1866 lemma cone_hull_empty: "cone hull {} = {}"
  1867   by (metis cone_empty cone_hull_eq)
  1868 
  1869 lemma cone_hull_empty_iff: "S = {} \<longleftrightarrow> cone hull S = {}"
  1870   by (metis bot_least cone_hull_empty hull_subset xtrans(5))
  1871 
  1872 lemma cone_hull_contains_0: "S \<noteq> {} \<longleftrightarrow> 0 \<in> cone hull S"
  1873   using cone_cone_hull[of S] cone_contains_0[of "cone hull S"] cone_hull_empty_iff[of S]
  1874   by auto
  1875 
  1876 lemma mem_cone_hull:
  1877   assumes "x \<in> S" "c \<ge> 0"
  1878   shows "c *\<^sub>R x \<in> cone hull S"
  1879   by (metis assms cone_cone_hull hull_inc mem_cone)
  1880 
  1881 proposition cone_hull_expl: "cone hull S = {c *\<^sub>R x | c x. c \<ge> 0 \<and> x \<in> S}"
  1882   (is "?lhs = ?rhs")
  1883 proof -
  1884   {
  1885     fix x
  1886     assume "x \<in> ?rhs"
  1887     then obtain cx :: real and xx where x: "x = cx *\<^sub>R xx" "cx \<ge> 0" "xx \<in> S"
  1888       by auto
  1889     fix c :: real
  1890     assume c: "c \<ge> 0"
  1891     then have "c *\<^sub>R x = (c * cx) *\<^sub>R xx"
  1892       using x by (simp add: algebra_simps)
  1893     moreover
  1894     have "c * cx \<ge> 0" using c x by auto
  1895     ultimately
  1896     have "c *\<^sub>R x \<in> ?rhs" using x by auto
  1897   }
  1898   then have "cone ?rhs"
  1899     unfolding cone_def by auto
  1900   then have "?rhs \<in> Collect cone"
  1901     unfolding mem_Collect_eq by auto
  1902   {
  1903     fix x
  1904     assume "x \<in> S"
  1905     then have "1 *\<^sub>R x \<in> ?rhs"
  1906       apply auto
  1907       apply (rule_tac x = 1 in exI, auto)
  1908       done
  1909     then have "x \<in> ?rhs" by auto
  1910   }
  1911   then have "S \<subseteq> ?rhs" by auto
  1912   then have "?lhs \<subseteq> ?rhs"
  1913     using \<open>?rhs \<in> Collect cone\<close> hull_minimal[of S "?rhs" "cone"] by auto
  1914   moreover
  1915   {
  1916     fix x
  1917     assume "x \<in> ?rhs"
  1918     then obtain cx :: real and xx where x: "x = cx *\<^sub>R xx" "cx \<ge> 0" "xx \<in> S"
  1919       by auto
  1920     then have "xx \<in> cone hull S"
  1921       using hull_subset[of S] by auto
  1922     then have "x \<in> ?lhs"
  1923       using x cone_cone_hull[of S] cone_def[of "cone hull S"] by auto
  1924   }
  1925   ultimately show ?thesis by auto
  1926 qed
  1927 
  1928 
  1929 subsection \<open>Affine dependence and consequential theorems\<close>
  1930 
  1931 text "Formalized by Lars Schewe."
  1932 
  1933 definition%important affine_dependent :: "'a::real_vector set \<Rightarrow> bool"
  1934   where "affine_dependent s \<longleftrightarrow> (\<exists>x\<in>s. x \<in> affine hull (s - {x}))"
  1935 
  1936 lemma affine_dependent_subset:
  1937    "\<lbrakk>affine_dependent s; s \<subseteq> t\<rbrakk> \<Longrightarrow> affine_dependent t"
  1938 apply (simp add: affine_dependent_def Bex_def)
  1939 apply (blast dest: hull_mono [OF Diff_mono [OF _ subset_refl]])
  1940 done
  1941 
  1942 lemma affine_independent_subset:
  1943   shows "\<lbrakk>\<not> affine_dependent t; s \<subseteq> t\<rbrakk> \<Longrightarrow> \<not> affine_dependent s"
  1944 by (metis affine_dependent_subset)
  1945 
  1946 lemma affine_independent_Diff:
  1947    "\<not> affine_dependent s \<Longrightarrow> \<not> affine_dependent(s - t)"
  1948 by (meson Diff_subset affine_dependent_subset)
  1949 
  1950 proposition affine_dependent_explicit:
  1951   "affine_dependent p \<longleftrightarrow>
  1952     (\<exists>S u. finite S \<and> S \<subseteq> p \<and> sum u S = 0 \<and> (\<exists>v\<in>S. u v \<noteq> 0) \<and> sum (\<lambda>v. u v *\<^sub>R v) S = 0)"
  1953 proof -
  1954   have "\<exists>S u. finite S \<and> S \<subseteq> p \<and> sum u S = 0 \<and> (\<exists>v\<in>S. u v \<noteq> 0) \<and> (\<Sum>w\<in>S. u w *\<^sub>R w) = 0"
  1955     if "(\<Sum>w\<in>S. u w *\<^sub>R w) = x" "x \<in> p" "finite S" "S \<noteq> {}" "S \<subseteq> p - {x}" "sum u S = 1" for x S u
  1956   proof (intro exI conjI)
  1957     have "x \<notin> S" 
  1958       using that by auto
  1959     then show "(\<Sum>v \<in> insert x S. if v = x then - 1 else u v) = 0"
  1960       using that by (simp add: sum_delta_notmem)
  1961     show "(\<Sum>w \<in> insert x S. (if w = x then - 1 else u w) *\<^sub>R w) = 0"
  1962       using that \<open>x \<notin> S\<close> by (simp add: if_smult sum_delta_notmem cong: if_cong)
  1963   qed (use that in auto)
  1964   moreover have "\<exists>x\<in>p. \<exists>S u. finite S \<and> S \<noteq> {} \<and> S \<subseteq> p - {x} \<and> sum u S = 1 \<and> (\<Sum>v\<in>S. u v *\<^sub>R v) = x"
  1965     if "(\<Sum>v\<in>S. u v *\<^sub>R v) = 0" "finite S" "S \<subseteq> p" "sum u S = 0" "v \<in> S" "u v \<noteq> 0" for S u v
  1966   proof (intro bexI exI conjI)
  1967     have "S \<noteq> {v}"
  1968       using that by auto
  1969     then show "S - {v} \<noteq> {}"
  1970       using that by auto
  1971     show "(\<Sum>x \<in> S - {v}. - (1 / u v) * u x) = 1"
  1972       unfolding sum_distrib_left[symmetric] sum_diff1[OF \<open>finite S\<close>] by (simp add: that)
  1973     show "(\<Sum>x\<in>S - {v}. (- (1 / u v) * u x) *\<^sub>R x) = v"
  1974       unfolding sum_distrib_left [symmetric] scaleR_scaleR[symmetric]
  1975                 scaleR_right.sum [symmetric] sum_diff1[OF \<open>finite S\<close>] 
  1976       using that by auto
  1977     show "S - {v} \<subseteq> p - {v}"
  1978       using that by auto
  1979   qed (use that in auto)
  1980   ultimately show ?thesis
  1981     unfolding affine_dependent_def affine_hull_explicit by auto
  1982 qed
  1983 
  1984 lemma affine_dependent_explicit_finite:
  1985   fixes S :: "'a::real_vector set"
  1986   assumes "finite S"
  1987   shows "affine_dependent S \<longleftrightarrow>
  1988     (\<exists>u. sum u S = 0 \<and> (\<exists>v\<in>S. u v \<noteq> 0) \<and> sum (\<lambda>v. u v *\<^sub>R v) S = 0)"
  1989   (is "?lhs = ?rhs")
  1990 proof
  1991   have *: "\<And>vt u v. (if vt then u v else 0) *\<^sub>R v = (if vt then (u v) *\<^sub>R v else 0::'a)"
  1992     by auto
  1993   assume ?lhs
  1994   then obtain t u v where
  1995     "finite t" "t \<subseteq> S" "sum u t = 0" "v\<in>t" "u v \<noteq> 0"  "(\<Sum>v\<in>t. u v *\<^sub>R v) = 0"
  1996     unfolding affine_dependent_explicit by auto
  1997   then show ?rhs
  1998     apply (rule_tac x="\<lambda>x. if x\<in>t then u x else 0" in exI)
  1999     apply (auto simp: * sum.inter_restrict[OF assms, symmetric] Int_absorb1[OF \<open>t\<subseteq>S\<close>])
  2000     done
  2001 next
  2002   assume ?rhs
  2003   then obtain u v where "sum u S = 0"  "v\<in>S" "u v \<noteq> 0" "(\<Sum>v\<in>S. u v *\<^sub>R v) = 0"
  2004     by auto
  2005   then show ?lhs unfolding affine_dependent_explicit
  2006     using assms by auto
  2007 qed
  2008 
  2009 
  2010 subsection%unimportant \<open>Connectedness of convex sets\<close>
  2011 
  2012 lemma connectedD:
  2013   "connected S \<Longrightarrow> open A \<Longrightarrow> open B \<Longrightarrow> S \<subseteq> A \<union> B \<Longrightarrow> A \<inter> B \<inter> S = {} \<Longrightarrow> A \<inter> S = {} \<or> B \<inter> S = {}"
  2014   by (rule Topological_Spaces.topological_space_class.connectedD)
  2015 
  2016 lemma convex_connected:
  2017   fixes S :: "'a::real_normed_vector set"
  2018   assumes "convex S"
  2019   shows "connected S"
  2020 proof (rule connectedI)
  2021   fix A B
  2022   assume "open A" "open B" "A \<inter> B \<inter> S = {}" "S \<subseteq> A \<union> B"
  2023   moreover
  2024   assume "A \<inter> S \<noteq> {}" "B \<inter> S \<noteq> {}"
  2025   then obtain a b where a: "a \<in> A" "a \<in> S" and b: "b \<in> B" "b \<in> S" by auto
  2026   define f where [abs_def]: "f u = u *\<^sub>R a + (1 - u) *\<^sub>R b" for u
  2027   then have "continuous_on {0 .. 1} f"
  2028     by (auto intro!: continuous_intros)
  2029   then have "connected (f ` {0 .. 1})"
  2030     by (auto intro!: connected_continuous_image)
  2031   note connectedD[OF this, of A B]
  2032   moreover have "a \<in> A \<inter> f ` {0 .. 1}"
  2033     using a by (auto intro!: image_eqI[of _ _ 1] simp: f_def)
  2034   moreover have "b \<in> B \<inter> f ` {0 .. 1}"
  2035     using b by (auto intro!: image_eqI[of _ _ 0] simp: f_def)
  2036   moreover have "f ` {0 .. 1} \<subseteq> S"
  2037     using \<open>convex S\<close> a b unfolding convex_def f_def by auto
  2038   ultimately show False by auto
  2039 qed
  2040 
  2041 corollary connected_UNIV[intro]: "connected (UNIV :: 'a::real_normed_vector set)"
  2042   by (simp add: convex_connected)
  2043 
  2044 lemma convex_prod:
  2045   assumes "\<And>i. i \<in> Basis \<Longrightarrow> convex {x. P i x}"
  2046   shows "convex {x. \<forall>i\<in>Basis. P i (x\<bullet>i)}"
  2047   using assms unfolding convex_def
  2048   by (auto simp: inner_add_left)
  2049 
  2050 lemma convex_positive_orthant: "convex {x::'a::euclidean_space. (\<forall>i\<in>Basis. 0 \<le> x\<bullet>i)}"
  2051   by (rule convex_prod) (simp add: atLeast_def[symmetric] convex_real_interval)
  2052 
  2053 subsection \<open>Convex hull\<close>
  2054 
  2055 lemma convex_convex_hull [iff]: "convex (convex hull s)"
  2056   unfolding hull_def
  2057   using convex_Inter[of "{t. convex t \<and> s \<subseteq> t}"]
  2058   by auto
  2059 
  2060 lemma convex_hull_subset:
  2061     "s \<subseteq> convex hull t \<Longrightarrow> convex hull s \<subseteq> convex hull t"
  2062   by (simp add: convex_convex_hull subset_hull)
  2063 
  2064 lemma convex_hull_eq: "convex hull s = s \<longleftrightarrow> convex s"
  2065   by (metis convex_convex_hull hull_same)
  2066 
  2067 subsubsection%unimportant \<open>Convex hull is "preserved" by a linear function\<close>
  2068 
  2069 lemma convex_hull_linear_image:
  2070   assumes f: "linear f"
  2071   shows "f ` (convex hull s) = convex hull (f ` s)"
  2072 proof
  2073   show "convex hull (f ` s) \<subseteq> f ` (convex hull s)"
  2074     by (intro hull_minimal image_mono hull_subset convex_linear_image assms convex_convex_hull)
  2075   show "f ` (convex hull s) \<subseteq> convex hull (f ` s)"
  2076   proof (unfold image_subset_iff_subset_vimage, rule hull_minimal)
  2077     show "s \<subseteq> f -` (convex hull (f ` s))"
  2078       by (fast intro: hull_inc)
  2079     show "convex (f -` (convex hull (f ` s)))"
  2080       by (intro convex_linear_vimage [OF f] convex_convex_hull)
  2081   qed
  2082 qed
  2083 
  2084 lemma in_convex_hull_linear_image:
  2085   assumes "linear f"
  2086     and "x \<in> convex hull s"
  2087   shows "f x \<in> convex hull (f ` s)"
  2088   using convex_hull_linear_image[OF assms(1)] assms(2) by auto
  2089 
  2090 lemma convex_hull_Times:
  2091   "convex hull (s \<times> t) = (convex hull s) \<times> (convex hull t)"
  2092 proof
  2093   show "convex hull (s \<times> t) \<subseteq> (convex hull s) \<times> (convex hull t)"
  2094     by (intro hull_minimal Sigma_mono hull_subset convex_Times convex_convex_hull)
  2095   have "(x, y) \<in> convex hull (s \<times> t)" if x: "x \<in> convex hull s" and y: "y \<in> convex hull t" for x y
  2096   proof (rule hull_induct [OF x], rule hull_induct [OF y])
  2097     fix x y assume "x \<in> s" and "y \<in> t"
  2098     then show "(x, y) \<in> convex hull (s \<times> t)"
  2099       by (simp add: hull_inc)
  2100   next
  2101     fix x let ?S = "((\<lambda>y. (0, y)) -` (\<lambda>p. (- x, 0) + p) ` (convex hull s \<times> t))"
  2102     have "convex ?S"
  2103       by (intro convex_linear_vimage convex_translation convex_convex_hull,
  2104         simp add: linear_iff)
  2105     also have "?S = {y. (x, y) \<in> convex hull (s \<times> t)}"
  2106       by (auto simp: image_def Bex_def)
  2107     finally show "convex {y. (x, y) \<in> convex hull (s \<times> t)}" .
  2108   next
  2109     show "convex {x. (x, y) \<in> convex hull s \<times> t}"
  2110     proof -
  2111       fix y let ?S = "((\<lambda>x. (x, 0)) -` (\<lambda>p. (0, - y) + p) ` (convex hull s \<times> t))"
  2112       have "convex ?S"
  2113       by (intro convex_linear_vimage convex_translation convex_convex_hull,
  2114         simp add: linear_iff)
  2115       also have "?S = {x. (x, y) \<in> convex hull (s \<times> t)}"
  2116         by (auto simp: image_def Bex_def)
  2117       finally show "convex {x. (x, y) \<in> convex hull (s \<times> t)}" .
  2118     qed
  2119   qed
  2120   then show "(convex hull s) \<times> (convex hull t) \<subseteq> convex hull (s \<times> t)"
  2121     unfolding subset_eq split_paired_Ball_Sigma by blast
  2122 qed
  2123 
  2124 
  2125 subsubsection%unimportant \<open>Stepping theorems for convex hulls of finite sets\<close>
  2126 
  2127 lemma convex_hull_empty[simp]: "convex hull {} = {}"
  2128   by (rule hull_unique) auto
  2129 
  2130 lemma convex_hull_singleton[simp]: "convex hull {a} = {a}"
  2131   by (rule hull_unique) auto
  2132 
  2133 lemma convex_hull_insert:
  2134   fixes S :: "'a::real_vector set"
  2135   assumes "S \<noteq> {}"
  2136   shows "convex hull (insert a S) =
  2137          {x. \<exists>u\<ge>0. \<exists>v\<ge>0. \<exists>b. (u + v = 1) \<and> b \<in> (convex hull S) \<and> (x = u *\<^sub>R a + v *\<^sub>R b)}"
  2138   (is "_ = ?hull")
  2139 proof (intro equalityI hull_minimal subsetI)
  2140   fix x
  2141   assume "x \<in> insert a S"
  2142   then have "\<exists>u\<ge>0. \<exists>v\<ge>0. u + v = 1 \<and> (\<exists>b. b \<in> convex hull S \<and> x = u *\<^sub>R a + v *\<^sub>R b)"
  2143   unfolding insert_iff
  2144   proof
  2145     assume "x = a"
  2146     then show ?thesis
  2147       by (rule_tac x=1 in exI) (use assms hull_subset in fastforce)
  2148   next
  2149     assume "x \<in> S"
  2150     with hull_subset[of S convex] show ?thesis
  2151       by force
  2152   qed
  2153   then show "x \<in> ?hull"
  2154     by simp
  2155 next
  2156   fix x
  2157   assume "x \<in> ?hull"
  2158   then obtain u v b where obt: "u\<ge>0" "v\<ge>0" "u + v = 1" "b \<in> convex hull S" "x = u *\<^sub>R a + v *\<^sub>R b"
  2159     by auto
  2160   have "a \<in> convex hull insert a S" "b \<in> convex hull insert a S"
  2161     using hull_mono[of S "insert a S" convex] hull_mono[of "{a}" "insert a S" convex] and obt(4)
  2162     by auto
  2163   then show "x \<in> convex hull insert a S"
  2164     unfolding obt(5) using obt(1-3)
  2165     by (rule convexD [OF convex_convex_hull])
  2166 next
  2167   show "convex ?hull"
  2168   proof (rule convexI)
  2169     fix x y u v
  2170     assume as: "(0::real) \<le> u" "0 \<le> v" "u + v = 1" and x: "x \<in> ?hull" and y: "y \<in> ?hull"
  2171     from x obtain u1 v1 b1 where
  2172       obt1: "u1\<ge>0" "v1\<ge>0" "u1 + v1 = 1" "b1 \<in> convex hull S" and xeq: "x = u1 *\<^sub>R a + v1 *\<^sub>R b1"
  2173       by auto
  2174     from y obtain u2 v2 b2 where
  2175       obt2: "u2\<ge>0" "v2\<ge>0" "u2 + v2 = 1" "b2 \<in> convex hull S" and yeq: "y = u2 *\<^sub>R a + v2 *\<^sub>R b2"
  2176       by auto
  2177     have *: "\<And>(x::'a) s1 s2. x - s1 *\<^sub>R x - s2 *\<^sub>R x = ((1::real) - (s1 + s2)) *\<^sub>R x"
  2178       by (auto simp: algebra_simps)
  2179     have "\<exists>b \<in> convex hull S. u *\<^sub>R x + v *\<^sub>R y =
  2180       (u * u1) *\<^sub>R a + (v * u2) *\<^sub>R a + (b - (u * u1) *\<^sub>R b - (v * u2) *\<^sub>R b)"
  2181     proof (cases "u * v1 + v * v2 = 0")
  2182       case True
  2183       have *: "\<And>(x::'a) s1 s2. x - s1 *\<^sub>R x - s2 *\<^sub>R x = ((1::real) - (s1 + s2)) *\<^sub>R x"
  2184         by (auto simp: algebra_simps)
  2185       have eq0: "u * v1 = 0" "v * v2 = 0"
  2186         using True mult_nonneg_nonneg[OF \<open>u\<ge>0\<close> \<open>v1\<ge>0\<close>] mult_nonneg_nonneg[OF \<open>v\<ge>0\<close> \<open>v2\<ge>0\<close>]
  2187         by arith+
  2188       then have "u * u1 + v * u2 = 1"
  2189         using as(3) obt1(3) obt2(3) by auto
  2190       then show ?thesis
  2191         using "*" eq0 as obt1(4) xeq yeq by auto
  2192     next
  2193       case False
  2194       have "1 - (u * u1 + v * u2) = (u + v) - (u * u1 + v * u2)"
  2195         using as(3) obt1(3) obt2(3) by (auto simp: field_simps)
  2196       also have "\<dots> = u * (v1 + u1 - u1) + v * (v2 + u2 - u2)"
  2197         using as(3) obt1(3) obt2(3) by (auto simp: field_simps)
  2198       also have "\<dots> = u * v1 + v * v2"
  2199         by simp
  2200       finally have **:"1 - (u * u1 + v * u2) = u * v1 + v * v2" by auto
  2201       let ?b = "((u * v1) / (u * v1 + v * v2)) *\<^sub>R b1 + ((v * v2) / (u * v1 + v * v2)) *\<^sub>R b2"
  2202       have zeroes: "0 \<le> u * v1 + v * v2" "0 \<le> u * v1" "0 \<le> u * v1 + v * v2" "0 \<le> v * v2"
  2203         using as(1,2) obt1(1,2) obt2(1,2) by auto
  2204       show ?thesis
  2205       proof
  2206         show "u *\<^sub>R x + v *\<^sub>R y = (u * u1) *\<^sub>R a + (v * u2) *\<^sub>R a + (?b - (u * u1) *\<^sub>R ?b - (v * u2) *\<^sub>R ?b)"
  2207           unfolding xeq yeq * **
  2208           using False by (auto simp: scaleR_left_distrib scaleR_right_distrib)
  2209         show "?b \<in> convex hull S"
  2210           using False zeroes obt1(4) obt2(4)
  2211           by (auto simp: convexD [OF convex_convex_hull] scaleR_left_distrib scaleR_right_distrib  add_divide_distrib[symmetric]  zero_le_divide_iff)
  2212       qed
  2213     qed
  2214     then obtain b where b: "b \<in> convex hull S" 
  2215        "u *\<^sub>R x + v *\<^sub>R y = (u * u1) *\<^sub>R a + (v * u2) *\<^sub>R a + (b - (u * u1) *\<^sub>R b - (v * u2) *\<^sub>R b)" ..
  2216 
  2217     have u1: "u1 \<le> 1"
  2218       unfolding obt1(3)[symmetric] and not_le using obt1(2) by auto
  2219     have u2: "u2 \<le> 1"
  2220       unfolding obt2(3)[symmetric] and not_le using obt2(2) by auto
  2221     have "u1 * u + u2 * v \<le> max u1 u2 * u + max u1 u2 * v"
  2222     proof (rule add_mono)
  2223       show "u1 * u \<le> max u1 u2 * u" "u2 * v \<le> max u1 u2 * v"
  2224         by (simp_all add: as mult_right_mono)
  2225     qed
  2226     also have "\<dots> \<le> 1"
  2227       unfolding distrib_left[symmetric] and as(3) using u1 u2 by auto
  2228     finally have le1: "u1 * u + u2 * v \<le> 1" .    
  2229     show "u *\<^sub>R x + v *\<^sub>R y \<in> ?hull"
  2230     proof (intro CollectI exI conjI)
  2231       show "0 \<le> u * u1 + v * u2"
  2232         by (simp add: as(1) as(2) obt1(1) obt2(1))
  2233       show "0 \<le> 1 - u * u1 - v * u2"
  2234         by (simp add: le1 diff_diff_add mult.commute)
  2235     qed (use b in \<open>auto simp: algebra_simps\<close>)
  2236   qed
  2237 qed
  2238 
  2239 lemma convex_hull_insert_alt:
  2240    "convex hull (insert a S) =
  2241      (if S = {} then {a}
  2242       else {(1 - u) *\<^sub>R a + u *\<^sub>R x |x u. 0 \<le> u \<and> u \<le> 1 \<and> x \<in> convex hull S})"
  2243   apply (auto simp: convex_hull_insert)
  2244   using diff_eq_eq apply fastforce
  2245   by (metis add.group_left_neutral add_le_imp_le_diff diff_add_cancel)
  2246 
  2247 subsubsection%unimportant \<open>Explicit expression for convex hull\<close>
  2248 
  2249 proposition convex_hull_indexed:
  2250   fixes S :: "'a::real_vector set"
  2251   shows "convex hull S =
  2252     {y. \<exists>k u x. (\<forall>i\<in>{1::nat .. k}. 0 \<le> u i \<and> x i \<in> S) \<and>
  2253                 (sum u {1..k} = 1) \<and> (\<Sum>i = 1..k. u i *\<^sub>R x i) = y}"
  2254     (is "?xyz = ?hull")
  2255 proof (rule hull_unique [OF _ convexI])
  2256   show "S \<subseteq> ?hull" 
  2257     by (clarsimp, rule_tac x=1 in exI, rule_tac x="\<lambda>x. 1" in exI, auto)
  2258 next
  2259   fix T
  2260   assume "S \<subseteq> T" "convex T"
  2261   then show "?hull \<subseteq> T"
  2262     by (blast intro: convex_sum)
  2263 next
  2264   fix x y u v
  2265   assume uv: "0 \<le> u" "0 \<le> v" "u + v = (1::real)"
  2266   assume xy: "x \<in> ?hull" "y \<in> ?hull"
  2267   from xy obtain k1 u1 x1 where
  2268     x [rule_format]: "\<forall>i\<in>{1::nat..k1}. 0\<le>u1 i \<and> x1 i \<in> S" 
  2269                       "sum u1 {Suc 0..k1} = 1" "(\<Sum>i = Suc 0..k1. u1 i *\<^sub>R x1 i) = x"
  2270     by auto
  2271   from xy obtain k2 u2 x2 where
  2272     y [rule_format]: "\<forall>i\<in>{1::nat..k2}. 0\<le>u2 i \<and> x2 i \<in> S" 
  2273                      "sum u2 {Suc 0..k2} = 1" "(\<Sum>i = Suc 0..k2. u2 i *\<^sub>R x2 i) = y"
  2274     by auto
  2275   have *: "\<And>P (x::'a) y s t i. (if P i then s else t) *\<^sub>R (if P i then x else y) = (if P i then s *\<^sub>R x else t *\<^sub>R y)"
  2276           "{1..k1 + k2} \<inter> {1..k1} = {1..k1}" "{1..k1 + k2} \<inter> - {1..k1} = (\<lambda>i. i + k1) ` {1..k2}"
  2277     by auto
  2278   have inj: "inj_on (\<lambda>i. i + k1) {1..k2}"
  2279     unfolding inj_on_def by auto
  2280   let ?uu = "\<lambda>i. if i \<in> {1..k1} then u * u1 i else v * u2 (i - k1)"
  2281   let ?xx = "\<lambda>i. if i \<in> {1..k1} then x1 i else x2 (i - k1)"
  2282   show "u *\<^sub>R x + v *\<^sub>R y \<in> ?hull"
  2283   proof (intro CollectI exI conjI ballI)
  2284     show "0 \<le> ?uu i" "?xx i \<in> S" if "i \<in> {1..k1+k2}" for i
  2285       using that by (auto simp add: le_diff_conv uv(1) x(1) uv(2) y(1))
  2286     show "(\<Sum>i = 1..k1 + k2. ?uu i) = 1"  "(\<Sum>i = 1..k1 + k2. ?uu i *\<^sub>R ?xx i) = u *\<^sub>R x + v *\<^sub>R y"
  2287       unfolding * sum.If_cases[OF finite_atLeastAtMost[of 1 "k1 + k2"]]
  2288         sum.reindex[OF inj] Collect_mem_eq o_def
  2289       unfolding scaleR_scaleR[symmetric] scaleR_right.sum [symmetric] sum_distrib_left[symmetric]
  2290       by (simp_all add: sum_distrib_left[symmetric]  x(2,3) y(2,3) uv(3))
  2291   qed 
  2292 qed
  2293 
  2294 lemma convex_hull_finite:
  2295   fixes S :: "'a::real_vector set"
  2296   assumes "finite S"
  2297   shows "convex hull S = {y. \<exists>u. (\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S = 1 \<and> sum (\<lambda>x. u x *\<^sub>R x) S = y}"
  2298   (is "?HULL = _")
  2299 proof (rule hull_unique [OF _ convexI]; clarify)
  2300   fix x
  2301   assume "x \<in> S"
  2302   then show "\<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) = x"
  2303     by (rule_tac x="\<lambda>y. if x=y then 1 else 0" in exI) (auto simp: sum.delta'[OF assms] sum_delta''[OF assms])
  2304 next
  2305   fix u v :: real
  2306   assume uv: "0 \<le> u" "0 \<le> v" "u + v = 1"
  2307   fix ux assume ux [rule_format]: "\<forall>x\<in>S. 0 \<le> ux x" "sum ux S = (1::real)"
  2308   fix uy assume uy [rule_format]: "\<forall>x\<in>S. 0 \<le> uy x" "sum uy S = (1::real)"
  2309   have "0 \<le> u * ux x + v * uy x" if "x\<in>S" for x
  2310     by (simp add: that uv ux(1) uy(1))
  2311   moreover
  2312   have "(\<Sum>x\<in>S. u * ux x + v * uy x) = 1"
  2313     unfolding sum.distrib and sum_distrib_left[symmetric] ux(2) uy(2)
  2314     using uv(3) by auto
  2315   moreover
  2316   have "(\<Sum>x\<in>S. (u * ux x + v * uy x) *\<^sub>R x) = u *\<^sub>R (\<Sum>x\<in>S. ux x *\<^sub>R x) + v *\<^sub>R (\<Sum>x\<in>S. uy x *\<^sub>R x)"
  2317     unfolding scaleR_left_distrib sum.distrib scaleR_scaleR[symmetric] scaleR_right.sum [symmetric]
  2318     by auto
  2319   ultimately
  2320   show "\<exists>uc. (\<forall>x\<in>S. 0 \<le> uc x) \<and> sum uc S = 1 \<and>
  2321              (\<Sum>x\<in>S. uc x *\<^sub>R x) = u *\<^sub>R (\<Sum>x\<in>S. ux x *\<^sub>R x) + v *\<^sub>R (\<Sum>x\<in>S. uy x *\<^sub>R x)"
  2322     by (rule_tac x="\<lambda>x. u * ux x + v * uy x" in exI, auto)
  2323 qed (use assms in \<open>auto simp: convex_explicit\<close>)
  2324 
  2325 
  2326 subsubsection%unimportant \<open>Another formulation\<close>
  2327 
  2328 text "Formalized by Lars Schewe."
  2329 
  2330 lemma convex_hull_explicit:
  2331   fixes p :: "'a::real_vector set"
  2332   shows "convex hull p =
  2333     {y. \<exists>S u. finite S \<and> S \<subseteq> p \<and> (\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) S = y}"
  2334   (is "?lhs = ?rhs")
  2335 proof -
  2336   {
  2337     fix x
  2338     assume "x\<in>?lhs"
  2339     then obtain k u y where
  2340         obt: "\<forall>i\<in>{1::nat..k}. 0 \<le> u i \<and> y i \<in> p" "sum u {1..k} = 1" "(\<Sum>i = 1..k. u i *\<^sub>R y i) = x"
  2341       unfolding convex_hull_indexed by auto
  2342 
  2343     have fin: "finite {1..k}" by auto
  2344     have fin': "\<And>v. finite {i \<in> {1..k}. y i = v}" by auto
  2345     {
  2346       fix j
  2347       assume "j\<in>{1..k}"
  2348       then have "y j \<in> p" "0 \<le> sum u {i. Suc 0 \<le> i \<and> i \<le> k \<and> y i = y j}"
  2349         using obt(1)[THEN bspec[where x=j]] and obt(2)
  2350         apply simp
  2351         apply (rule sum_nonneg)
  2352         using obt(1)
  2353         apply auto
  2354         done
  2355     }
  2356     moreover
  2357     have "(\<Sum>v\<in>y ` {1..k}. sum u {i \<in> {1..k}. y i = v}) = 1"
  2358       unfolding sum.image_gen[OF fin, symmetric] using obt(2) by auto
  2359     moreover have "(\<Sum>v\<in>y ` {1..k}. sum u {i \<in> {1..k}. y i = v} *\<^sub>R v) = x"
  2360       using sum.image_gen[OF fin, of "\<lambda>i. u i *\<^sub>R y i" y, symmetric]
  2361       unfolding scaleR_left.sum using obt(3) by auto
  2362     ultimately
  2363     have "\<exists>S u. finite S \<and> S \<subseteq> p \<and> (\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S = 1 \<and> (\<Sum>v\<in>S. u v *\<^sub>R v) = x"
  2364       apply (rule_tac x="y ` {1..k}" in exI)
  2365       apply (rule_tac x="\<lambda>v. sum u {i\<in>{1..k}. y i = v}" in exI, auto)
  2366       done
  2367     then have "x\<in>?rhs" by auto
  2368   }
  2369   moreover
  2370   {
  2371     fix y
  2372     assume "y\<in>?rhs"
  2373     then obtain S u where
  2374       obt: "finite S" "S \<subseteq> p" "\<forall>x\<in>S. 0 \<le> u x" "sum u S = 1" "(\<Sum>v\<in>S. u v *\<^sub>R v) = y"
  2375       by auto
  2376 
  2377     obtain f where f: "inj_on f {1..card S}" "f ` {1..card S} = S"
  2378       using ex_bij_betw_nat_finite_1[OF obt(1)] unfolding bij_betw_def by auto
  2379 
  2380     {
  2381       fix i :: nat
  2382       assume "i\<in>{1..card S}"
  2383       then have "f i \<in> S"
  2384         using f(2) by blast
  2385       then have "0 \<le> u (f i)" "f i \<in> p" using obt(2,3) by auto
  2386     }
  2387     moreover have *: "finite {1..card S}" by auto
  2388     {
  2389       fix y
  2390       assume "y\<in>S"
  2391       then obtain i where "i\<in>{1..card S}" "f i = y"
  2392         using f using image_iff[of y f "{1..card S}"]
  2393         by auto
  2394       then have "{x. Suc 0 \<le> x \<and> x \<le> card S \<and> f x = y} = {i}"
  2395         apply auto
  2396         using f(1)[unfolded inj_on_def]
  2397         by (metis One_nat_def atLeastAtMost_iff)
  2398       then have "card {x. Suc 0 \<le> x \<and> x \<le> card S \<and> f x = y} = 1" by auto
  2399       then have "(\<Sum>x\<in>{x \<in> {1..card S}. f x = y}. u (f x)) = u y"
  2400           "(\<Sum>x\<in>{x \<in> {1..card S}. f x = y}. u (f x) *\<^sub>R f x) = u y *\<^sub>R y"
  2401         by (auto simp: sum_constant_scaleR)
  2402     }
  2403     then have "(\<Sum>x = 1..card S. u (f x)) = 1" "(\<Sum>i = 1..card S. u (f i) *\<^sub>R f i) = y"
  2404       unfolding sum.image_gen[OF *(1), of "\<lambda>x. u (f x) *\<^sub>R f x" f]
  2405         and sum.image_gen[OF *(1), of "\<lambda>x. u (f x)" f]
  2406       unfolding f
  2407       using sum.cong [of S S "\<lambda>y. (\<Sum>x\<in>{x \<in> {1..card S}. f x = y}. u (f x) *\<^sub>R f x)" "\<lambda>v. u v *\<^sub>R v"]
  2408       using sum.cong [of S S "\<lambda>y. (\<Sum>x\<in>{x \<in> {1..card S}. f x = y}. u (f x))" u]
  2409       unfolding obt(4,5)
  2410       by auto
  2411     ultimately
  2412     have "\<exists>k u x. (\<forall>i\<in>{1..k}. 0 \<le> u i \<and> x i \<in> p) \<and> sum u {1..k} = 1 \<and>
  2413         (\<Sum>i::nat = 1..k. u i *\<^sub>R x i) = y"
  2414       apply (rule_tac x="card S" in exI)
  2415       apply (rule_tac x="u \<circ> f" in exI)
  2416       apply (rule_tac x=f in exI, fastforce)
  2417       done
  2418     then have "y \<in> ?lhs"
  2419       unfolding convex_hull_indexed by auto
  2420   }
  2421   ultimately show ?thesis
  2422     unfolding set_eq_iff by blast
  2423 qed
  2424 
  2425 
  2426 subsubsection%unimportant \<open>A stepping theorem for that expansion\<close>
  2427 
  2428 lemma convex_hull_finite_step:
  2429   fixes S :: "'a::real_vector set"
  2430   assumes "finite S"
  2431   shows
  2432     "(\<exists>u. (\<forall>x\<in>insert a S. 0 \<le> u x) \<and> sum u (insert a S) = w \<and> sum (\<lambda>x. u x *\<^sub>R x) (insert a S) = y)
  2433       \<longleftrightarrow> (\<exists>v\<ge>0. \<exists>u. (\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S = w - v \<and> sum (\<lambda>x. u x *\<^sub>R x) S = y - v *\<^sub>R a)"
  2434   (is "?lhs = ?rhs")
  2435 proof (rule, case_tac[!] "a\<in>S")
  2436   assume "a \<in> S"
  2437   then have *: "insert a S = S" by auto
  2438   assume ?lhs
  2439   then show ?rhs
  2440     unfolding *  by (rule_tac x=0 in exI, auto)
  2441 next
  2442   assume ?lhs
  2443   then obtain u where
  2444       u: "\<forall>x\<in>insert a S. 0 \<le> u x" "sum u (insert a S) = w" "(\<Sum>x\<in>insert a S. u x *\<^sub>R x) = y"
  2445     by auto
  2446   assume "a \<notin> S"
  2447   then show ?rhs
  2448     apply (rule_tac x="u a" in exI)
  2449     using u(1)[THEN bspec[where x=a]]
  2450     apply simp
  2451     apply (rule_tac x=u in exI)
  2452     using u[unfolded sum_clauses(2)[OF assms]] and \<open>a\<notin>S\<close>
  2453     apply auto
  2454     done
  2455 next
  2456   assume "a \<in> S"
  2457   then have *: "insert a S = S" by auto
  2458   have fin: "finite (insert a S)" using assms by auto
  2459   assume ?rhs
  2460   then obtain v u where uv: "v\<ge>0" "\<forall>x\<in>S. 0 \<le> u x" "sum u S = w - v" "(\<Sum>x\<in>S. u x *\<^sub>R x) = y - v *\<^sub>R a"
  2461     by auto
  2462   show ?lhs
  2463     apply (rule_tac x = "\<lambda>x. (if a = x then v else 0) + u x" in exI)
  2464     unfolding scaleR_left_distrib and sum.distrib and sum_delta''[OF fin] and sum.delta'[OF fin]
  2465     unfolding sum_clauses(2)[OF assms]
  2466     using uv and uv(2)[THEN bspec[where x=a]] and \<open>a\<in>S\<close>
  2467     apply auto
  2468     done
  2469 next
  2470   assume ?rhs
  2471   then obtain v u where uv: "v\<ge>0" "\<forall>x\<in>S. 0 \<le> u x" "sum u S = w - v" "(\<Sum>x\<in>S. u x *\<^sub>R x) = y - v *\<^sub>R a"
  2472     by auto
  2473   moreover assume "a \<notin> S"
  2474   moreover
  2475   have "(\<Sum>x\<in>S. if a = x then v else u x) = sum u S"  "(\<Sum>x\<in>S. (if a = x then v else u x) *\<^sub>R x) = (\<Sum>x\<in>S. u x *\<^sub>R x)"
  2476     using \<open>a \<notin> S\<close>
  2477     by (auto simp: intro!: sum.cong)
  2478   ultimately show ?lhs
  2479     by (rule_tac x="\<lambda>x. if a = x then v else u x" in exI) (auto simp: sum_clauses(2)[OF assms])
  2480 qed
  2481 
  2482 
  2483 subsubsection%unimportant \<open>Hence some special cases\<close>
  2484 
  2485 lemma convex_hull_2:
  2486   "convex hull {a,b} = {u *\<^sub>R a + v *\<^sub>R b | u v. 0 \<le> u \<and> 0 \<le> v \<and> u + v = 1}"
  2487 proof -
  2488   have *: "\<And>u. (\<forall>x\<in>{a, b}. 0 \<le> u x) \<longleftrightarrow> 0 \<le> u a \<and> 0 \<le> u b"
  2489     by auto
  2490   have **: "finite {b}" by auto
  2491   show ?thesis
  2492     apply (simp add: convex_hull_finite)
  2493     unfolding convex_hull_finite_step[OF **, of a 1, unfolded * conj_assoc]
  2494     apply auto
  2495     apply (rule_tac x=v in exI)
  2496     apply (rule_tac x="1 - v" in exI, simp)
  2497     apply (rule_tac x=u in exI, simp)
  2498     apply (rule_tac x="\<lambda>x. v" in exI, simp)
  2499     done
  2500 qed
  2501 
  2502 lemma convex_hull_2_alt: "convex hull {a,b} = {a + u *\<^sub>R (b - a) | u.  0 \<le> u \<and> u \<le> 1}"
  2503   unfolding convex_hull_2
  2504 proof (rule Collect_cong)
  2505   have *: "\<And>x y ::real. x + y = 1 \<longleftrightarrow> x = 1 - y"
  2506     by auto
  2507   fix x
  2508   show "(\<exists>v u. x = v *\<^sub>R a + u *\<^sub>R b \<and> 0 \<le> v \<and> 0 \<le> u \<and> v + u = 1) \<longleftrightarrow>
  2509     (\<exists>u. x = a + u *\<^sub>R (b - a) \<and> 0 \<le> u \<and> u \<le> 1)"
  2510     unfolding *
  2511     apply auto
  2512     apply (rule_tac[!] x=u in exI)
  2513     apply (auto simp: algebra_simps)
  2514     done
  2515 qed
  2516 
  2517 lemma convex_hull_3:
  2518   "convex hull {a,b,c} = { u *\<^sub>R a + v *\<^sub>R b + w *\<^sub>R c | u v w. 0 \<le> u \<and> 0 \<le> v \<and> 0 \<le> w \<and> u + v + w = 1}"
  2519 proof -
  2520   have fin: "finite {a,b,c}" "finite {b,c}" "finite {c}"
  2521     by auto
  2522   have *: "\<And>x y z ::real. x + y + z = 1 \<longleftrightarrow> x = 1 - y - z"
  2523     by (auto simp: field_simps)
  2524   show ?thesis
  2525     unfolding convex_hull_finite[OF fin(1)] and convex_hull_finite_step[OF fin(2)] and *
  2526     unfolding convex_hull_finite_step[OF fin(3)]
  2527     apply (rule Collect_cong, simp)
  2528     apply auto
  2529     apply (rule_tac x=va in exI)
  2530     apply (rule_tac x="u c" in exI, simp)
  2531     apply (rule_tac x="1 - v - w" in exI, simp)
  2532     apply (rule_tac x=v in exI, simp)
  2533     apply (rule_tac x="\<lambda>x. w" in exI, simp)
  2534     done
  2535 qed
  2536 
  2537 lemma convex_hull_3_alt:
  2538   "convex hull {a,b,c} = {a + u *\<^sub>R (b - a) + v *\<^sub>R (c - a) | u v.  0 \<le> u \<and> 0 \<le> v \<and> u + v \<le> 1}"
  2539 proof -
  2540   have *: "\<And>x y z ::real. x + y + z = 1 \<longleftrightarrow> x = 1 - y - z"
  2541     by auto
  2542   show ?thesis
  2543     unfolding convex_hull_3
  2544     apply (auto simp: *)
  2545     apply (rule_tac x=v in exI)
  2546     apply (rule_tac x=w in exI)
  2547     apply (simp add: algebra_simps)
  2548     apply (rule_tac x=u in exI)
  2549     apply (rule_tac x=v in exI)
  2550     apply (simp add: algebra_simps)
  2551     done
  2552 qed
  2553 
  2554 
  2555 subsection%unimportant \<open>Relations among closure notions and corresponding hulls\<close>
  2556 
  2557 lemma affine_imp_convex: "affine s \<Longrightarrow> convex s"
  2558   unfolding affine_def convex_def by auto
  2559 
  2560 lemma convex_affine_hull [simp]: "convex (affine hull S)"
  2561   by (simp add: affine_imp_convex)
  2562 
  2563 lemma subspace_imp_convex: "subspace s \<Longrightarrow> convex s"
  2564   using subspace_imp_affine affine_imp_convex by auto
  2565 
  2566 lemma affine_hull_subset_span: "(affine hull s) \<subseteq> (span s)"
  2567   by (metis hull_minimal span_superset subspace_imp_affine subspace_span)
  2568 
  2569 lemma convex_hull_subset_span: "(convex hull s) \<subseteq> (span s)"
  2570   by (metis hull_minimal span_superset subspace_imp_convex subspace_span)
  2571 
  2572 lemma convex_hull_subset_affine_hull: "(convex hull s) \<subseteq> (affine hull s)"
  2573   by (metis affine_affine_hull affine_imp_convex hull_minimal hull_subset)
  2574 
  2575 lemma affine_dependent_imp_dependent: "affine_dependent s \<Longrightarrow> dependent s"
  2576   unfolding affine_dependent_def dependent_def
  2577   using affine_hull_subset_span by auto
  2578 
  2579 lemma dependent_imp_affine_dependent:
  2580   assumes "dependent {x - a| x . x \<in> s}"
  2581     and "a \<notin> s"
  2582   shows "affine_dependent (insert a s)"
  2583 proof -
  2584   from assms(1)[unfolded dependent_explicit] obtain S u v
  2585     where obt: "finite S" "S \<subseteq> {x - a |x. x \<in> s}" "v\<in>S" "u v  \<noteq> 0" "(\<Sum>v\<in>S. u v *\<^sub>R v) = 0"
  2586     by auto
  2587   define t where "t = (\<lambda>x. x + a) ` S"
  2588 
  2589   have inj: "inj_on (\<lambda>x. x + a) S"
  2590     unfolding inj_on_def by auto
  2591   have "0 \<notin> S"
  2592     using obt(2) assms(2) unfolding subset_eq by auto
  2593   have fin: "finite t" and "t \<subseteq> s"
  2594     unfolding t_def using obt(1,2) by auto
  2595   then have "finite (insert a t)" and "insert a t \<subseteq> insert a s"
  2596     by auto
  2597   moreover have *: "\<And>P Q. (\<Sum>x\<in>t. (if x = a then P x else Q x)) = (\<Sum>x\<in>t. Q x)"
  2598     apply (rule sum.cong)
  2599     using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close>
  2600     apply auto
  2601     done
  2602   have "(\<Sum>x\<in>insert a t. if x = a then - (\<Sum>x\<in>t. u (x - a)) else u (x - a)) = 0"
  2603     unfolding sum_clauses(2)[OF fin] * using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close> by auto
  2604   moreover have "\<exists>v\<in>insert a t. (if v = a then - (\<Sum>x\<in>t. u (x - a)) else u (v - a)) \<noteq> 0"
  2605     using obt(3,4) \<open>0\<notin>S\<close>
  2606     by (rule_tac x="v + a" in bexI) (auto simp: t_def)
  2607   moreover have *: "\<And>P Q. (\<Sum>x\<in>t. (if x = a then P x else Q x) *\<^sub>R x) = (\<Sum>x\<in>t. Q x *\<^sub>R x)"
  2608     using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close> by (auto intro!: sum.cong)
  2609   have "(\<Sum>x\<in>t. u (x - a)) *\<^sub>R a = (\<Sum>v\<in>t. u (v - a) *\<^sub>R v)"
  2610     unfolding scaleR_left.sum
  2611     unfolding t_def and sum.reindex[OF inj] and o_def
  2612     using obt(5)
  2613     by (auto simp: sum.distrib scaleR_right_distrib)
  2614   then have "(\<Sum>v\<in>insert a t. (if v = a then - (\<Sum>x\<in>t. u (x - a)) else u (v - a)) *\<^sub>R v) = 0"
  2615     unfolding sum_clauses(2)[OF fin]
  2616     using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close>
  2617     by (auto simp: *)
  2618   ultimately show ?thesis
  2619     unfolding affine_dependent_explicit
  2620     apply (rule_tac x="insert a t" in exI, auto)
  2621     done
  2622 qed
  2623 
  2624 lemma convex_cone:
  2625   "convex s \<and> cone s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>y\<in>s. (x + y) \<in> s) \<and> (\<forall>x\<in>s. \<forall>c\<ge>0. (c *\<^sub>R x) \<in> s)"
  2626   (is "?lhs = ?rhs")
  2627 proof -
  2628   {
  2629     fix x y
  2630     assume "x\<in>s" "y\<in>s" and ?lhs
  2631     then have "2 *\<^sub>R x \<in>s" "2 *\<^sub>R y \<in> s"
  2632       unfolding cone_def by auto
  2633     then have "x + y \<in> s"
  2634       using \<open>?lhs\<close>[unfolded convex_def, THEN conjunct1]
  2635       apply (erule_tac x="2*\<^sub>R x" in ballE)
  2636       apply (erule_tac x="2*\<^sub>R y" in ballE)
  2637       apply (erule_tac x="1/2" in allE, simp)
  2638       apply (erule_tac x="1/2" in allE, auto)
  2639       done
  2640   }
  2641   then show ?thesis
  2642     unfolding convex_def cone_def by blast
  2643 qed
  2644 
  2645 lemma affine_dependent_biggerset:
  2646   fixes s :: "'a::euclidean_space set"
  2647   assumes "finite s" "card s \<ge> DIM('a) + 2"
  2648   shows "affine_dependent s"
  2649 proof -
  2650   have "s \<noteq> {}" using assms by auto
  2651   then obtain a where "a\<in>s" by auto
  2652   have *: "{x - a |x. x \<in> s - {a}} = (\<lambda>x. x - a) ` (s - {a})"
  2653     by auto
  2654   have "card {x - a |x. x \<in> s - {a}} = card (s - {a})"
  2655     unfolding * by (simp add: card_image inj_on_def)
  2656   also have "\<dots> > DIM('a)" using assms(2)
  2657     unfolding card_Diff_singleton[OF assms(1) \<open>a\<in>s\<close>] by auto
  2658   finally show ?thesis
  2659     apply (subst insert_Diff[OF \<open>a\<in>s\<close>, symmetric])
  2660     apply (rule dependent_imp_affine_dependent)
  2661     apply (rule dependent_biggerset, auto)
  2662     done
  2663 qed
  2664 
  2665 lemma affine_dependent_biggerset_general:
  2666   assumes "finite (S :: 'a::euclidean_space set)"
  2667     and "card S \<ge> dim S + 2"
  2668   shows "affine_dependent S"
  2669 proof -
  2670   from assms(2) have "S \<noteq> {}" by auto
  2671   then obtain a where "a\<in>S" by auto
  2672   have *: "{x - a |x. x \<in> S - {a}} = (\<lambda>x. x - a) ` (S - {a})"
  2673     by auto
  2674   have **: "card {x - a |x. x \<in> S - {a}} = card (S - {a})"
  2675     by (metis (no_types, lifting) "*" card_image diff_add_cancel inj_on_def)
  2676   have "dim {x - a |x. x \<in> S - {a}} \<le> dim S"
  2677     using \<open>a\<in>S\<close> by (auto simp: span_base span_diff intro: subset_le_dim)
  2678   also have "\<dots> < dim S + 1" by auto
  2679   also have "\<dots> \<le> card (S - {a})"
  2680     using assms
  2681     using card_Diff_singleton[OF assms(1) \<open>a\<in>S\<close>]
  2682     by auto
  2683   finally show ?thesis
  2684     apply (subst insert_Diff[OF \<open>a\<in>S\<close>, symmetric])
  2685     apply (rule dependent_imp_affine_dependent)
  2686     apply (rule dependent_biggerset_general)
  2687     unfolding **
  2688     apply auto
  2689     done
  2690 qed
  2691 
  2692 
  2693 subsection%unimportant \<open>Some Properties of Affine Dependent Sets\<close>
  2694 
  2695 lemma affine_independent_0 [simp]: "\<not> affine_dependent {}"
  2696   by (simp add: affine_dependent_def)
  2697 
  2698 lemma affine_independent_1 [simp]: "\<not> affine_dependent {a}"
  2699   by (simp add: affine_dependent_def)
  2700 
  2701 lemma affine_independent_2 [simp]: "\<not> affine_dependent {a,b}"
  2702   by (simp add: affine_dependent_def insert_Diff_if hull_same)
  2703 
  2704 lemma affine_hull_translation: "affine hull ((\<lambda>x. a + x) `  S) = (\<lambda>x. a + x) ` (affine hull S)"
  2705 proof -
  2706   have "affine ((\<lambda>x. a + x) ` (affine hull S))"
  2707     using affine_translation affine_affine_hull by blast
  2708   moreover have "(\<lambda>x. a + x) `  S \<subseteq> (\<lambda>x. a + x) ` (affine hull S)"
  2709     using hull_subset[of S] by auto
  2710   ultimately have h1: "affine hull ((\<lambda>x. a + x) `  S) \<subseteq> (\<lambda>x. a + x) ` (affine hull S)"
  2711     by (metis hull_minimal)
  2712   have "affine((\<lambda>x. -a + x) ` (affine hull ((\<lambda>x. a + x) `  S)))"
  2713     using affine_translation affine_affine_hull by blast
  2714   moreover have "(\<lambda>x. -a + x) ` (\<lambda>x. a + x) `  S \<subseteq> (\<lambda>x. -a + x) ` (affine hull ((\<lambda>x. a + x) `  S))"
  2715     using hull_subset[of "(\<lambda>x. a + x) `  S"] by auto
  2716   moreover have "S = (\<lambda>x. -a + x) ` (\<lambda>x. a + x) `  S"
  2717     using translation_assoc[of "-a" a] by auto
  2718   ultimately have "(\<lambda>x. -a + x) ` (affine hull ((\<lambda>x. a + x) `  S)) >= (affine hull S)"
  2719     by (metis hull_minimal)
  2720   then have "affine hull ((\<lambda>x. a + x) ` S) >= (\<lambda>x. a + x) ` (affine hull S)"
  2721     by auto
  2722   then show ?thesis using h1 by auto
  2723 qed
  2724 
  2725 lemma affine_dependent_translation:
  2726   assumes "affine_dependent S"
  2727   shows "affine_dependent ((\<lambda>x. a + x) ` S)"
  2728 proof -
  2729   obtain x where x: "x \<in> S \<and> x \<in> affine hull (S - {x})"
  2730     using assms affine_dependent_def by auto
  2731   have "(+) a ` (S - {x}) = (+) a ` S - {a + x}"
  2732     by auto
  2733   then have "a + x \<in> affine hull ((\<lambda>x. a + x) ` S - {a + x})"
  2734     using affine_hull_translation[of a "S - {x}"] x by auto
  2735   moreover have "a + x \<in> (\<lambda>x. a + x) ` S"
  2736     using x by auto
  2737   ultimately show ?thesis
  2738     unfolding affine_dependent_def by auto
  2739 qed
  2740 
  2741 lemma affine_dependent_translation_eq:
  2742   "affine_dependent S \<longleftrightarrow> affine_dependent ((\<lambda>x. a + x) ` S)"
  2743 proof -
  2744   {
  2745     assume "affine_dependent ((\<lambda>x. a + x) ` S)"
  2746     then have "affine_dependent S"
  2747       using affine_dependent_translation[of "((\<lambda>x. a + x) ` S)" "-a"] translation_assoc[of "-a" a]
  2748       by auto
  2749   }
  2750   then show ?thesis
  2751     using affine_dependent_translation by auto
  2752 qed
  2753 
  2754 lemma affine_hull_0_dependent:
  2755   assumes "0 \<in> affine hull S"
  2756   shows "dependent S"
  2757 proof -
  2758   obtain s u where s_u: "finite s \<and> s \<noteq> {} \<and> s \<subseteq> S \<and> sum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = 0"
  2759     using assms affine_hull_explicit[of S] by auto
  2760   then have "\<exists>v\<in>s. u v \<noteq> 0"
  2761     using sum_not_0[of "u" "s"] by auto
  2762   then have "finite s \<and> s \<subseteq> S \<and> (\<exists>v\<in>s. u v \<noteq> 0 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = 0)"
  2763     using s_u by auto
  2764   then show ?thesis
  2765     unfolding dependent_explicit[of S] by auto
  2766 qed
  2767 
  2768 lemma affine_dependent_imp_dependent2:
  2769   assumes "affine_dependent (insert 0 S)"
  2770   shows "dependent S"
  2771 proof -
  2772   obtain x where x: "x \<in> insert 0 S \<and> x \<in> affine hull (insert 0 S - {x})"
  2773     using affine_dependent_def[of "(insert 0 S)"] assms by blast
  2774   then have "x \<in> span (insert 0 S - {x})"
  2775     using affine_hull_subset_span by auto
  2776   moreover have "span (insert 0 S - {x}) = span (S - {x})"
  2777     using insert_Diff_if[of "0" S "{x}"] span_insert_0[of "S-{x}"] by auto
  2778   ultimately have "x \<in> span (S - {x})" by auto
  2779   then have "x \<noteq> 0 \<Longrightarrow> dependent S"
  2780     using x dependent_def by auto
  2781   moreover
  2782   {
  2783     assume "x = 0"
  2784     then have "0 \<in> affine hull S"
  2785       using x hull_mono[of "S - {0}" S] by auto
  2786     then have "dependent S"
  2787       using affine_hull_0_dependent by auto
  2788   }
  2789   ultimately show ?thesis by auto
  2790 qed
  2791 
  2792 lemma affine_dependent_iff_dependent:
  2793   assumes "a \<notin> S"
  2794   shows "affine_dependent (insert a S) \<longleftrightarrow> dependent ((\<lambda>x. -a + x) ` S)"
  2795 proof -
  2796   have "((+) (- a) ` S) = {x - a| x . x \<in> S}" by auto
  2797   then show ?thesis
  2798     using affine_dependent_translation_eq[of "(insert a S)" "-a"]
  2799       affine_dependent_imp_dependent2 assms
  2800       dependent_imp_affine_dependent[of a S]
  2801     by (auto simp del: uminus_add_conv_diff)
  2802 qed
  2803 
  2804 lemma affine_dependent_iff_dependent2:
  2805   assumes "a \<in> S"
  2806   shows "affine_dependent S \<longleftrightarrow> dependent ((\<lambda>x. -a + x) ` (S-{a}))"
  2807 proof -
  2808   have "insert a (S - {a}) = S"
  2809     using assms by auto
  2810   then show ?thesis
  2811     using assms affine_dependent_iff_dependent[of a "S-{a}"] by auto
  2812 qed
  2813 
  2814 lemma affine_hull_insert_span_gen:
  2815   "affine hull (insert a s) = (\<lambda>x. a + x) ` span ((\<lambda>x. - a + x) ` s)"
  2816 proof -
  2817   have h1: "{x - a |x. x \<in> s} = ((\<lambda>x. -a+x) ` s)"
  2818     by auto
  2819   {
  2820     assume "a \<notin> s"
  2821     then have ?thesis
  2822       using affine_hull_insert_span[of a s] h1 by auto
  2823   }
  2824   moreover
  2825   {
  2826     assume a1: "a \<in> s"
  2827     have "\<exists>x. x \<in> s \<and> -a+x=0"
  2828       apply (rule exI[of _ a])
  2829       using a1
  2830       apply auto
  2831       done
  2832     then have "insert 0 ((\<lambda>x. -a+x) ` (s - {a})) = (\<lambda>x. -a+x) ` s"
  2833       by auto
  2834     then have "span ((\<lambda>x. -a+x) ` (s - {a}))=span ((\<lambda>x. -a+x) ` s)"
  2835       using span_insert_0[of "(+) (- a) ` (s - {a})"] by (auto simp del: uminus_add_conv_diff)
  2836     moreover have "{x - a |x. x \<in> (s - {a})} = ((\<lambda>x. -a+x) ` (s - {a}))"
  2837       by auto
  2838     moreover have "insert a (s - {a}) = insert a s"
  2839       by auto
  2840     ultimately have ?thesis
  2841       using affine_hull_insert_span[of "a" "s-{a}"] by auto
  2842   }
  2843   ultimately show ?thesis by auto
  2844 qed
  2845 
  2846 lemma affine_hull_span2:
  2847   assumes "a \<in> s"
  2848   shows "affine hull s = (\<lambda>x. a+x) ` span ((\<lambda>x. -a+x) ` (s-{a}))"
  2849   using affine_hull_insert_span_gen[of a "s - {a}", unfolded insert_Diff[OF assms]]
  2850   by auto
  2851 
  2852 lemma affine_hull_span_gen:
  2853   assumes "a \<in> affine hull s"
  2854   shows "affine hull s = (\<lambda>x. a+x) ` span ((\<lambda>x. -a+x) ` s)"
  2855 proof -
  2856   have "affine hull (insert a s) = affine hull s"
  2857     using hull_redundant[of a affine s] assms by auto
  2858   then show ?thesis
  2859     using affine_hull_insert_span_gen[of a "s"] by auto
  2860 qed
  2861 
  2862 lemma affine_hull_span_0:
  2863   assumes "0 \<in> affine hull S"
  2864   shows "affine hull S = span S"
  2865   using affine_hull_span_gen[of "0" S] assms by auto
  2866 
  2867 lemma extend_to_affine_basis_nonempty:
  2868   fixes S V :: "'n::euclidean_space set"
  2869   assumes "\<not> affine_dependent S" "S \<subseteq> V" "S \<noteq> {}"
  2870   shows "\<exists>T. \<not> affine_dependent T \<and> S \<subseteq> T \<and> T \<subseteq> V \<and> affine hull T = affine hull V"
  2871 proof -
  2872   obtain a where a: "a \<in> S"
  2873     using assms by auto
  2874   then have h0: "independent  ((\<lambda>x. -a + x) ` (S-{a}))"
  2875     using affine_dependent_iff_dependent2 assms by auto
  2876   obtain B where B:
  2877     "(\<lambda>x. -a+x) ` (S - {a}) \<subseteq> B \<and> B \<subseteq> (\<lambda>x. -a+x) ` V \<and> independent B \<and> (\<lambda>x. -a+x) ` V \<subseteq> span B"
  2878     using assms
  2879     by (blast intro: maximal_independent_subset_extend[OF _ h0, of "(\<lambda>x. -a + x) ` V"])
  2880   define T where "T = (\<lambda>x. a+x) ` insert 0 B"
  2881   then have "T = insert a ((\<lambda>x. a+x) ` B)"
  2882     by auto
  2883   then have "affine hull T = (\<lambda>x. a+x) ` span B"
  2884     using affine_hull_insert_span_gen[of a "((\<lambda>x. a+x) ` B)"] translation_assoc[of "-a" a B]
  2885     by auto
  2886   then have "V \<subseteq> affine hull T"
  2887     using B assms translation_inverse_subset[of a V "span B"]
  2888     by auto
  2889   moreover have "T \<subseteq> V"
  2890     using T_def B a assms by auto
  2891   ultimately have "affine hull T = affine hull V"
  2892     by (metis Int_absorb1 Int_absorb2 hull_hull hull_mono)
  2893   moreover have "S \<subseteq> T"
  2894     using T_def B translation_inverse_subset[of a "S-{a}" B]
  2895     by auto
  2896   moreover have "\<not> affine_dependent T"
  2897     using T_def affine_dependent_translation_eq[of "insert 0 B"]
  2898       affine_dependent_imp_dependent2 B
  2899     by auto
  2900   ultimately show ?thesis using \<open>T \<subseteq> V\<close> by auto
  2901 qed
  2902 
  2903 lemma affine_basis_exists:
  2904   fixes V :: "'n::euclidean_space set"
  2905   shows "\<exists>B. B \<subseteq> V \<and> \<not> affine_dependent B \<and> affine hull V = affine hull B"
  2906 proof (cases "V = {}")
  2907   case True
  2908   then show ?thesis
  2909     using affine_independent_0 by auto
  2910 next
  2911   case False
  2912   then obtain x where "x \<in> V" by auto
  2913   then show ?thesis
  2914     using affine_dependent_def[of "{x}"] extend_to_affine_basis_nonempty[of "{x}" V]
  2915     by auto
  2916 qed
  2917 
  2918 proposition extend_to_affine_basis:
  2919   fixes S V :: "'n::euclidean_space set"
  2920   assumes "\<not> affine_dependent S" "S \<subseteq> V"
  2921   obtains T where "\<not> affine_dependent T" "S \<subseteq> T" "T \<subseteq> V" "affine hull T = affine hull V"
  2922 proof (cases "S = {}")
  2923   case True then show ?thesis
  2924     using affine_basis_exists by (metis empty_subsetI that)
  2925 next
  2926   case False
  2927   then show ?thesis by (metis assms extend_to_affine_basis_nonempty that)
  2928 qed
  2929 
  2930 subsection \<open>Affine Dimension of a Set\<close>
  2931 
  2932 definition%important aff_dim :: "('a::euclidean_space) set \<Rightarrow> int"
  2933   where "aff_dim V =
  2934   (SOME d :: int.
  2935     \<exists>B. affine hull B = affine hull V \<and> \<not> affine_dependent B \<and> of_nat (card B) = d + 1)"
  2936 
  2937 lemma aff_dim_basis_exists:
  2938   fixes V :: "('n::euclidean_space) set"
  2939   shows "\<exists>B. affine hull B = affine hull V \<and> \<not> affine_dependent B \<and> of_nat (card B) = aff_dim V + 1"
  2940 proof -
  2941   obtain B where "\<not> affine_dependent B \<and> affine hull B = affine hull V"
  2942     using affine_basis_exists[of V] by auto
  2943   then show ?thesis
  2944     unfolding aff_dim_def
  2945       some_eq_ex[of "\<lambda>d. \<exists>B. affine hull B = affine hull V \<and> \<not> affine_dependent B \<and> of_nat (card B) = d + 1"]
  2946     apply auto
  2947     apply (rule exI[of _ "int (card B) - (1 :: int)"])
  2948     apply (rule exI[of _ "B"], auto)
  2949     done
  2950 qed
  2951 
  2952 lemma affine_hull_nonempty: "S \<noteq> {} \<longleftrightarrow> affine hull S \<noteq> {}"
  2953 proof -
  2954   have "S = {} \<Longrightarrow> affine hull S = {}"
  2955     using affine_hull_empty by auto
  2956   moreover have "affine hull S = {} \<Longrightarrow> S = {}"
  2957     unfolding hull_def by auto
  2958   ultimately show ?thesis by blast
  2959 qed
  2960 
  2961 lemma aff_dim_parallel_subspace_aux:
  2962   fixes B :: "'n::euclidean_space set"
  2963   assumes "\<not> affine_dependent B" "a \<in> B"
  2964   shows "finite B \<and> ((card B) - 1 = dim (span ((\<lambda>x. -a+x) ` (B-{a}))))"
  2965 proof -
  2966   have "independent ((\<lambda>x. -a + x) ` (B-{a}))"
  2967     using affine_dependent_iff_dependent2 assms by auto
  2968   then have fin: "dim (span ((\<lambda>x. -a+x) ` (B-{a}))) = card ((\<lambda>x. -a + x) ` (B-{a}))"
  2969     "finite ((\<lambda>x. -a + x) ` (B - {a}))"
  2970     using indep_card_eq_dim_span[of "(\<lambda>x. -a+x) ` (B-{a})"] by auto
  2971   show ?thesis
  2972   proof (cases "(\<lambda>x. -a + x) ` (B - {a}) = {}")
  2973     case True
  2974     have "B = insert a ((\<lambda>x. a + x) ` (\<lambda>x. -a + x) ` (B - {a}))"
  2975       using translation_assoc[of "a" "-a" "(B - {a})"] assms by auto
  2976     then have "B = {a}" using True by auto
  2977     then show ?thesis using assms fin by auto
  2978   next
  2979     case False
  2980     then have "card ((\<lambda>x. -a + x) ` (B - {a})) > 0"
  2981       using fin by auto
  2982     moreover have h1: "card ((\<lambda>x. -a + x) ` (B-{a})) = card (B-{a})"
  2983       by (rule card_image) (use translate_inj_on in blast)
  2984     ultimately have "card (B-{a}) > 0" by auto
  2985     then have *: "finite (B - {a})"
  2986       using card_gt_0_iff[of "(B - {a})"] by auto
  2987     then have "card (B - {a}) = card B - 1"
  2988       using card_Diff_singleton assms by auto
  2989     with * show ?thesis using fin h1 by auto
  2990   qed
  2991 qed
  2992 
  2993 lemma aff_dim_parallel_subspace:
  2994   fixes V L :: "'n::euclidean_space set"
  2995   assumes "V \<noteq> {}"
  2996     and "subspace L"
  2997     and "affine_parallel (affine hull V) L"
  2998   shows "aff_dim V = int (dim L)"
  2999 proof -
  3000   obtain B where
  3001     B: "affine hull B = affine hull V \<and> \<not> affine_dependent B \<and> int (card B) = aff_dim V + 1"
  3002     using aff_dim_basis_exists by auto
  3003   then have "B \<noteq> {}"
  3004     using assms B affine_hull_nonempty[of V] affine_hull_nonempty[of B]
  3005     by auto
  3006   then obtain a where a: "a \<in> B" by auto
  3007   define Lb where "Lb = span ((\<lambda>x. -a+x) ` (B-{a}))"
  3008   moreover have "affine_parallel (affine hull B) Lb"
  3009     using Lb_def B assms affine_hull_span2[of a B] a
  3010       affine_parallel_commut[of "Lb" "(affine hull B)"]
  3011     unfolding affine_parallel_def
  3012     by auto
  3013   moreover have "subspace Lb"
  3014     using Lb_def subspace_span by auto
  3015   moreover have "affine hull B \<noteq> {}"
  3016     using assms B affine_hull_nonempty[of V] by auto
  3017   ultimately have "L = Lb"
  3018     using assms affine_parallel_subspace[of "affine hull B"] affine_affine_hull[of B] B
  3019     by auto
  3020   then have "dim L = dim Lb"
  3021     by auto
  3022   moreover have "card B - 1 = dim Lb" and "finite B"
  3023     using Lb_def aff_dim_parallel_subspace_aux a B by auto
  3024   ultimately show ?thesis
  3025     using B \<open>B \<noteq> {}\<close> card_gt_0_iff[of B] by auto
  3026 qed
  3027 
  3028 lemma aff_independent_finite:
  3029   fixes B :: "'n::euclidean_space set"
  3030   assumes "\<not> affine_dependent B"
  3031   shows "finite B"
  3032 proof -
  3033   {
  3034     assume "B \<noteq> {}"
  3035     then obtain a where "a \<in> B" by auto
  3036     then have ?thesis
  3037       using aff_dim_parallel_subspace_aux assms by auto
  3038   }
  3039   then show ?thesis by auto
  3040 qed
  3041 
  3042 lemmas independent_finite = independent_imp_finite
  3043 
  3044 lemma span_substd_basis:
  3045   assumes d: "d \<subseteq> Basis"
  3046   shows "span d = {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0}"
  3047   (is "_ = ?B")
  3048 proof -
  3049   have "d \<subseteq> ?B"
  3050     using d by (auto simp: inner_Basis)
  3051   moreover have s: "subspace ?B"
  3052     using subspace_substandard[of "\<lambda>i. i \<notin> d"] .
  3053   ultimately have "span d \<subseteq> ?B"
  3054     using span_mono[of d "?B"] span_eq_iff[of "?B"] by blast
  3055   moreover have *: "card d \<le> dim (span d)"
  3056     using independent_card_le_dim[of d "span d"] independent_substdbasis[OF assms]
  3057       span_superset[of d]
  3058     by auto
  3059   moreover from * have "dim ?B \<le> dim (span d)"
  3060     using dim_substandard[OF assms] by auto
  3061   ultimately show ?thesis
  3062     using s subspace_dim_equal[of "span d" "?B"] subspace_span[of d] by auto
  3063 qed
  3064 
  3065 lemma basis_to_substdbasis_subspace_isomorphism:
  3066   fixes B :: "'a::euclidean_space set"
  3067   assumes "independent B"
  3068   shows "\<exists>f d::'a set. card d = card B \<and> linear f \<and> f ` B = d \<and>
  3069     f ` span B = {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = 0} \<and> inj_on f (span B) \<and> d \<subseteq> Basis"
  3070 proof -
  3071   have B: "card B = dim B"
  3072     using dim_unique[of B B "card B"] assms span_superset[of B] by auto
  3073   have "dim B \<le> card (Basis :: 'a set)"
  3074     using dim_subset_UNIV[of B] by simp
  3075   from ex_card[OF this] obtain d :: "'a set" where d: "d \<subseteq> Basis" and t: "card d = dim B"
  3076     by auto
  3077   let ?t = "{x::'a::euclidean_space. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0}"
  3078   have "\<exists>f. linear f \<and> f ` B = d \<and> f ` span B = ?t \<and> inj_on f (span B)"
  3079   proof (intro basis_to_basis_subspace_isomorphism subspace_span subspace_substandard span_superset)
  3080     show "d \<subseteq> {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = 0}"
  3081       using d inner_not_same_Basis by blast
  3082   qed (auto simp: span_substd_basis independent_substdbasis dim_substandard d t B assms)
  3083   with t \<open>card B = dim B\<close> d show ?thesis by auto
  3084 qed
  3085 
  3086 lemma aff_dim_empty:
  3087   fixes S :: "'n::euclidean_space set"
  3088   shows "S = {} \<longleftrightarrow> aff_dim S = -1"
  3089 proof -
  3090   obtain B where *: "affine hull B = affine hull S"
  3091     and "\<not> affine_dependent B"
  3092     and "int (card B) = aff_dim S + 1"
  3093     using aff_dim_basis_exists by auto
  3094   moreover
  3095   from * have "S = {} \<longleftrightarrow> B = {}"
  3096     using affine_hull_nonempty[of B] affine_hull_nonempty[of S] by auto
  3097   ultimately show ?thesis
  3098     using aff_independent_finite[of B] card_gt_0_iff[of B] by auto
  3099 qed
  3100 
  3101 lemma aff_dim_empty_eq [simp]: "aff_dim ({}::'a::euclidean_space set) = -1"
  3102   by (simp add: aff_dim_empty [symmetric])
  3103 
  3104 lemma aff_dim_affine_hull [simp]: "aff_dim (affine hull S) = aff_dim S"
  3105   unfolding aff_dim_def using hull_hull[of _ S] by auto
  3106 
  3107 lemma aff_dim_affine_hull2:
  3108   assumes "affine hull S = affine hull T"
  3109   shows "aff_dim S = aff_dim T"
  3110   unfolding aff_dim_def using assms by auto
  3111 
  3112 lemma aff_dim_unique:
  3113   fixes B V :: "'n::euclidean_space set"
  3114   assumes "affine hull B = affine hull V \<and> \<not> affine_dependent B"
  3115   shows "of_nat (card B) = aff_dim V + 1"
  3116 proof (cases "B = {}")
  3117   case True
  3118   then have "V = {}"
  3119     using affine_hull_nonempty[of V] affine_hull_nonempty[of B] assms
  3120     by auto
  3121   then have "aff_dim V = (-1::int)"
  3122     using aff_dim_empty by auto
  3123   then show ?thesis
  3124     using \<open>B = {}\<close> by auto
  3125 next
  3126   case False
  3127   then obtain a where a: "a \<in> B" by auto
  3128   define Lb where "Lb = span ((\<lambda>x. -a+x) ` (B-{a}))"
  3129   have "affine_parallel (affine hull B) Lb"
  3130     using Lb_def affine_hull_span2[of a B] a
  3131       affine_parallel_commut[of "Lb" "(affine hull B)"]
  3132     unfolding affine_parallel_def by auto
  3133   moreover have "subspace Lb"
  3134     using Lb_def subspace_span by auto
  3135   ultimately have "aff_dim B = int(dim Lb)"
  3136     using aff_dim_parallel_subspace[of B Lb] \<open>B \<noteq> {}\<close> by auto
  3137   moreover have "(card B) - 1 = dim Lb" "finite B"
  3138     using Lb_def aff_dim_parallel_subspace_aux a assms by auto
  3139   ultimately have "of_nat (card B) = aff_dim B + 1"
  3140     using \<open>B \<noteq> {}\<close> card_gt_0_iff[of B] by auto
  3141   then show ?thesis
  3142     using aff_dim_affine_hull2 assms by auto
  3143 qed
  3144 
  3145 lemma aff_dim_affine_independent:
  3146   fixes B :: "'n::euclidean_space set"
  3147   assumes "\<not> affine_dependent B"
  3148   shows "of_nat (card B) = aff_dim B + 1"
  3149   using aff_dim_unique[of B B] assms by auto
  3150 
  3151 lemma affine_independent_iff_card:
  3152     fixes s :: "'a::euclidean_space set"
  3153     shows "\<not> affine_dependent s \<longleftrightarrow> finite s \<and> aff_dim s = int(card s) - 1"
  3154   apply (rule iffI)
  3155   apply (simp add: aff_dim_affine_independent aff_independent_finite)
  3156   by (metis affine_basis_exists [of s] aff_dim_unique card_subset_eq diff_add_cancel of_nat_eq_iff)
  3157 
  3158 lemma aff_dim_sing [simp]:
  3159   fixes a :: "'n::euclidean_space"
  3160   shows "aff_dim {a} = 0"
  3161   using aff_dim_affine_independent[of "{a}"] affine_independent_1 by auto
  3162 
  3163 lemma aff_dim_2 [simp]: "aff_dim {a,b} = (if a = b then 0 else 1)"
  3164 proof (clarsimp)
  3165   assume "a \<noteq> b"
  3166   then have "aff_dim{a,b} = card{a,b} - 1"
  3167     using affine_independent_2 [of a b] aff_dim_affine_independent by fastforce
  3168   also have "\<dots> = 1"
  3169     using \<open>a \<noteq> b\<close> by simp
  3170   finally show "aff_dim {a, b} = 1" .
  3171 qed
  3172 
  3173 lemma aff_dim_inner_basis_exists:
  3174   fixes V :: "('n::euclidean_space) set"
  3175   shows "\<exists>B. B \<subseteq> V \<and> affine hull B = affine hull V \<and>
  3176     \<not> affine_dependent B \<and> of_nat (card B) = aff_dim V + 1"
  3177 proof -
  3178   obtain B where B: "\<not> affine_dependent B" "B \<subseteq> V" "affine hull B = affine hull V"
  3179     using affine_basis_exists[of V] by auto
  3180   then have "of_nat(card B) = aff_dim V+1" using aff_dim_unique by auto
  3181   with B show ?thesis by auto
  3182 qed
  3183 
  3184 lemma aff_dim_le_card:
  3185   fixes V :: "'n::euclidean_space set"
  3186   assumes "finite V"
  3187   shows "aff_dim V \<le> of_nat (card V) - 1"
  3188 proof -
  3189   obtain B where B: "B \<subseteq> V" "of_nat (card B) = aff_dim V + 1"
  3190     using aff_dim_inner_basis_exists[of V] by auto
  3191   then have "card B \<le> card V"
  3192     using assms card_mono by auto
  3193   with B show ?thesis by auto
  3194 qed
  3195 
  3196 lemma aff_dim_parallel_eq:
  3197   fixes S T :: "'n::euclidean_space set"
  3198   assumes "affine_parallel (affine hull S) (affine hull T)"
  3199   shows "aff_dim S = aff_dim T"
  3200 proof -
  3201   {
  3202     assume "T \<noteq> {}" "S \<noteq> {}"
  3203     then obtain L where L: "subspace L \<and> affine_parallel (affine hull T) L"
  3204       using affine_parallel_subspace[of "affine hull T"]
  3205         affine_affine_hull[of T] affine_hull_nonempty
  3206       by auto
  3207     then have "aff_dim T = int (dim L)"
  3208       using aff_dim_parallel_subspace \<open>T \<noteq> {}\<close> by auto
  3209     moreover have *: "subspace L \<and> affine_parallel (affine hull S) L"
  3210        using L affine_parallel_assoc[of "affine hull S" "affine hull T" L] assms by auto
  3211     moreover from * have "aff_dim S = int (dim L)"
  3212       using aff_dim_parallel_subspace \<open>S \<noteq> {}\<close> by auto
  3213     ultimately have ?thesis by auto
  3214   }
  3215   moreover
  3216   {
  3217     assume "S = {}"
  3218     then have "S = {}" and "T = {}"
  3219       using assms affine_hull_nonempty
  3220       unfolding affine_parallel_def
  3221       by auto
  3222     then have ?thesis using aff_dim_empty by auto
  3223   }
  3224   moreover
  3225   {
  3226     assume "T = {}"
  3227     then have "S = {}" and "T = {}"
  3228       using assms affine_hull_nonempty
  3229       unfolding affine_parallel_def
  3230       by auto
  3231     then have ?thesis
  3232       using aff_dim_empty by auto
  3233   }
  3234   ultimately show ?thesis by blast
  3235 qed
  3236 
  3237 lemma aff_dim_translation_eq:
  3238   fixes a :: "'n::euclidean_space"
  3239   shows "aff_dim ((\<lambda>x. a + x) ` S) = aff_dim S"
  3240 proof -
  3241   have "affine_parallel (affine hull S) (affine hull ((\<lambda>x. a + x) ` S))"
  3242     unfolding affine_parallel_def
  3243     apply (rule exI[of _ "a"])
  3244     using affine_hull_translation[of a S]
  3245     apply auto
  3246     done
  3247   then show ?thesis
  3248     using aff_dim_parallel_eq[of S "(\<lambda>x. a + x) ` S"] by auto
  3249 qed
  3250 
  3251 lemma aff_dim_affine:
  3252   fixes S L :: "'n::euclidean_space set"
  3253   assumes "S \<noteq> {}"
  3254     and "affine S"
  3255     and "subspace L"
  3256     and "affine_parallel S L"
  3257   shows "aff_dim S = int (dim L)"
  3258 proof -
  3259   have *: "affine hull S = S"
  3260     using assms affine_hull_eq[of S] by auto
  3261   then have "affine_parallel (affine hull S) L"
  3262     using assms by (simp add: *)
  3263   then show ?thesis
  3264     using assms aff_dim_parallel_subspace[of S L] by blast
  3265 qed
  3266 
  3267 lemma dim_affine_hull:
  3268   fixes S :: "'n::euclidean_space set"
  3269   shows "dim (affine hull S) = dim S"
  3270 proof -
  3271   have "dim (affine hull S) \<ge> dim S"
  3272     using dim_subset by auto
  3273   moreover have "dim (span S) \<ge> dim (affine hull S)"
  3274     using dim_subset affine_hull_subset_span by blast
  3275   moreover have "dim (span S) = dim S"
  3276     using dim_span by auto
  3277   ultimately show ?thesis by auto
  3278 qed
  3279 
  3280 lemma aff_dim_subspace:
  3281   fixes S :: "'n::euclidean_space set"
  3282   assumes "subspace S"
  3283   shows "aff_dim S = int (dim S)"
  3284 proof (cases "S={}")
  3285   case True with assms show ?thesis
  3286     by (simp add: subspace_affine)
  3287 next
  3288   case False
  3289   with aff_dim_affine[of S S] assms subspace_imp_affine[of S] affine_parallel_reflex[of S] subspace_affine
  3290   show ?thesis by auto
  3291 qed
  3292 
  3293 lemma aff_dim_zero:
  3294   fixes S :: "'n::euclidean_space set"
  3295   assumes "0 \<in> affine hull S"
  3296   shows "aff_dim S = int (dim S)"
  3297 proof -
  3298   have "subspace (affine hull S)"
  3299     using subspace_affine[of "affine hull S"] affine_affine_hull assms
  3300     by auto
  3301   then have "aff_dim (affine hull S) = int (dim (affine hull S))"
  3302     using assms aff_dim_subspace[of "affine hull S"] by auto
  3303   then show ?thesis
  3304     using aff_dim_affine_hull[of S] dim_affine_hull[of S]
  3305     by auto
  3306 qed
  3307 
  3308 lemma aff_dim_eq_dim:
  3309   fixes S :: "'n::euclidean_space set"
  3310   assumes "a \<in> affine hull S"
  3311   shows "aff_dim S = int (dim ((\<lambda>x. -a+x) ` S))"
  3312 proof -
  3313   have "0 \<in> affine hull ((\<lambda>x. -a+x) ` S)"
  3314     unfolding affine_hull_translation
  3315     using assms by (simp add: ab_group_add_class.ab_left_minus image_iff)
  3316   with aff_dim_zero show ?thesis
  3317     by (metis aff_dim_translation_eq)
  3318 qed
  3319 
  3320 lemma aff_dim_UNIV [simp]: "aff_dim (UNIV :: 'n::euclidean_space set) = int(DIM('n))"
  3321   using aff_dim_subspace[of "(UNIV :: 'n::euclidean_space set)"]
  3322     dim_UNIV[where 'a="'n::euclidean_space"]
  3323   by auto
  3324 
  3325 lemma aff_dim_geq:
  3326   fixes V :: "'n::euclidean_space set"
  3327   shows "aff_dim V \<ge> -1"
  3328 proof -
  3329   obtain B where "affine hull B = affine hull V"
  3330     and "\<not> affine_dependent B"
  3331     and "int (card B) = aff_dim V + 1"
  3332     using aff_dim_basis_exists by auto
  3333   then show ?thesis by auto
  3334 qed
  3335 
  3336 lemma aff_dim_negative_iff [simp]:
  3337   fixes S :: "'n::euclidean_space set"
  3338   shows "aff_dim S < 0 \<longleftrightarrow>S = {}"
  3339 by (metis aff_dim_empty aff_dim_geq diff_0 eq_iff zle_diff1_eq)
  3340 
  3341 lemma aff_lowdim_subset_hyperplane:
  3342   fixes S :: "'a::euclidean_space set"
  3343   assumes "aff_dim S < DIM('a)"
  3344   obtains a b where "a \<noteq> 0" "S \<subseteq> {x. a \<bullet> x = b}"
  3345 proof (cases "S={}")
  3346   case True
  3347   moreover
  3348   have "(SOME b. b \<in> Basis) \<noteq> 0"
  3349     by (metis norm_some_Basis norm_zero zero_neq_one)
  3350   ultimately show ?thesis
  3351     using that by blast
  3352 next
  3353   case False
  3354   then obtain c S' where "c \<notin> S'" "S = insert c S'"
  3355     by (meson equals0I mk_disjoint_insert)
  3356   have "dim ((+) (-c) ` S) < DIM('a)"
  3357     by (metis \<open>S = insert c S'\<close> aff_dim_eq_dim assms hull_inc insertI1 of_nat_less_imp_less)
  3358   then obtain a where "a \<noteq> 0" "span ((+) (-c) ` S) \<subseteq> {x. a \<bullet> x = 0}"
  3359     using lowdim_subset_hyperplane by blast
  3360   moreover
  3361   have "a \<bullet> w = a \<bullet> c" if "span ((+) (- c) ` S) \<subseteq> {x. a \<bullet> x = 0}" "w \<in> S" for w
  3362   proof -
  3363     have "w-c \<in> span ((+) (- c) ` S)"
  3364       by (simp add: span_base \<open>w \<in> S\<close>)
  3365     with that have "w-c \<in> {x. a \<bullet> x = 0}"
  3366       by blast
  3367     then show ?thesis
  3368       by (auto simp: algebra_simps)
  3369   qed
  3370   ultimately have "S \<subseteq> {x. a \<bullet> x = a \<bullet> c}"
  3371     by blast
  3372   then show ?thesis
  3373     by (rule that[OF \<open>a \<noteq> 0\<close>])
  3374 qed
  3375 
  3376 lemma affine_independent_card_dim_diffs:
  3377   fixes S :: "'a :: euclidean_space set"
  3378   assumes "\<not> affine_dependent S" "a \<in> S"
  3379     shows "card S = dim {x - a|x. x \<in> S} + 1"
  3380 proof -
  3381   have 1: "{b - a|b. b \<in> (S - {a})} \<subseteq> {x - a|x. x \<in> S}" by auto
  3382   have 2: "x - a \<in> span {b - a |b. b \<in> S - {a}}" if "x \<in> S" for x
  3383   proof (cases "x = a")
  3384     case True then show ?thesis by (simp add: span_clauses)
  3385   next
  3386     case False then show ?thesis
  3387       using assms by (blast intro: span_base that)
  3388   qed
  3389   have "\<not> affine_dependent (insert a S)"
  3390     by (simp add: assms insert_absorb)
  3391   then have 3: "independent {b - a |b. b \<in> S - {a}}"
  3392       using dependent_imp_affine_dependent by fastforce
  3393   have "{b - a |b. b \<in> S - {a}} = (\<lambda>b. b-a) ` (S - {a})"
  3394     by blast
  3395   then have "card {b - a |b. b \<in> S - {a}} = card ((\<lambda>b. b-a) ` (S - {a}))"
  3396     by simp
  3397   also have "\<dots> = card (S - {a})"
  3398     by (metis (no_types, lifting) card_image diff_add_cancel inj_onI)
  3399   also have "\<dots> = card S - 1"
  3400     by (simp add: aff_independent_finite assms)
  3401   finally have 4: "card {b - a |b. b \<in> S - {a}} = card S - 1" .
  3402   have "finite S"
  3403     by (meson assms aff_independent_finite)
  3404   with \<open>a \<in> S\<close> have "card S \<noteq> 0" by auto
  3405   moreover have "dim {x - a |x. x \<in> S} = card S - 1"
  3406     using 2 by (blast intro: dim_unique [OF 1 _ 3 4])
  3407   ultimately show ?thesis
  3408     by auto
  3409 qed
  3410 
  3411 lemma independent_card_le_aff_dim:
  3412   fixes B :: "'n::euclidean_space set"
  3413   assumes "B \<subseteq> V"
  3414   assumes "\<not> affine_dependent B"
  3415   shows "int (card B) \<le> aff_dim V + 1"
  3416 proof -
  3417   obtain T where T: "\<not> affine_dependent T \<and> B \<subseteq> T \<and> T \<subseteq> V \<and> affine hull T = affine hull V"
  3418     by (metis assms extend_to_affine_basis[of B V])
  3419   then have "of_nat (card T) = aff_dim V + 1"
  3420     using aff_dim_unique by auto
  3421   then show ?thesis
  3422     using T card_mono[of T B] aff_independent_finite[of T] by auto
  3423 qed
  3424 
  3425 lemma aff_dim_subset:
  3426   fixes S T :: "'n::euclidean_space set"
  3427   assumes "S \<subseteq> T"
  3428   shows "aff_dim S \<le> aff_dim T"
  3429 proof -
  3430   obtain B where B: "\<not> affine_dependent B" "B \<subseteq> S" "affine hull B = affine hull S"
  3431     "of_nat (card B) = aff_dim S + 1"
  3432     using aff_dim_inner_basis_exists[of S] by auto
  3433   then have "int (card B) \<le> aff_dim T + 1"
  3434     using assms independent_card_le_aff_dim[of B T] by auto
  3435   with B show ?thesis by auto
  3436 qed
  3437 
  3438 lemma aff_dim_le_DIM:
  3439   fixes S :: "'n::euclidean_space set"
  3440   shows "aff_dim S \<le> int (DIM('n))"
  3441 proof -
  3442   have "aff_dim (UNIV :: 'n::euclidean_space set) = int(DIM('n))"
  3443     using aff_dim_UNIV by auto
  3444   then show "aff_dim (S:: 'n::euclidean_space set) \<le> int(DIM('n))"
  3445     using aff_dim_subset[of S "(UNIV :: ('n::euclidean_space) set)"] subset_UNIV by auto
  3446 qed
  3447 
  3448 lemma affine_dim_equal:
  3449   fixes S :: "'n::euclidean_space set"
  3450   assumes "affine S" "affine T" "S \<noteq> {}" "S \<subseteq> T" "aff_dim S = aff_dim T"
  3451   shows "S = T"
  3452 proof -
  3453   obtain a where "a \<in> S" using assms by auto
  3454   then have "a \<in> T" using assms by auto
  3455   define LS where "LS = {y. \<exists>x \<in> S. (-a) + x = y}"
  3456   then have ls: "subspace LS" "affine_parallel S LS"
  3457     using assms parallel_subspace_explicit[of S a LS] \<open>a \<in> S\<close> by auto
  3458   then have h1: "int(dim LS) = aff_dim S"
  3459     using assms aff_dim_affine[of S LS] by auto
  3460   have "T \<noteq> {}" using assms by auto
  3461   define LT where "LT = {y. \<exists>x \<in> T. (-a) + x = y}"
  3462   then have lt: "subspace LT \<and> affine_parallel T LT"
  3463     using assms parallel_subspace_explicit[of T a LT] \<open>a \<in> T\<close> by auto
  3464   then have "int(dim LT) = aff_dim T"
  3465     using assms aff_dim_affine[of T LT] \<open>T \<noteq> {}\<close> by auto
  3466   then have "dim LS = dim LT"
  3467     using h1 assms by auto
  3468   moreover have "LS \<le> LT"
  3469     using LS_def LT_def assms by auto
  3470   ultimately have "LS = LT"
  3471     using subspace_dim_equal[of LS LT] ls lt by auto
  3472   moreover have "S = {x. \<exists>y \<in> LS. a+y=x}"
  3473     using LS_def by auto
  3474   moreover have "T = {x. \<exists>y \<in> LT. a+y=x}"
  3475     using LT_def by auto
  3476   ultimately show ?thesis by auto
  3477 qed
  3478 
  3479 lemma aff_dim_eq_0:
  3480   fixes S :: "'a::euclidean_space set"
  3481   shows "aff_dim S = 0 \<longleftrightarrow> (\<exists>a. S = {a})"
  3482 proof (cases "S = {}")
  3483   case True
  3484   then show ?thesis
  3485     by auto
  3486 next
  3487   case False
  3488   then obtain a where "a \<in> S" by auto
  3489   show ?thesis
  3490   proof safe
  3491     assume 0: "aff_dim S = 0"
  3492     have "\<not> {a,b} \<subseteq> S" if "b \<noteq> a" for b
  3493       by (metis "0" aff_dim_2 aff_dim_subset not_one_le_zero that)
  3494     then show "\<exists>a. S = {a}"
  3495       using \<open>a \<in> S\<close> by blast
  3496   qed auto
  3497 qed
  3498 
  3499 lemma affine_hull_UNIV:
  3500   fixes S :: "'n::euclidean_space set"
  3501   assumes "aff_dim S = int(DIM('n))"
  3502   shows "affine hull S = (UNIV :: ('n::euclidean_space) set)"
  3503 proof -
  3504   have "S \<noteq> {}"
  3505     using assms aff_dim_empty[of S] by auto
  3506   have h0: "S \<subseteq> affine hull S"
  3507     using hull_subset[of S _] by auto
  3508   have h1: "aff_dim (UNIV :: ('n::euclidean_space) set) = aff_dim S"
  3509     using aff_dim_UNIV assms by auto
  3510   then have h2: "aff_dim (affine hull S) \<le> aff_dim (UNIV :: ('n::euclidean_space) set)"
  3511     using aff_dim_le_DIM[of "affine hull S"] assms h0 by auto
  3512   have h3: "aff_dim S \<le> aff_dim (affine hull S)"
  3513     using h0 aff_dim_subset[of S "affine hull S"] assms by auto
  3514   then have h4: "aff_dim (affine hull S) = aff_dim (UNIV :: ('n::euclidean_space) set)"
  3515     using h0 h1 h2 by auto
  3516   then show ?thesis
  3517     using affine_dim_equal[of "affine hull S" "(UNIV :: ('n::euclidean_space) set)"]
  3518       affine_affine_hull[of S] affine_UNIV assms h4 h0 \<open>S \<noteq> {}\<close>
  3519     by auto
  3520 qed
  3521 
  3522 lemma disjoint_affine_hull:
  3523   fixes s :: "'n::euclidean_space set"
  3524   assumes "\<not> affine_dependent s" "t \<subseteq> s" "u \<subseteq> s" "t \<inter> u = {}"
  3525     shows "(affine hull t) \<inter> (affine hull u) = {}"
  3526 proof -
  3527   have "finite s" using assms by (simp add: aff_independent_finite)
  3528   then have "finite t" "finite u" using assms finite_subset by blast+
  3529   { fix y
  3530     assume yt: "y \<in> affine hull t" and yu: "y \<in> affine hull u"
  3531     then obtain a b
  3532            where a1 [simp]: "sum a t = 1" and [simp]: "sum (\<lambda>v. a v *\<^sub>R v) t = y"
  3533              and [simp]: "sum b u = 1" "sum (\<lambda>v. b v *\<^sub>R v) u = y"
  3534       by (auto simp: affine_hull_finite \<open>finite t\<close> \<open>finite u\<close>)
  3535     define c where "c x = (if x \<in> t then a x else if x \<in> u then -(b x) else 0)" for x
  3536     have [simp]: "s \<inter> t = t" "s \<inter> - t \<inter> u = u" using assms by auto
  3537     have "sum c s = 0"
  3538       by (simp add: c_def comm_monoid_add_class.sum.If_cases \<open>finite s\<close> sum_negf)
  3539     moreover have "\<not> (\<forall>v\<in>s. c v = 0)"
  3540       by (metis (no_types) IntD1 \<open>s \<inter> t = t\<close> a1 c_def sum_not_0 zero_neq_one)
  3541     moreover have "(\<Sum>v\<in>s. c v *\<^sub>R v) = 0"
  3542       by (simp add: c_def if_smult sum_negf
  3543              comm_monoid_add_class.sum.If_cases \<open>finite s\<close>)
  3544     ultimately have False
  3545       using assms \<open>finite s\<close> by (auto simp: affine_dependent_explicit)
  3546   }
  3547   then show ?thesis by blast
  3548 qed
  3549 
  3550 lemma aff_dim_convex_hull:
  3551   fixes S :: "'n::euclidean_space set"
  3552   shows "aff_dim (convex hull S) = aff_dim S"
  3553   using aff_dim_affine_hull[of S] convex_hull_subset_affine_hull[of S]
  3554     hull_subset[of S "convex"] aff_dim_subset[of S "convex hull S"]
  3555     aff_dim_subset[of "convex hull S" "affine hull S"]
  3556   by auto
  3557 
  3558 subsection \<open>Caratheodory's theorem\<close>
  3559 
  3560 lemma convex_hull_caratheodory_aff_dim:
  3561   fixes p :: "('a::euclidean_space) set"
  3562   shows "convex hull p =
  3563     {y. \<exists>s u. finite s \<and> s \<subseteq> p \<and> card s \<le> aff_dim p + 1 \<and>
  3564       (\<forall>x\<in>s. 0 \<le> u x) \<and> sum u s = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) s = y}"
  3565   unfolding convex_hull_explicit set_eq_iff mem_Collect_eq
  3566 proof (intro allI iffI)
  3567   fix y
  3568   let ?P = "\<lambda>n. \<exists>s u. finite s \<and> card s = n \<and> s \<subseteq> p \<and> (\<forall>x\<in>s. 0 \<le> u x) \<and>
  3569     sum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y"
  3570   assume "\<exists>s u. finite s \<and> s \<subseteq> p \<and> (\<forall>x\<in>s. 0 \<le> u x) \<and> sum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y"
  3571   then obtain N where "?P N" by auto
  3572   then have "\<exists>n\<le>N. (\<forall>k<n. \<not> ?P k) \<and> ?P n"
  3573     apply (rule_tac ex_least_nat_le, auto)
  3574     done
  3575   then obtain n where "?P n" and smallest: "\<forall>k<n. \<not> ?P k"
  3576     by blast
  3577   then obtain s u where obt: "finite s" "card s = n" "s\<subseteq>p" "\<forall>x\<in>s. 0 \<le> u x"
  3578     "sum u s = 1"  "(\<Sum>v\<in>s. u v *\<^sub>R v) = y" by auto
  3579 
  3580   have "card s \<le> aff_dim p + 1"
  3581   proof (rule ccontr, simp only: not_le)
  3582     assume "aff_dim p + 1 < card s"
  3583     then have "affine_dependent s"
  3584       using affine_dependent_biggerset[OF obt(1)] independent_card_le_aff_dim not_less obt(3)
  3585       by blast
  3586     then obtain w v where wv: "sum w s = 0" "v\<in>s" "w v \<noteq> 0" "(\<Sum>v\<in>s. w v *\<^sub>R v) = 0"
  3587       using affine_dependent_explicit_finite[OF obt(1)] by auto
  3588     define i where "i = (\<lambda>v. (u v) / (- w v)) ` {v\<in>s. w v < 0}"
  3589     define t where "t = Min i"
  3590     have "\<exists>x\<in>s. w x < 0"
  3591     proof (rule ccontr, simp add: not_less)
  3592       assume as:"\<forall>x\<in>s. 0 \<le> w x"
  3593       then have "sum w (s - {v}) \<ge> 0"
  3594         apply (rule_tac sum_nonneg, auto)
  3595         done
  3596       then have "sum w s > 0"
  3597         unfolding sum.remove[OF obt(1) \<open>v\<in>s\<close>]
  3598         using as[THEN bspec[where x=v]]  \<open>v\<in>s\<close>  \<open>w v \<noteq> 0\<close> by auto
  3599       then show False using wv(1) by auto
  3600     qed
  3601     then have "i \<noteq> {}" unfolding i_def by auto
  3602     then have "t \<ge> 0"
  3603       using Min_ge_iff[of i 0 ] and obt(1)
  3604       unfolding t_def i_def
  3605       using obt(4)[unfolded le_less]
  3606       by (auto simp: divide_le_0_iff)
  3607     have t: "\<forall>v\<in>s. u v + t * w v \<ge> 0"
  3608     proof
  3609       fix v
  3610       assume "v \<in> s"
  3611       then have v: "0 \<le> u v"
  3612         using obt(4)[THEN bspec[where x=v]] by auto
  3613       show "0 \<le> u v + t * w v"
  3614       proof (cases "w v < 0")
  3615         case False
  3616         thus ?thesis using v \<open>t\<ge>0\<close> by auto
  3617       next
  3618         case True
  3619         then have "t \<le> u v / (- w v)"
  3620           using \<open>v\<in>s\<close> unfolding t_def i_def
  3621           apply (rule_tac Min_le)
  3622           using obt(1) apply auto
  3623           done
  3624         then show ?thesis
  3625           unfolding real_0_le_add_iff
  3626           using pos_le_divide_eq[OF True[unfolded neg_0_less_iff_less[symmetric]]]
  3627           by auto
  3628       qed
  3629     qed
  3630     obtain a where "a \<in> s" and "t = (\<lambda>v. (u v) / (- w v)) a" and "w a < 0"
  3631       using Min_in[OF _ \<open>i\<noteq>{}\<close>] and obt(1) unfolding i_def t_def by auto
  3632     then have a: "a \<in> s" "u a + t * w a = 0" by auto
  3633     have *: "\<And>f. sum f (s - {a}) = sum f s - ((f a)::'b::ab_group_add)"
  3634       unfolding sum.remove[OF obt(1) \<open>a\<in>s\<close>] by auto
  3635     have "(\<Sum>v\<in>s. u v + t * w v) = 1"
  3636       unfolding sum.distrib wv(1) sum_distrib_left[symmetric] obt(5) by auto
  3637     moreover have "(\<Sum>v\<in>s. u v *\<^sub>R v + (t * w v) *\<^sub>R v) - (u a *\<^sub>R a + (t * w a) *\<^sub>R a) = y"
  3638       unfolding sum.distrib obt(6) scaleR_scaleR[symmetric] scaleR_right.sum [symmetric] wv(4)
  3639       using a(2) [THEN eq_neg_iff_add_eq_0 [THEN iffD2]] by simp
  3640     ultimately have "?P (n - 1)"
  3641       apply (rule_tac x="(s - {a})" in exI)
  3642       apply (rule_tac x="\<lambda>v. u v + t * w v" in exI)
  3643       using obt(1-3) and t and a
  3644       apply (auto simp: * scaleR_left_distrib)
  3645       done
  3646     then show False
  3647       using smallest[THEN spec[where x="n - 1"]] by auto
  3648   qed
  3649   then show "\<exists>s u. finite s \<and> s \<subseteq> p \<and> card s \<le> aff_dim p + 1 \<and>
  3650       (\<forall>x\<in>s. 0 \<le> u x) \<and> sum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y"
  3651     using obt by auto
  3652 qed auto
  3653 
  3654 lemma caratheodory_aff_dim:
  3655   fixes p :: "('a::euclidean_space) set"
  3656   shows "convex hull p = {x. \<exists>s. finite s \<and> s \<subseteq> p \<and> card s \<le> aff_dim p + 1 \<and> x \<in> convex hull s}"
  3657         (is "?lhs = ?rhs")
  3658 proof
  3659   show "?lhs \<subseteq> ?rhs"
  3660     apply (subst convex_hull_caratheodory_aff_dim, clarify)
  3661     apply (rule_tac x=s in exI)
  3662     apply (simp add: hull_subset convex_explicit [THEN iffD1, OF convex_convex_hull])
  3663     done
  3664 next
  3665   show "?rhs \<subseteq> ?lhs"
  3666     using hull_mono by blast
  3667 qed
  3668 
  3669 lemma convex_hull_caratheodory:
  3670   fixes p :: "('a::euclidean_space) set"
  3671   shows "convex hull p =
  3672             {y. \<exists>s u. finite s \<and> s \<subseteq> p \<and> card s \<le> DIM('a) + 1 \<and>
  3673               (\<forall>x\<in>s. 0 \<le> u x) \<and> sum u s = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) s = y}"
  3674         (is "?lhs = ?rhs")
  3675 proof (intro set_eqI iffI)
  3676   fix x
  3677   assume "x \<in> ?lhs" then show "x \<in> ?rhs"
  3678     apply (simp only: convex_hull_caratheodory_aff_dim Set.mem_Collect_eq)
  3679     apply (erule ex_forward)+
  3680     using aff_dim_le_DIM [of p]
  3681     apply simp
  3682     done
  3683 next
  3684   fix x
  3685   assume "x \<in> ?rhs" then show "x \<in> ?lhs"
  3686     by (auto simp: convex_hull_explicit)
  3687 qed
  3688 
  3689 theorem caratheodory:
  3690   "convex hull p =
  3691     {x::'a::euclidean_space. \<exists>s. finite s \<and> s \<subseteq> p \<and>
  3692       card s \<le> DIM('a) + 1 \<and> x \<in> convex hull s}"
  3693 proof safe
  3694   fix x
  3695   assume "x \<in> convex hull p"
  3696   then obtain s u where "finite s" "s \<subseteq> p" "card s \<le> DIM('a) + 1"
  3697     "\<forall>x\<in>s. 0 \<le> u x" "sum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"
  3698     unfolding convex_hull_caratheodory by auto
  3699   then show "\<exists>s. finite s \<and> s \<subseteq> p \<and> card s \<le> DIM('a) + 1 \<and> x \<in> convex hull s"
  3700     apply (rule_tac x=s in exI)
  3701     using hull_subset[of s convex]
  3702     using convex_convex_hull[simplified convex_explicit, of s,
  3703       THEN spec[where x=s], THEN spec[where x=u]]
  3704     apply auto
  3705     done
  3706 next
  3707   fix x s
  3708   assume  "finite s" "s \<subseteq> p" "card s \<le> DIM('a) + 1" "x \<in> convex hull s"
  3709   then show "x \<in> convex hull p"
  3710     using hull_mono[OF \<open>s\<subseteq>p\<close>] by auto
  3711 qed
  3712 
  3713 subsection%unimportant\<open>Some Properties of subset of standard basis\<close>
  3714 
  3715 lemma affine_hull_substd_basis:
  3716   assumes "d \<subseteq> Basis"
  3717   shows "affine hull (insert 0 d) = {x::'a::euclidean_space. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0}"
  3718   (is "affine hull (insert 0 ?A) = ?B")
  3719 proof -
  3720   have *: "\<And>A. (+) (0::'a) ` A = A" "\<And>A. (+) (- (0::'a)) ` A = A"
  3721     by auto
  3722   show ?thesis
  3723     unfolding affine_hull_insert_span_gen span_substd_basis[OF assms,symmetric] * ..
  3724 qed
  3725 
  3726 lemma affine_hull_convex_hull [simp]: "affine hull (convex hull S) = affine hull S"
  3727   by (metis Int_absorb1 Int_absorb2 convex_hull_subset_affine_hull hull_hull hull_mono hull_subset)
  3728 
  3729 
  3730 subsection%unimportant \<open>Moving and scaling convex hulls\<close>
  3731 
  3732 lemma convex_hull_set_plus:
  3733   "convex hull (S + T) = convex hull S + convex hull T"
  3734   unfolding set_plus_image
  3735   apply (subst convex_hull_linear_image [symmetric])
  3736   apply (simp add: linear_iff scaleR_right_distrib)
  3737   apply (simp add: convex_hull_Times)
  3738   done
  3739 
  3740 lemma translation_eq_singleton_plus: "(\<lambda>x. a + x) ` T = {a} + T"
  3741   unfolding set_plus_def by auto
  3742 
  3743 lemma convex_hull_translation:
  3744   "convex hull ((\<lambda>x. a + x) ` S) = (\<lambda>x. a + x) ` (convex hull S)"
  3745   unfolding translation_eq_singleton_plus
  3746   by (simp only: convex_hull_set_plus convex_hull_singleton)
  3747 
  3748 lemma convex_hull_scaling:
  3749   "convex hull ((\<lambda>x. c *\<^sub>R x) ` S) = (\<lambda>x. c *\<^sub>R x) ` (convex hull S)"
  3750   using linear_scaleR by (rule convex_hull_linear_image [symmetric])
  3751 
  3752 lemma convex_hull_affinity:
  3753   "convex hull ((\<lambda>x. a + c *\<^sub>R x) ` S) = (\<lambda>x. a + c *\<^sub>R x) ` (convex hull S)"
  3754   by(simp only: image_image[symmetric] convex_hull_scaling convex_hull_translation)
  3755 
  3756 
  3757 subsection%unimportant \<open>Convexity of cone hulls\<close>
  3758 
  3759 lemma convex_cone_hull:
  3760   assumes "convex S"
  3761   shows "convex (cone hull S)"
  3762 proof (rule convexI)
  3763   fix x y
  3764   assume xy: "x \<in> cone hull S" "y \<in> cone hull S"
  3765   then have "S \<noteq> {}"
  3766     using cone_hull_empty_iff[of S] by auto
  3767   fix u v :: real
  3768   assume uv: "u \<ge> 0" "v \<ge> 0" "u + v = 1"
  3769   then have *: "u *\<^sub>R x \<in> cone hull S" "v *\<^sub>R y \<in> cone hull S"
  3770     using cone_cone_hull[of S] xy cone_def[of "cone hull S"] by auto
  3771   from * obtain cx :: real and xx where x: "u *\<^sub>R x = cx *\<^sub>R xx" "cx \<ge> 0" "xx \<in> S"
  3772     using cone_hull_expl[of S] by auto
  3773   from * obtain cy :: real and yy where y: "v *\<^sub>R y = cy *\<^sub>R yy" "cy \<ge> 0" "yy \<in> S"
  3774     using cone_hull_expl[of S] by auto
  3775   {
  3776     assume "cx + cy \<le> 0"
  3777     then have "u *\<^sub>R x = 0" and "v *\<^sub>R y = 0"
  3778       using x y by auto
  3779     then have "u *\<^sub>R x + v *\<^sub>R y = 0"
  3780       by auto
  3781     then have "u *\<^sub>R x + v *\<^sub>R y \<in> cone hull S"
  3782       using cone_hull_contains_0[of S] \<open>S \<noteq> {}\<close> by auto
  3783   }
  3784   moreover
  3785   {
  3786     assume "cx + cy > 0"
  3787     then have "(cx / (cx + cy)) *\<^sub>R xx + (cy / (cx + cy)) *\<^sub>R yy \<in> S"
  3788       using assms mem_convex_alt[of S xx yy cx cy] x y by auto
  3789     then have "cx *\<^sub>R xx + cy *\<^sub>R yy \<in> cone hull S"
  3790       using mem_cone_hull[of "(cx/(cx+cy)) *\<^sub>R xx + (cy/(cx+cy)) *\<^sub>R yy" S "cx+cy"] \<open>cx+cy>0\<close>
  3791       by (auto simp: scaleR_right_distrib)
  3792     then have "u *\<^sub>R x + v *\<^sub>R y \<in> cone hull S"
  3793       using x y by auto
  3794   }
  3795   moreover have "cx + cy \<le> 0 \<or> cx + cy > 0" by auto
  3796   ultimately show "u *\<^sub>R x + v *\<^sub>R y \<in> cone hull S" by blast
  3797 qed
  3798 
  3799 lemma cone_convex_hull:
  3800   assumes "cone S"
  3801   shows "cone (convex hull S)"
  3802 proof (cases "S = {}")
  3803   case True
  3804   then show ?thesis by auto
  3805 next
  3806   case False
  3807   then have *: "0 \<in> S \<and> (\<forall>c. c > 0 \<longrightarrow> (*\<^sub>R) c ` S = S)"
  3808     using cone_iff[of S] assms by auto
  3809   {
  3810     fix c :: real
  3811     assume "c > 0"
  3812     then have "(*\<^sub>R) c ` (convex hull S) = convex hull ((*\<^sub>R) c ` S)"
  3813       using convex_hull_scaling[of _ S] by auto
  3814     also have "\<dots> = convex hull S"
  3815       using * \<open>c > 0\<close> by auto
  3816     finally have "(*\<^sub>R) c ` (convex hull S) = convex hull S"
  3817       by auto
  3818   }
  3819   then have "0 \<in> convex hull S" "\<And>c. c > 0 \<Longrightarrow> ((*\<^sub>R) c ` (convex hull S)) = (convex hull S)"
  3820     using * hull_subset[of S convex] by auto
  3821   then show ?thesis
  3822     using \<open>S \<noteq> {}\<close> cone_iff[of "convex hull S"] by auto
  3823 qed
  3824 
  3825 subsection \<open>Radon's theorem\<close>
  3826 
  3827 text "Formalized by Lars Schewe."
  3828 
  3829 lemma Radon_ex_lemma:
  3830   assumes "finite c" "affine_dependent c"
  3831   shows "\<exists>u. sum u c = 0 \<and> (\<exists>v\<in>c. u v \<noteq> 0) \<and> sum (\<lambda>v. u v *\<^sub>R v) c = 0"
  3832 proof -
  3833   from assms(2)[unfolded affine_dependent_explicit]
  3834   obtain s u where
  3835       "finite s" "s \<subseteq> c" "sum u s = 0" "\<exists>v\<in>s. u v \<noteq> 0" "(\<Sum>v\<in>s. u v *\<^sub>R v) = 0"
  3836     by blast
  3837   then show ?thesis
  3838     apply (rule_tac x="\<lambda>v. if v\<in>s then u v else 0" in exI)
  3839     unfolding if_smult scaleR_zero_left and sum.inter_restrict[OF assms(1), symmetric]
  3840     apply (auto simp: Int_absorb1)
  3841     done
  3842 qed
  3843 
  3844 lemma Radon_s_lemma:
  3845   assumes "finite s"
  3846     and "sum f s = (0::real)"
  3847   shows "sum f {x\<in>s. 0 < f x} = - sum f {x\<in>s. f x < 0}"
  3848 proof -
  3849   have *: "\<And>x. (if f x < 0 then f x else 0) + (if 0 < f x then f x else 0) = f x"
  3850     by auto
  3851   show ?thesis
  3852     unfolding add_eq_0_iff[symmetric] and sum.inter_filter[OF assms(1)]
  3853       and sum.distrib[symmetric] and *
  3854     using assms(2)
  3855     by assumption
  3856 qed
  3857 
  3858 lemma Radon_v_lemma:
  3859   assumes "finite s"
  3860     and "sum f s = 0"
  3861     and "\<forall>x. g x = (0::real) \<longrightarrow> f x = (0::'a::euclidean_space)"
  3862   shows "(sum f {x\<in>s. 0 < g x}) = - sum f {x\<in>s. g x < 0}"
  3863 proof -
  3864   have *: "\<And>x. (if 0 < g x then f x else 0) + (if g x < 0 then f x else 0) = f x"
  3865     using assms(3) by auto
  3866   show ?thesis
  3867     unfolding eq_neg_iff_add_eq_0 and sum.inter_filter[OF assms(1)]
  3868       and sum.distrib[symmetric] and *
  3869     using assms(2)
  3870     apply assumption
  3871     done
  3872 qed
  3873 
  3874 lemma Radon_partition:
  3875   assumes "finite c" "affine_dependent c"
  3876   shows "\<exists>m p. m \<inter> p = {} \<and> m \<union> p = c \<and> (convex hull m) \<inter> (convex hull p) \<noteq> {}"
  3877 proof -
  3878   obtain u v where uv: "sum u c = 0" "v\<in>c" "u v \<noteq> 0"  "(\<Sum>v\<in>c. u v *\<^sub>R v) = 0"
  3879     using Radon_ex_lemma[OF assms] by auto
  3880   have fin: "finite {x \<in> c. 0 < u x}" "finite {x \<in> c. 0 > u x}"
  3881     using assms(1) by auto
  3882   define z  where "z = inverse (sum u {x\<in>c. u x > 0}) *\<^sub>R sum (\<lambda>x. u x *\<^sub>R x) {x\<in>c. u x > 0}"
  3883   have "sum u {x \<in> c. 0 < u x} \<noteq> 0"
  3884   proof (cases "u v \<ge> 0")
  3885     case False
  3886     then have "u v < 0" by auto
  3887     then show ?thesis
  3888     proof (cases "\<exists>w\<in>{x \<in> c. 0 < u x}. u w > 0")
  3889       case True
  3890       then show ?thesis
  3891         using sum_nonneg_eq_0_iff[of _ u, OF fin(1)] by auto
  3892     next
  3893       case False
  3894       then have "sum u c \<le> sum (\<lambda>x. if x=v then u v else 0) c"
  3895         apply (rule_tac sum_mono, auto)
  3896         done
  3897       then show ?thesis
  3898         unfolding sum.delta[OF assms(1)] using uv(2) and \<open>u v < 0\<close> and uv(1) by auto
  3899     qed
  3900   qed (insert sum_nonneg_eq_0_iff[of _ u, OF fin(1)] uv(2-3), auto)
  3901 
  3902   then have *: "sum u {x\<in>c. u x > 0} > 0"
  3903     unfolding less_le
  3904     apply (rule_tac conjI)
  3905     apply (rule_tac sum_nonneg, auto)
  3906     done
  3907   moreover have "sum u ({x \<in> c. 0 < u x} \<union> {x \<in> c. u x < 0}) = sum u c"
  3908     "(\<Sum>x\<in>{x \<in> c. 0 < u x} \<union> {x \<in> c. u x < 0}. u x *\<^sub>R x) = (\<Sum>x\<in>c. u x *\<^sub>R x)"
  3909     using assms(1)
  3910     apply (rule_tac[!] sum.mono_neutral_left, auto)
  3911     done
  3912   then have "sum u {x \<in> c. 0 < u x} = - sum u {x \<in> c. 0 > u x}"
  3913     "(\<Sum>x\<in>{x \<in> c. 0 < u x}. u x *\<^sub>R x) = - (\<Sum>x\<in>{x \<in> c. 0 > u x}. u x *\<^sub>R x)"
  3914     unfolding eq_neg_iff_add_eq_0
  3915     using uv(1,4)
  3916     by (auto simp: sum.union_inter_neutral[OF fin, symmetric])
  3917   moreover have "\<forall>x\<in>{v \<in> c. u v < 0}. 0 \<le> inverse (sum u {x \<in> c. 0 < u x}) * - u x"
  3918     apply rule
  3919     apply (rule mult_nonneg_nonneg)
  3920     using *
  3921     apply auto
  3922     done
  3923   ultimately have "z \<in> convex hull {v \<in> c. u v \<le> 0}"
  3924     unfolding convex_hull_explicit mem_Collect_eq
  3925     apply (rule_tac x="{v \<in> c. u v < 0}" in exI)
  3926     apply (rule_tac x="\<lambda>y. inverse (sum u {x\<in>c. u x > 0}) * - u y" in exI)
  3927     using assms(1) unfolding scaleR_scaleR[symmetric] scaleR_right.sum [symmetric] and z_def
  3928     apply (auto simp: sum_negf sum_distrib_left[symmetric])
  3929     done
  3930   moreover have "\<forall>x\<in>{v \<in> c. 0 < u v}. 0 \<le> inverse (sum u {x \<in> c. 0 < u x}) * u x"
  3931     apply rule
  3932     apply (rule mult_nonneg_nonneg)
  3933     using *
  3934     apply auto
  3935     done
  3936   then have "z \<in> convex hull {v \<in> c. u v > 0}"
  3937     unfolding convex_hull_explicit mem_Collect_eq
  3938     apply (rule_tac x="{v \<in> c. 0 < u v}" in exI)
  3939     apply (rule_tac x="\<lambda>y. inverse (sum u {x\<in>c. u x > 0}) * u y" in exI)
  3940     using assms(1)
  3941     unfolding scaleR_scaleR[symmetric] scaleR_right.sum [symmetric] and z_def
  3942     using *
  3943     apply (auto simp: sum_negf sum_distrib_left[symmetric])
  3944     done
  3945   ultimately show ?thesis
  3946     apply (rule_tac x="{v\<in>c. u v \<le> 0}" in exI)
  3947     apply (rule_tac x="{v\<in>c. u v > 0}" in exI, auto)
  3948     done
  3949 qed
  3950 
  3951 theorem Radon:
  3952   assumes "affine_dependent c"
  3953   obtains m p where "m \<subseteq> c" "p \<subseteq> c" "m \<inter> p = {}" "(convex hull m) \<inter> (convex hull p) \<noteq> {}"
  3954 proof -
  3955   from assms[unfolded affine_dependent_explicit]
  3956   obtain s u where
  3957       "finite s" "s \<subseteq> c" "sum u s = 0" "\<exists>v\<in>s. u v \<noteq> 0" "(\<Sum>v\<in>s. u v *\<^sub>R v) = 0"
  3958     by blast
  3959   then have *: "finite s" "affine_dependent s" and s: "s \<subseteq> c"
  3960     unfolding affine_dependent_explicit by auto
  3961   from Radon_partition[OF *]
  3962   obtain m p where "m \<inter> p = {}" "m \<union> p = s" "convex hull m \<inter> convex hull p \<noteq> {}"
  3963     by blast
  3964   then show ?thesis
  3965     apply (rule_tac that[of p m])
  3966     using s
  3967     apply auto
  3968     done
  3969 qed
  3970 
  3971 
  3972 subsection \<open>Helly's theorem\<close>
  3973 
  3974 lemma Helly_induct:
  3975   fixes f :: "'a::euclidean_space set set"
  3976   assumes "card f = n"
  3977     and "n \<ge> DIM('a) + 1"
  3978     and "\<forall>s\<in>f. convex s" "\<forall>t\<subseteq>f. card t = DIM('a) + 1 \<longrightarrow> \<Inter>t \<noteq> {}"
  3979   shows "\<Inter>f \<noteq> {}"
  3980   using assms
  3981 proof (induction n arbitrary: f)
  3982   case 0
  3983   then show ?case by auto
  3984 next
  3985   case (Suc n)
  3986   have "finite f"
  3987     using \<open>card f = Suc n\<close> by (auto intro: card_ge_0_finite)
  3988   show "\<Inter>f \<noteq> {}"
  3989   proof (cases "n = DIM('a)")
  3990     case True
  3991     then show ?thesis
  3992       by (simp add: Suc.prems(1) Suc.prems(4))
  3993   next
  3994     case False
  3995     have "\<Inter>(f - {s}) \<noteq> {}" if "s \<in> f" for s
  3996     proof (rule Suc.IH[rule_format])
  3997       show "card (f - {s}) = n"
  3998         by (simp add: Suc.prems(1) \<open>finite f\<close> that)
  3999       show "DIM('a) + 1 \<le> n"
  4000         using False Suc.prems(2) by linarith
  4001       show "\<And>t. \<lbrakk>t \<subseteq> f - {s}; card t = DIM('a) + 1\<rbrakk> \<Longrightarrow> \<Inter>t \<noteq> {}"
  4002         by (simp add: Suc.prems(4) subset_Diff_insert)
  4003     qed (use Suc in auto)
  4004     then have "\<forall>s\<in>f. \<exists>x. x \<in> \<Inter>(f - {s})"
  4005       by blast
  4006     then obtain X where X: "\<And>s. s\<in>f \<Longrightarrow> X s \<in> \<Inter>(f - {s})"
  4007       by metis
  4008     show ?thesis
  4009     proof (cases "inj_on X f")
  4010       case False
  4011       then obtain s t where "s\<noteq>t" and st: "s\<in>f" "t\<in>f" "X s = X t"
  4012         unfolding inj_on_def by auto
  4013       then have *: "\<Inter>f = \<Inter>(f - {s}) \<inter> \<Inter>(f - {t})" by auto
  4014       show ?thesis
  4015         by (metis "*" X disjoint_iff_not_equal st)
  4016     next
  4017       case True
  4018       then obtain m p where mp: "m \<inter> p = {}" "m \<union> p = X ` f" "convex hull m \<inter> convex hull p \<noteq> {}"
  4019         using Radon_partition[of "X ` f"] and affine_dependent_biggerset[of "X ` f"]
  4020         unfolding card_image[OF True] and \<open>card f = Suc n\<close>
  4021         using Suc(3) \<open>finite f\<close> and False
  4022         by auto
  4023       have "m \<subseteq> X ` f" "p \<subseteq> X ` f"
  4024         using mp(2) by auto
  4025       then obtain g h where gh:"m = X ` g" "p = X ` h" "g \<subseteq> f" "h \<subseteq> f"
  4026         unfolding subset_image_iff by auto
  4027       then have "f \<union> (g \<union> h) = f" by auto
  4028       then have f: "f = g \<union> h"
  4029         using inj_on_Un_image_eq_iff[of X f "g \<union> h"] and True
  4030         unfolding mp(2)[unfolded image_Un[symmetric] gh]
  4031         by auto
  4032       have *: "g \<inter> h = {}"
  4033         using mp(1)
  4034         unfolding gh
  4035         using inj_on_image_Int[OF True gh(3,4)]
  4036         by auto
  4037       have "convex hull (X ` h) \<subseteq> \<Inter>g" "convex hull (X ` g) \<subseteq> \<Inter>h"
  4038         by (rule hull_minimal; use X * f in \<open>auto simp: Suc.prems(3) convex_Inter\<close>)+
  4039       then show ?thesis
  4040         unfolding f using mp(3)[unfolded gh] by blast
  4041     qed
  4042   qed 
  4043 qed
  4044 
  4045 theorem Helly:
  4046   fixes f :: "'a::euclidean_space set set"
  4047   assumes "card f \<ge> DIM('a) + 1" "\<forall>s\<in>f. convex s"
  4048     and "\<And>t. \<lbrakk>t\<subseteq>f; card t = DIM('a) + 1\<rbrakk> \<Longrightarrow> \<Inter>t \<noteq> {}"
  4049   shows "\<Inter>f \<noteq> {}"
  4050   apply (rule Helly_induct)
  4051   using assms
  4052   apply auto
  4053   done
  4054 
  4055 subsection \<open>Epigraphs of convex functions\<close>
  4056 
  4057 definition%important "epigraph S (f :: _ \<Rightarrow> real) = {xy. fst xy \<in> S \<and> f (fst xy) \<le> snd xy}"
  4058 
  4059 lemma mem_epigraph: "(x, y) \<in> epigraph S f \<longleftrightarrow> x \<in> S \<and> f x \<le> y"
  4060   unfolding epigraph_def by auto
  4061 
  4062 lemma convex_epigraph: "convex (epigraph S f) \<longleftrightarrow> convex_on S f \<and> convex S"
  4063 proof safe
  4064   assume L: "convex (epigraph S f)"
  4065   then show "convex_on S f"
  4066     by (auto simp: convex_def convex_on_def epigraph_def)
  4067   show "convex S"
  4068     using L
  4069     apply (clarsimp simp: convex_def convex_on_def epigraph_def)
  4070     apply (erule_tac x=x in allE)
  4071     apply (erule_tac x="f x" in allE, safe)
  4072     apply (erule_tac x=y in allE)
  4073     apply (erule_tac x="f y" in allE)
  4074     apply (auto simp: )
  4075     done
  4076 next
  4077   assume "convex_on S f" "convex S"
  4078   then show "convex (epigraph S f)"
  4079     unfolding convex_def convex_on_def epigraph_def
  4080     apply safe
  4081      apply (rule_tac [2] y="u * f a + v * f aa" in order_trans)
  4082       apply (auto intro!:mult_left_mono add_mono)
  4083     done
  4084 qed
  4085 
  4086 lemma convex_epigraphI: "convex_on S f \<Longrightarrow> convex S \<Longrightarrow> convex (epigraph S f)"
  4087   unfolding convex_epigraph by auto
  4088 
  4089 lemma convex_epigraph_convex: "convex S \<Longrightarrow> convex_on S f \<longleftrightarrow> convex(epigraph S f)"
  4090   by (simp add: convex_epigraph)
  4091 
  4092 
  4093 subsubsection%unimportant \<open>Use this to derive general bound property of convex function\<close>
  4094 
  4095 lemma convex_on:
  4096   assumes "convex S"
  4097   shows "convex_on S f \<longleftrightarrow>
  4098     (\<forall>k u x. (\<forall>i\<in>{1..k::nat}. 0 \<le> u i \<and> x i \<in> S) \<and> sum u {1..k} = 1 \<longrightarrow>
  4099       f (sum (\<lambda>i. u i *\<^sub>R x i) {1..k}) \<le> sum (\<lambda>i. u i * f(x i)) {1..k})"
  4100 
  4101   unfolding convex_epigraph_convex[OF assms] convex epigraph_def Ball_def mem_Collect_eq
  4102   unfolding fst_sum snd_sum fst_scaleR snd_scaleR
  4103   apply safe
  4104     apply (drule_tac x=k in spec)
  4105     apply (drule_tac x=u in spec)
  4106     apply (drule_tac x="\<lambda>i. (x i, f (x i))" in spec)
  4107     apply simp
  4108   using assms[unfolded convex] apply simp
  4109   apply (rule_tac y="\<Sum>i = 1..k. u i * f (fst (x i))" in order_trans, force)
  4110    apply (rule sum_mono)
  4111    apply (erule_tac x=i in allE)
  4112   unfolding real_scaleR_def
  4113    apply (rule mult_left_mono)
  4114   using assms[unfolded convex] apply auto
  4115   done
  4116 
  4117 subsection%unimportant \<open>A bound within a convex hull\<close>
  4118 
  4119 lemma convex_on_convex_hull_bound:
  4120   assumes "convex_on (convex hull s) f"
  4121     and "\<forall>x\<in>s. f x \<le> b"
  4122   shows "\<forall>x\<in> convex hull s. f x \<le> b"
  4123 proof
  4124   fix x
  4125   assume "x \<in> convex hull s"
  4126   then obtain k u v where
  4127     obt: "\<forall>i\<in>{1..k::nat}. 0 \<le> u i \<and> v i \<in> s" "sum u {1..k} = 1" "(\<Sum>i = 1..k. u i *\<^sub>R v i) = x"
  4128     unfolding convex_hull_indexed mem_Collect_eq by auto
  4129   have "(\<Sum>i = 1..k. u i * f (v i)) \<le> b"
  4130     using sum_mono[of "{1..k}" "\<lambda>i. u i * f (v i)" "\<lambda>i. u i * b"]
  4131     unfolding sum_distrib_right[symmetric] obt(2) mult_1
  4132     apply (drule_tac meta_mp)
  4133     apply (rule mult_left_mono)
  4134     using assms(2) obt(1)
  4135     apply auto
  4136     done
  4137   then show "f x \<le> b"
  4138     using assms(1)[unfolded convex_on[OF convex_convex_hull], rule_format, of k u v]
  4139     unfolding obt(2-3)
  4140     using obt(1) and hull_subset[unfolded subset_eq, rule_format, of _ s]
  4141     by auto
  4142 qed
  4143 
  4144 lemma inner_sum_Basis[simp]: "i \<in> Basis \<Longrightarrow> (\<Sum>Basis) \<bullet> i = 1"
  4145   by (simp add: inner_sum_left sum.If_cases inner_Basis)
  4146 
  4147 lemma convex_set_plus:
  4148   assumes "convex S" and "convex T" shows "convex (S + T)"
  4149 proof -
  4150   have "convex (\<Union>x\<in> S. \<Union>y \<in> T. {x + y})"
  4151     using assms by (rule convex_sums)
  4152   moreover have "(\<Union>x\<in> S. \<Union>y \<in> T. {x + y}) = S + T"
  4153     unfolding set_plus_def by auto
  4154   finally show "convex (S + T)" .
  4155 qed
  4156 
  4157 lemma convex_set_sum:
  4158   assumes "\<And>i. i \<in> A \<Longrightarrow> convex (B i)"
  4159   shows "convex (\<Sum>i\<in>A. B i)"
  4160 proof (cases "finite A")
  4161   case True then show ?thesis using assms
  4162     by induct (auto simp: convex_set_plus)
  4163 qed auto
  4164 
  4165 lemma finite_set_sum:
  4166   assumes "finite A" and "\<forall>i\<in>A. finite (B i)" shows "finite (\<Sum>i\<in>A. B i)"
  4167   using assms by (induct set: finite, simp, simp add: finite_set_plus)
  4168 
  4169 lemma box_eq_set_sum_Basis:
  4170   shows "{x. \<forall>i\<in>Basis. x\<bullet>i \<in> B i} = (\<Sum>i\<in>Basis. image (\<lambda>x. x *\<^sub>R i) (B i))"
  4171   apply (subst set_sum_alt [OF finite_Basis], safe)
  4172   apply (fast intro: euclidean_representation [symmetric])
  4173   apply (subst inner_sum_left)
  4174 apply (rename_tac f)
  4175   apply (subgoal_tac "(\<Sum>x\<in>Basis. f x \<bullet> i) = f i \<bullet> i")
  4176   apply (drule (1) bspec)
  4177   apply clarsimp
  4178   apply (frule sum.remove [OF finite_Basis])
  4179   apply (erule trans, simp)
  4180   apply (rule sum.neutral, clarsimp)
  4181   apply (frule_tac x=i in bspec, assumption)
  4182   apply (drule_tac x=x in bspec, assumption, clarsimp)
  4183   apply (cut_tac u=x and v=i in inner_Basis, assumption+)
  4184   apply (rule ccontr, simp)
  4185   done
  4186 
  4187 lemma convex_hull_set_sum:
  4188   "convex hull (\<Sum>i\<in>A. B i) = (\<Sum>i\<in>A. convex hull (B i))"
  4189 proof (cases "finite A")
  4190   assume "finite A" then show ?thesis
  4191     by (induct set: finite, simp, simp add: convex_hull_set_plus)
  4192 qed simp
  4193 
  4194 
  4195 end