| author | paulson <lp15@cam.ac.uk> | 
| Wed, 07 Feb 2024 11:52:34 +0000 | |
| changeset 79583 | a521c241e946 | 
| parent 79582 | 7822b55b26ce | 
| child 79670 | f471e1715fc4 | 
| permissions | -rw-r--r-- | 
| 
70086
 
72c52a897de2
First tranche of the Homology development: Simplices
 
paulson <lp15@cam.ac.uk> 
parents: 
69802 
diff
changeset
 | 
1  | 
(* Title: HOL/Analysis/Convex.thy  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2  | 
Author: L C Paulson, University of Cambridge  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
3  | 
Author: Robert Himmelmann, TU Muenchen  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
4  | 
Author: Bogdan Grechuk, University of Edinburgh  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
5  | 
Author: Armin Heller, TU Muenchen  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
6  | 
Author: Johannes Hoelzl, TU Muenchen  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
7  | 
*)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
8  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
9  | 
section \<open>Convex Sets and Functions\<close>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
10  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
11  | 
theory Convex  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
12  | 
imports  | 
| 
79583
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
13  | 
Affine "HOL-Library.Set_Algebras" "HOL-Library.FuncSet"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
14  | 
begin  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
15  | 
|
| 71044 | 16  | 
subsection \<open>Convex Sets\<close>  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
17  | 
|
| 70136 | 18  | 
definition\<^marker>\<open>tag important\<close> convex :: "'a::real_vector set \<Rightarrow> bool"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
19  | 
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)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
20  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
21  | 
lemma convexI:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
22  | 
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"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
23  | 
shows "convex s"  | 
| 78475 | 24  | 
by (simp add: assms convex_def)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
25  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
26  | 
lemma convexD:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
27  | 
assumes "convex s" and "x \<in> s" and "y \<in> s" and "0 \<le> u" and "0 \<le> v" and "u + v = 1"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
28  | 
shows "u *\<^sub>R x + v *\<^sub>R y \<in> s"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
29  | 
using assms unfolding convex_def by fast  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
30  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
31  | 
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)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
32  | 
(is "_ \<longleftrightarrow> ?alt")  | 
| 78475 | 33  | 
by (smt (verit) convexD convexI)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
34  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
35  | 
lemma convexD_alt:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
36  | 
assumes "convex s" "a \<in> s" "b \<in> s" "0 \<le> u" "u \<le> 1"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
37  | 
shows "((1 - u) *\<^sub>R a + u *\<^sub>R b) \<in> s"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
38  | 
using assms unfolding convex_alt by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
39  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
40  | 
lemma mem_convex_alt:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
41  | 
assumes "convex S" "x \<in> S" "y \<in> S" "u \<ge> 0" "v \<ge> 0" "u + v > 0"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
42  | 
shows "((u/(u+v)) *\<^sub>R x + (v/(u+v)) *\<^sub>R y) \<in> S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
43  | 
using assms  | 
| 72385 | 44  | 
by (simp add: convex_def zero_le_divide_iff add_divide_distrib [symmetric])  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
45  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
46  | 
lemma convex_empty[intro,simp]: "convex {}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
47  | 
unfolding convex_def by simp  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
48  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
49  | 
lemma convex_singleton[intro,simp]: "convex {a}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
50  | 
unfolding convex_def by (auto simp: scaleR_left_distrib[symmetric])  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
51  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
52  | 
lemma convex_UNIV[intro,simp]: "convex UNIV"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
53  | 
unfolding convex_def by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
54  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
55  | 
lemma convex_Inter: "(\<And>s. s\<in>f \<Longrightarrow> convex s) \<Longrightarrow> convex(\<Inter>f)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
56  | 
unfolding convex_def by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
57  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
58  | 
lemma convex_Int: "convex s \<Longrightarrow> convex t \<Longrightarrow> convex (s \<inter> t)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
59  | 
unfolding convex_def by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
60  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
61  | 
lemma convex_INT: "(\<And>i. i \<in> A \<Longrightarrow> convex (B i)) \<Longrightarrow> convex (\<Inter>i\<in>A. B i)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
62  | 
unfolding convex_def by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
63  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
64  | 
lemma convex_Times: "convex s \<Longrightarrow> convex t \<Longrightarrow> convex (s \<times> t)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
65  | 
unfolding convex_def by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
66  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
67  | 
lemma convex_halfspace_le: "convex {x. inner a x \<le> b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
68  | 
unfolding convex_def  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
69  | 
by (auto simp: inner_add intro!: convex_bound_le)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
70  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
71  | 
lemma convex_halfspace_ge: "convex {x. inner a x \<ge> b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
72  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
73  | 
  have *: "{x. inner a x \<ge> b} = {x. inner (-a) x \<le> -b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
74  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
75  | 
show ?thesis  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
76  | 
unfolding * using convex_halfspace_le[of "-a" "-b"] by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
77  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
78  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
79  | 
lemma convex_halfspace_abs_le: "convex {x. \<bar>inner a x\<bar> \<le> b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
80  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
81  | 
  have *: "{x. \<bar>inner a x\<bar> \<le> b} = {x. inner a x \<le> b} \<inter> {x. -b \<le> inner a x}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
82  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
83  | 
show ?thesis  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
84  | 
unfolding * by (simp add: convex_Int convex_halfspace_ge convex_halfspace_le)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
85  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
86  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
87  | 
lemma convex_hyperplane: "convex {x. inner a x = b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
88  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
89  | 
  have *: "{x. inner a x = b} = {x. inner a x \<le> b} \<inter> {x. inner a x \<ge> b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
90  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
91  | 
show ?thesis using convex_halfspace_le convex_halfspace_ge  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
92  | 
by (auto intro!: convex_Int simp: *)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
93  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
94  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
95  | 
lemma convex_halfspace_lt: "convex {x. inner a x < b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
96  | 
unfolding convex_def  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
97  | 
by (auto simp: convex_bound_lt inner_add)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
98  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
99  | 
lemma convex_halfspace_gt: "convex {x. inner a x > b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
100  | 
using convex_halfspace_lt[of "-a" "-b"] by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
101  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
102  | 
lemma convex_halfspace_Re_ge: "convex {x. Re x \<ge> b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
103  | 
using convex_halfspace_ge[of b "1::complex"] by simp  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
104  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
105  | 
lemma convex_halfspace_Re_le: "convex {x. Re x \<le> b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
106  | 
using convex_halfspace_le[of "1::complex" b] by simp  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
107  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
108  | 
lemma convex_halfspace_Im_ge: "convex {x. Im x \<ge> b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
109  | 
using convex_halfspace_ge[of b \<i>] by simp  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
110  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
111  | 
lemma convex_halfspace_Im_le: "convex {x. Im x \<le> b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
112  | 
using convex_halfspace_le[of \<i> b] by simp  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
113  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
114  | 
lemma convex_halfspace_Re_gt: "convex {x. Re x > b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
115  | 
using convex_halfspace_gt[of b "1::complex"] by simp  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
116  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
117  | 
lemma convex_halfspace_Re_lt: "convex {x. Re x < b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
118  | 
using convex_halfspace_lt[of "1::complex" b] by simp  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
119  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
120  | 
lemma convex_halfspace_Im_gt: "convex {x. Im x > b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
121  | 
using convex_halfspace_gt[of b \<i>] by simp  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
122  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
123  | 
lemma convex_halfspace_Im_lt: "convex {x. Im x < b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
124  | 
using convex_halfspace_lt[of \<i> b] by simp  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
125  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
126  | 
lemma convex_real_interval [iff]:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
127  | 
fixes a b :: "real"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
128  | 
  shows "convex {a..}" and "convex {..b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
129  | 
    and "convex {a<..}" and "convex {..<b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
130  | 
    and "convex {a..b}" and "convex {a<..b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
131  | 
    and "convex {a..<b}" and "convex {a<..<b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
132  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
133  | 
  have "{a..} = {x. a \<le> inner 1 x}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
134  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
135  | 
  then show 1: "convex {a..}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
136  | 
by (simp only: convex_halfspace_ge)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
137  | 
  have "{..b} = {x. inner 1 x \<le> b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
138  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
139  | 
  then show 2: "convex {..b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
140  | 
by (simp only: convex_halfspace_le)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
141  | 
  have "{a<..} = {x. a < inner 1 x}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
142  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
143  | 
  then show 3: "convex {a<..}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
144  | 
by (simp only: convex_halfspace_gt)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
145  | 
  have "{..<b} = {x. inner 1 x < b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
146  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
147  | 
  then show 4: "convex {..<b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
148  | 
by (simp only: convex_halfspace_lt)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
149  | 
  have "{a..b} = {a..} \<inter> {..b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
150  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
151  | 
  then show "convex {a..b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
152  | 
by (simp only: convex_Int 1 2)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
153  | 
  have "{a<..b} = {a<..} \<inter> {..b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
154  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
155  | 
  then show "convex {a<..b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
156  | 
by (simp only: convex_Int 3 2)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
157  | 
  have "{a..<b} = {a..} \<inter> {..<b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
158  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
159  | 
  then show "convex {a..<b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
160  | 
by (simp only: convex_Int 1 4)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
161  | 
  have "{a<..<b} = {a<..} \<inter> {..<b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
162  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
163  | 
  then show "convex {a<..<b}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
164  | 
by (simp only: convex_Int 3 4)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
165  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
166  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
167  | 
lemma convex_Reals: "convex \<real>"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
168  | 
by (simp add: convex_def scaleR_conv_of_real)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
169  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
170  | 
|
| 70136 | 171  | 
subsection\<^marker>\<open>tag unimportant\<close> \<open>Explicit expressions for convexity in terms of arbitrary sums\<close>  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
172  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
173  | 
lemma convex_sum:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
174  | 
fixes C :: "'a::real_vector set"  | 
| 72385 | 175  | 
assumes "finite S"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
176  | 
and "convex C"  | 
| 78475 | 177  | 
and a: "(\<Sum> i \<in> S. a i) = 1" "\<And>i. i \<in> S \<Longrightarrow> a i \<ge> 0"  | 
178  | 
and C: "\<And>i. i \<in> S \<Longrightarrow> y i \<in> C"  | 
|
| 72385 | 179  | 
shows "(\<Sum> j \<in> S. a j *\<^sub>R y j) \<in> C"  | 
| 78475 | 180  | 
using \<open>finite S\<close> a C  | 
181  | 
proof (induction arbitrary: a set: finite)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
182  | 
case empty  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
183  | 
then show ?case by simp  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
184  | 
next  | 
| 78475 | 185  | 
case (insert i S)  | 
| 72385 | 186  | 
then have "0 \<le> sum a S"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
187  | 
by (simp add: sum_nonneg)  | 
| 72385 | 188  | 
have "a i *\<^sub>R y i + (\<Sum>j\<in>S. a j *\<^sub>R y j) \<in> C"  | 
189  | 
proof (cases "sum a S = 0")  | 
|
| 78475 | 190  | 
case True with insert show ?thesis  | 
191  | 
by (simp add: sum_nonneg_eq_0_iff)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
192  | 
next  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
193  | 
case False  | 
| 72385 | 194  | 
with \<open>0 \<le> sum a S\<close> have "0 < sum a S"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
195  | 
by simp  | 
| 72385 | 196  | 
then have "(\<Sum>j\<in>S. (a j / sum a S) *\<^sub>R y j) \<in> C"  | 
| 78475 | 197  | 
using insert  | 
198  | 
by (simp add: insert.IH flip: sum_divide_distrib)  | 
|
199  | 
with \<open>convex C\<close> insert \<open>0 \<le> sum a S\<close>  | 
|
| 72385 | 200  | 
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"  | 
| 78475 | 201  | 
by (simp add: convex_def)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
202  | 
then show ?thesis  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
203  | 
by (simp add: scaleR_sum_right False)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
204  | 
qed  | 
| 72385 | 205  | 
then show ?case using \<open>finite S\<close> and \<open>i \<notin> S\<close>  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
206  | 
by simp  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
207  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
208  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
209  | 
lemma convex:  | 
| 78475 | 210  | 
"convex S \<longleftrightarrow>  | 
211  | 
    (\<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)
 | 
|
212  | 
      \<longrightarrow> sum (\<lambda>i. u i *\<^sub>R x i) {1..k} \<in> S)"  
 | 
|
213  | 
(is "?lhs = ?rhs")  | 
|
214  | 
proof  | 
|
215  | 
show "?lhs \<Longrightarrow> ?rhs"  | 
|
216  | 
by (metis (full_types) atLeastAtMost_iff convex_sum finite_atLeastAtMost)  | 
|
| 72385 | 217  | 
  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
 | 
218  | 
\<longrightarrow> (\<Sum>i = 1..k. u i *\<^sub>R (x i :: 'a)) \<in> S"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
219  | 
  {
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
220  | 
fix \<mu> :: real  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
221  | 
fix x y :: 'a  | 
| 72385 | 222  | 
assume xy: "x \<in> S" "y \<in> S"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
223  | 
assume mu: "\<mu> \<ge> 0" "\<mu> \<le> 1"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
224  | 
let ?u = "\<lambda>i. if (i :: nat) = 1 then \<mu> else 1 - \<mu>"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
225  | 
let ?x = "\<lambda>i. if (i :: nat) = 1 then x else y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
226  | 
    have "{1 :: nat .. 2} \<inter> - {x. x = 1} = {2}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
227  | 
by auto  | 
| 78475 | 228  | 
    then have S: "(\<Sum>j \<in> {1..2}. ?u j *\<^sub>R ?x j) \<in> S"
 | 
229  | 
      using sum.If_cases[of "{(1 :: nat) .. 2}" "\<lambda>x. x = 1" "\<lambda>x. \<mu>" "\<lambda>x. 1 - \<mu>"]
 | 
|
230  | 
using mu xy "*" by auto  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
231  | 
    have grarr: "(\<Sum>j \<in> {Suc (Suc 0)..2}. ?u j *\<^sub>R ?x j) = (1 - \<mu>) *\<^sub>R y"
 | 
| 
70097
 
4005298550a6
The last big tranche of Homology material: invariance of domain; renamings to use generic sum/prod lemmas from their locale
 
paulson <lp15@cam.ac.uk> 
parents: 
70086 
diff
changeset
 | 
232  | 
using sum.atLeast_Suc_atMost[of "Suc (Suc 0)" 2 "\<lambda> j. (1 - \<mu>) *\<^sub>R y"] by auto  | 
| 78475 | 233  | 
with sum.atLeast_Suc_atMost  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
234  | 
    have "(\<Sum>j \<in> {1..2}. ?u j *\<^sub>R ?x j) = \<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y"
 | 
| 78475 | 235  | 
by (smt (verit, best) Suc_1 Suc_eq_plus1 add_0 le_add1)  | 
| 72385 | 236  | 
then have "(1 - \<mu>) *\<^sub>R y + \<mu> *\<^sub>R x \<in> S"  | 
237  | 
using S by (auto simp: add.commute)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
238  | 
}  | 
| 72385 | 239  | 
then show "convex S"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
240  | 
unfolding convex_alt by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
241  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
242  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
243  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
244  | 
lemma convex_explicit:  | 
| 72385 | 245  | 
fixes S :: "'a::real_vector set"  | 
246  | 
shows "convex S \<longleftrightarrow>  | 
|
247  | 
(\<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)"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
248  | 
proof safe  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
249  | 
fix t  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
250  | 
fix u :: "'a \<Rightarrow> real"  | 
| 72385 | 251  | 
assume "convex S"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
252  | 
and "finite t"  | 
| 72385 | 253  | 
and "t \<subseteq> S" "\<forall>x\<in>t. 0 \<le> u x" "sum u t = 1"  | 
254  | 
then show "(\<Sum>x\<in>t. u x *\<^sub>R x) \<in> S"  | 
|
| 78475 | 255  | 
by (simp add: convex_sum subsetD)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
256  | 
next  | 
| 72385 | 257  | 
assume *: "\<forall>t. \<forall> u. finite t \<and> t \<subseteq> S \<and> (\<forall>x\<in>t. 0 \<le> u x) \<and>  | 
258  | 
sum u t = 1 \<longrightarrow> (\<Sum>x\<in>t. u x *\<^sub>R x) \<in> S"  | 
|
259  | 
show "convex S"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
260  | 
unfolding convex_alt  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
261  | 
proof safe  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
262  | 
fix x y  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
263  | 
fix \<mu> :: real  | 
| 72385 | 264  | 
assume **: "x \<in> S" "y \<in> S" "0 \<le> \<mu>" "\<mu> \<le> 1"  | 
265  | 
show "(1 - \<mu>) *\<^sub>R x + \<mu> *\<^sub>R y \<in> S"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
266  | 
proof (cases "x = y")  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
267  | 
case False  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
268  | 
then show ?thesis  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
269  | 
        using *[rule_format, of "{x, y}" "\<lambda> z. if z = x then 1 - \<mu> else \<mu>"] **
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
270  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
271  | 
next  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
272  | 
case True  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
273  | 
then show ?thesis  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
274  | 
        using *[rule_format, of "{x, y}" "\<lambda> z. 1"] **
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
275  | 
by (auto simp: field_simps real_vector.scale_left_diff_distrib)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
276  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
277  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
278  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
279  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
280  | 
lemma convex_finite:  | 
| 72385 | 281  | 
assumes "finite S"  | 
282  | 
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)"  | 
|
283  | 
(is "?lhs = ?rhs")  | 
|
284  | 
proof  | 
|
285  | 
  { have if_distrib_arg: "\<And>P f g x. (if P then f else g) x = (if P then f x else g x)"
 | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
286  | 
by simp  | 
| 72385 | 287  | 
fix T :: "'a set" and u :: "'a \<Rightarrow> real"  | 
288  | 
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"  | 
|
289  | 
assume *: "\<forall>x\<in>T. 0 \<le> u x" "sum u T = 1"  | 
|
290  | 
assume "T \<subseteq> S"  | 
|
291  | 
then have "S \<inter> T = T" by auto  | 
|
| 78475 | 292  | 
with sum[THEN spec[where x="\<lambda>x. if x\<in>T then u x else 0"]] *  | 
293  | 
have "(\<Sum>x\<in>T. u x *\<^sub>R x) \<in> S"  | 
|
| 72385 | 294  | 
by (auto simp: assms sum.If_cases if_distrib if_distrib_arg) }  | 
295  | 
moreover assume ?rhs  | 
|
296  | 
ultimately show ?lhs  | 
|
297  | 
unfolding convex_explicit by auto  | 
|
298  | 
qed (auto simp: convex_explicit assms)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
299  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
300  | 
|
| 71044 | 301  | 
subsection \<open>Convex Functions on a Set\<close>  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
302  | 
|
| 70136 | 303  | 
definition\<^marker>\<open>tag important\<close> convex_on :: "'a::real_vector set \<Rightarrow> ('a \<Rightarrow> real) \<Rightarrow> bool"
 | 
| 
79582
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
304  | 
where "convex_on S f \<longleftrightarrow> convex S \<and>  | 
| 72385 | 305  | 
(\<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)"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
306  | 
|
| 
74729
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
307  | 
definition\<^marker>\<open>tag important\<close> concave_on :: "'a::real_vector set \<Rightarrow> ('a \<Rightarrow> real) \<Rightarrow> bool"
 | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
308  | 
where "concave_on S f \<equiv> convex_on S (\<lambda>x. - f x)"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
309  | 
|
| 
79583
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
310  | 
lemma convex_on_iff_concave: "convex_on S f = concave_on S (\<lambda>x. - f x)"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
311  | 
by (simp add: concave_on_def)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
312  | 
|
| 
74729
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
313  | 
lemma concave_on_iff:  | 
| 
79582
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
314  | 
"concave_on S f \<longleftrightarrow> convex S \<and>  | 
| 
74729
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
315  | 
(\<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) \<ge> u * f x + v * f y)"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
316  | 
by (auto simp: concave_on_def convex_on_def algebra_simps)  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
317  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
318  | 
lemma convex_onI [intro?]:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
319  | 
assumes "\<And>t x y. t > 0 \<Longrightarrow> t < 1 \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
320  | 
f ((1 - t) *\<^sub>R x + t *\<^sub>R y) \<le> (1 - t) * f x + t * f y"  | 
| 
79582
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
321  | 
and "convex A"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
322  | 
shows "convex_on A f"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
323  | 
unfolding convex_on_def  | 
| 78475 | 324  | 
by (smt (verit, del_insts) assms mult_cancel_right1 mult_eq_0_iff scaleR_collapse scaleR_eq_0_iff)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
325  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
326  | 
lemma convex_on_linorderI [intro?]:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
327  | 
  fixes A :: "('a::{linorder,real_vector}) set"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
328  | 
assumes "\<And>t x y. t > 0 \<Longrightarrow> t < 1 \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x < y \<Longrightarrow>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
329  | 
f ((1 - t) *\<^sub>R x + t *\<^sub>R y) \<le> (1 - t) * f x + t * f y"  | 
| 
79582
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
330  | 
and "convex A"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
331  | 
shows "convex_on A f"  | 
| 78475 | 332  | 
by (smt (verit, best) add.commute assms convex_onI distrib_left linorder_cases mult.commute mult_cancel_left2 scaleR_collapse)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
333  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
334  | 
lemma convex_onD:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
335  | 
assumes "convex_on A f"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
336  | 
shows "\<And>t x y. t \<ge> 0 \<Longrightarrow> t \<le> 1 \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
337  | 
f ((1 - t) *\<^sub>R x + t *\<^sub>R y) \<le> (1 - t) * f x + t * f y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
338  | 
using assms by (auto simp: convex_on_def)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
339  | 
|
| 
79582
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
340  | 
lemma convex_on_imp_convex: "convex_on A f \<Longrightarrow> convex A"  | 
| 
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
341  | 
by (auto simp: convex_on_def)  | 
| 
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
342  | 
|
| 
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
343  | 
lemma concave_on_imp_convex: "concave_on A f \<Longrightarrow> convex A"  | 
| 
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
344  | 
by (simp add: concave_on_def convex_on_imp_convex)  | 
| 
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
345  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
346  | 
lemma convex_onD_Icc:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
347  | 
  assumes "convex_on {x..y} f" "x \<le> (y :: _ :: {real_vector,preorder})"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
348  | 
shows "\<And>t. t \<ge> 0 \<Longrightarrow> t \<le> 1 \<Longrightarrow>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
349  | 
f ((1 - t) *\<^sub>R x + t *\<^sub>R y) \<le> (1 - t) * f x + t * f y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
350  | 
using assms(2) by (intro convex_onD [OF assms(1)]) simp_all  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
351  | 
|
| 
79582
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
352  | 
lemma convex_on_subset: "\<lbrakk>convex_on T f; S \<subseteq> T; convex S\<rbrakk> \<Longrightarrow> convex_on S f"  | 
| 
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
353  | 
by (simp add: convex_on_def subset_iff)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
354  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
355  | 
lemma convex_on_add [intro]:  | 
| 72385 | 356  | 
assumes "convex_on S f"  | 
357  | 
and "convex_on S g"  | 
|
358  | 
shows "convex_on S (\<lambda>x. f x + g x)"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
359  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
360  | 
  {
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
361  | 
fix x y  | 
| 72385 | 362  | 
assume "x \<in> S" "y \<in> S"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
363  | 
moreover  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
364  | 
fix u v :: real  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
365  | 
assume "0 \<le> u" "0 \<le> v" "u + v = 1"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
366  | 
ultimately  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
367  | 
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)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
368  | 
using assms unfolding convex_on_def by (auto simp: add_mono)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
369  | 
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)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
370  | 
by (simp add: field_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
371  | 
}  | 
| 
79582
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
372  | 
with assms show ?thesis  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
373  | 
unfolding convex_on_def by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
374  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
375  | 
|
| 
79583
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
376  | 
lemma convex_on_ident: "convex_on S (\<lambda>x. x) \<longleftrightarrow> convex S"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
377  | 
by (simp add: convex_on_def)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
378  | 
|
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
379  | 
lemma concave_on_ident: "concave_on S (\<lambda>x. x) \<longleftrightarrow> convex S"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
380  | 
by (simp add: concave_on_iff)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
381  | 
|
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
382  | 
lemma convex_on_const: "convex_on S (\<lambda>x. a) \<longleftrightarrow> convex S"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
383  | 
by (simp add: convex_on_def flip: distrib_right)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
384  | 
|
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
385  | 
lemma concave_on_const: "concave_on S (\<lambda>x. a) \<longleftrightarrow> convex S"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
386  | 
by (simp add: concave_on_iff flip: distrib_right)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
387  | 
|
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
388  | 
lemma convex_on_diff:  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
389  | 
assumes "convex_on S f" and "concave_on S g"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
390  | 
shows "convex_on S (\<lambda>x. f x - g x)"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
391  | 
using assms concave_on_def convex_on_add by fastforce  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
392  | 
|
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
393  | 
lemma concave_on_diff:  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
394  | 
assumes "concave_on S f"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
395  | 
and "convex_on S g"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
396  | 
shows "concave_on S (\<lambda>x. f x - g x)"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
397  | 
using convex_on_diff assms concave_on_def by fastforce  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
398  | 
|
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
399  | 
lemma concave_on_add:  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
400  | 
assumes "concave_on S f"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
401  | 
and "concave_on S g"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
402  | 
shows "concave_on S (\<lambda>x. f x + g x)"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
403  | 
using assms convex_on_iff_concave concave_on_diff concave_on_def by fastforce  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
404  | 
|
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
405  | 
lemma convex_on_mul:  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
406  | 
fixes S::"real set"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
407  | 
assumes "convex_on S f" "convex_on S g"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
408  | 
assumes "mono_on S f" "mono_on S g"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
409  | 
  assumes fty: "f \<in> S \<rightarrow> {0..}" and gty: "g \<in> S \<rightarrow> {0..}"
 | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
410  | 
shows "convex_on S (\<lambda>x. f x * g x)"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
411  | 
proof (intro convex_on_linorderI)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
412  | 
show "convex S"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
413  | 
using \<open>convex_on S f\<close> convex_on_imp_convex by blast  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
414  | 
fix t::real and x y  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
415  | 
assume t: "0 < t" "t < 1" and xy: "x \<in> S" "y \<in> S"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
416  | 
have "f x*g y + f y*g x \<le> f x*g x + f y*g y"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
417  | 
using \<open>mono_on S f\<close> \<open>mono_on S g\<close>  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
418  | 
by (smt (verit, ccfv_SIG) mono_onD mult_right_mono right_diff_distrib' xy)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
419  | 
then have "(1-t) * f x * g y + (1-t) * f y * g x \<le> (1-t) * f x * g x + (1-t) * f y * g y"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
420  | 
using t  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
421  | 
by (metis (mono_tags, opaque_lifting) mult.assoc diff_gt_0_iff_gt distrib_left mult_le_cancel_left_pos)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
422  | 
then have *: "t*(1-t) * f x * g y + t*(1-t) * f y * g x \<le> t*(1-t) * f x * g x + t*(1-t) * f y * g y"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
423  | 
using t  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
424  | 
by (metis (mono_tags, opaque_lifting) mult.assoc distrib_left mult_le_cancel_left_pos)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
425  | 
have inS: "(1-t)*x + t*y \<in> S"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
426  | 
using t xy \<open>convex S\<close> by (simp add: convex_alt)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
427  | 
then have "f ((1-t)*x + t*y) * g ((1-t)*x + t*y) \<le> ((1-t)*f x + t*f y)*g ((1-t)*x + t*y)"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
428  | 
using convex_onD [OF \<open>convex_on S f\<close>, of t x y] t xy fty gty  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
429  | 
by (intro mult_mono add_nonneg_nonneg) (auto simp: Pi_iff zero_le_mult_iff)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
430  | 
also have "\<dots> \<le> ((1-t)*f x + t*f y) * ((1-t)*g x + t*g y)"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
431  | 
using convex_onD [OF \<open>convex_on S g\<close>, of t x y] t xy fty gty inS  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
432  | 
by (intro mult_mono add_nonneg_nonneg) (auto simp: Pi_iff zero_le_mult_iff)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
433  | 
also have "\<dots> \<le> (1-t) * (f x*g x) + t * (f y*g y)"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
434  | 
using * by (simp add: algebra_simps)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
435  | 
finally show "f ((1-t) *\<^sub>R x + t *\<^sub>R y) * g ((1-t) *\<^sub>R x + t *\<^sub>R y) \<le> (1-t)*(f x*g x) + t*(f y*g y)"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
436  | 
by simp  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
437  | 
qed  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
438  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
439  | 
lemma convex_on_cmul [intro]:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
440  | 
fixes c :: real  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
441  | 
assumes "0 \<le> c"  | 
| 72385 | 442  | 
and "convex_on S f"  | 
443  | 
shows "convex_on S (\<lambda>x. c * f x)"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
444  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
445  | 
have *: "u * (c * fx) + v * (c * fy) = c * (u * fx + v * fy)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
446  | 
for u c fx v fy :: real  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
447  | 
by (simp add: field_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
448  | 
show ?thesis using assms(2) and mult_left_mono [OF _ assms(1)]  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
449  | 
unfolding convex_on_def and * by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
450  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
451  | 
|
| 
79583
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
452  | 
lemma convex_on_cdiv [intro]:  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
453  | 
fixes c :: real  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
454  | 
assumes "0 \<le> c" and "convex_on S f"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
455  | 
shows "convex_on S (\<lambda>x. f x / c)"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
456  | 
unfolding divide_inverse  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
457  | 
using convex_on_cmul [of "inverse c" S f] by (simp add: mult.commute assms)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
458  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
459  | 
lemma convex_lower:  | 
| 72385 | 460  | 
assumes "convex_on S f"  | 
461  | 
and "x \<in> S"  | 
|
462  | 
and "y \<in> S"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
463  | 
and "0 \<le> u"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
464  | 
and "0 \<le> v"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
465  | 
and "u + v = 1"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
466  | 
shows "f (u *\<^sub>R x + v *\<^sub>R y) \<le> max (f x) (f y)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
467  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
468  | 
let ?m = "max (f x) (f y)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
469  | 
have "u * f x + v * f y \<le> u * max (f x) (f y) + v * max (f x) (f y)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
470  | 
using assms(4,5) by (auto simp: mult_left_mono add_mono)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
471  | 
also have "\<dots> = max (f x) (f y)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
472  | 
using assms(6) by (simp add: distrib_right [symmetric])  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
473  | 
finally show ?thesis  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
474  | 
using assms unfolding convex_on_def by fastforce  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
475  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
476  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
477  | 
lemma convex_on_dist [intro]:  | 
| 72385 | 478  | 
fixes S :: "'a::real_normed_vector set"  | 
| 
79582
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
479  | 
assumes "convex S"  | 
| 72385 | 480  | 
shows "convex_on S (\<lambda>x. dist a x)"  | 
| 
79582
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
481  | 
unfolding convex_on_def dist_norm  | 
| 
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
482  | 
proof (intro conjI strip)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
483  | 
fix x y  | 
| 72385 | 484  | 
assume "x \<in> S" "y \<in> S"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
485  | 
fix u v :: real  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
486  | 
assume "0 \<le> u"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
487  | 
assume "0 \<le> v"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
488  | 
assume "u + v = 1"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
489  | 
have "a = u *\<^sub>R a + v *\<^sub>R a"  | 
| 78475 | 490  | 
by (metis \<open>u + v = 1\<close> scaleR_left.add scaleR_one)  | 
491  | 
then have "a - (u *\<^sub>R x + v *\<^sub>R y) = (u *\<^sub>R (a - x)) + (v *\<^sub>R (a - y))"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
492  | 
by (auto simp: algebra_simps)  | 
| 78475 | 493  | 
then show "norm (a - (u *\<^sub>R x + v *\<^sub>R y)) \<le> u * norm (a - x) + v * norm (a - y)"  | 
494  | 
by (smt (verit, best) \<open>0 \<le> u\<close> \<open>0 \<le> v\<close> norm_scaleR norm_triangle_ineq)  | 
|
| 
79582
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
495  | 
qed (use assms in auto)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
496  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
497  | 
|
| 70136 | 498  | 
subsection\<^marker>\<open>tag unimportant\<close> \<open>Arithmetic operations on sets preserve convexity\<close>  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
499  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
500  | 
lemma convex_linear_image:  | 
| 78475 | 501  | 
assumes "linear f" and "convex S"  | 
| 72385 | 502  | 
shows "convex (f ` S)"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
503  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
504  | 
interpret f: linear f by fact  | 
| 72385 | 505  | 
from \<open>convex S\<close> show "convex (f ` S)"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
506  | 
by (simp add: convex_def f.scaleR [symmetric] f.add [symmetric])  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
507  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
508  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
509  | 
lemma convex_linear_vimage:  | 
| 78475 | 510  | 
assumes "linear f" and "convex S"  | 
| 72385 | 511  | 
shows "convex (f -` S)"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
512  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
513  | 
interpret f: linear f by fact  | 
| 72385 | 514  | 
from \<open>convex S\<close> show "convex (f -` S)"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
515  | 
by (simp add: convex_def f.add f.scaleR)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
516  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
517  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
518  | 
lemma convex_scaling:  | 
| 72385 | 519  | 
assumes "convex S"  | 
520  | 
shows "convex ((\<lambda>x. c *\<^sub>R x) ` S)"  | 
|
| 78475 | 521  | 
by (simp add: assms convex_linear_image)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
522  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
523  | 
lemma convex_scaled:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
524  | 
assumes "convex S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
525  | 
shows "convex ((\<lambda>x. x *\<^sub>R c) ` S)"  | 
| 78475 | 526  | 
by (simp add: assms convex_linear_image)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
527  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
528  | 
lemma convex_negations:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
529  | 
assumes "convex S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
530  | 
shows "convex ((\<lambda>x. - x) ` S)"  | 
| 78475 | 531  | 
by (simp add: assms convex_linear_image module_hom_uminus)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
532  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
533  | 
lemma convex_sums:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
534  | 
assumes "convex S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
535  | 
and "convex T"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
536  | 
  shows "convex (\<Union>x\<in> S. \<Union>y \<in> T. {x + y})"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
537  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
538  | 
have "linear (\<lambda>(x, y). x + y)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
539  | 
by (auto intro: linearI simp: scaleR_add_right)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
540  | 
with assms have "convex ((\<lambda>(x, y). x + y) ` (S \<times> T))"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
541  | 
by (intro convex_linear_image convex_Times)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
542  | 
  also have "((\<lambda>(x, y). x + y) ` (S \<times> T)) = (\<Union>x\<in> S. \<Union>y \<in> T. {x + y})"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
543  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
544  | 
finally show ?thesis .  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
545  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
546  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
547  | 
lemma convex_differences:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
548  | 
assumes "convex S" "convex T"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
549  | 
  shows "convex (\<Union>x\<in> S. \<Union>y \<in> T. {x - y})"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
550  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
551  | 
  have "{x - y| x y. x \<in> S \<and> y \<in> T} = {x + y |x y. x \<in> S \<and> y \<in> uminus ` T}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
552  | 
by (auto simp: diff_conv_add_uminus simp del: add_uminus_conv_diff)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
553  | 
then show ?thesis  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
554  | 
using convex_sums[OF assms(1) convex_negations[OF assms(2)]] by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
555  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
556  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
557  | 
lemma convex_translation:  | 
| 69661 | 558  | 
"convex ((+) a ` S)" if "convex S"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
559  | 
proof -  | 
| 69661 | 560  | 
  have "(\<Union> x\<in> {a}. \<Union>y \<in> S. {x + y}) = (+) a ` S"
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
561  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
562  | 
then show ?thesis  | 
| 69661 | 563  | 
using convex_sums [OF convex_singleton [of a] that] by auto  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
564  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
565  | 
|
| 69661 | 566  | 
lemma convex_translation_subtract:  | 
567  | 
"convex ((\<lambda>b. b - a) ` S)" if "convex S"  | 
|
568  | 
using convex_translation [of S "- a"] that by (simp cong: image_cong_simp)  | 
|
569  | 
||
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
570  | 
lemma convex_affinity:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
571  | 
assumes "convex S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
572  | 
shows "convex ((\<lambda>x. a + c *\<^sub>R x) ` S)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
573  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
574  | 
have "(\<lambda>x. a + c *\<^sub>R x) ` S = (+) a ` (*\<^sub>R) c ` S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
575  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
576  | 
then show ?thesis  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
577  | 
using convex_translation[OF convex_scaling[OF assms], of a c] by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
578  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
579  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
580  | 
lemma convex_on_sum:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
581  | 
fixes a :: "'a \<Rightarrow> real"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
582  | 
and y :: "'a \<Rightarrow> 'b::real_vector"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
583  | 
and f :: "'b \<Rightarrow> real"  | 
| 78475 | 584  | 
  assumes "finite S" "S \<noteq> {}"
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
585  | 
and "convex_on C f"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
586  | 
and "convex C"  | 
| 78475 | 587  | 
and "(\<Sum> i \<in> S. a i) = 1"  | 
588  | 
and "\<And>i. i \<in> S \<Longrightarrow> a i \<ge> 0"  | 
|
589  | 
and "\<And>i. i \<in> S \<Longrightarrow> y i \<in> C"  | 
|
590  | 
shows "f (\<Sum> i \<in> S. a i *\<^sub>R y i) \<le> (\<Sum> i \<in> S. a i * f (y i))"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
591  | 
using assms  | 
| 78475 | 592  | 
proof (induct S arbitrary: a rule: finite_ne_induct)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
593  | 
case (singleton i)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
594  | 
then show ?case  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
595  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
596  | 
next  | 
| 78475 | 597  | 
case (insert i S)  | 
598  | 
then have yai: "y i \<in> C" "a i \<ge> 0"  | 
|
599  | 
by auto  | 
|
600  | 
with insert have conv: "\<And>x y \<mu>. x \<in> C \<Longrightarrow> y \<in> C \<Longrightarrow> 0 \<le> \<mu> \<Longrightarrow> \<mu> \<le> 1 \<Longrightarrow>  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
601  | 
f (\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y) \<le> \<mu> * f x + (1 - \<mu>) * f y"  | 
| 78475 | 602  | 
by (simp add: convex_on_def)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
603  | 
show ?case  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
604  | 
proof (cases "a i = 1")  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
605  | 
case True  | 
| 78475 | 606  | 
with insert have "(\<Sum> j \<in> S. a j) = 0"  | 
607  | 
by auto  | 
|
608  | 
with insert show ?thesis  | 
|
609  | 
by (simp add: sum_nonneg_eq_0_iff)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
610  | 
next  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
611  | 
case False  | 
| 78475 | 612  | 
then have ai1: "a i < 1"  | 
613  | 
using sum_nonneg_leq_bound[of "insert i S" a] insert by force  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
614  | 
then have i0: "1 - a i > 0"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
615  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
616  | 
let ?a = "\<lambda>j. a j / (1 - a i)"  | 
| 78475 | 617  | 
have a_nonneg: "?a j \<ge> 0" if "j \<in> S" for j  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
618  | 
using i0 insert that by fastforce  | 
| 78475 | 619  | 
have "(\<Sum> j \<in> insert i S. a j) = 1"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
620  | 
using insert by auto  | 
| 78475 | 621  | 
then have "(\<Sum> j \<in> S. a j) = 1 - a i"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
622  | 
using sum.insert insert by fastforce  | 
| 78475 | 623  | 
then have "(\<Sum> j \<in> S. a j) / (1 - a i) = 1"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
624  | 
using i0 by auto  | 
| 78475 | 625  | 
then have a1: "(\<Sum> j \<in> S. ?a j) = 1"  | 
626  | 
unfolding sum_divide_distrib by simp  | 
|
627  | 
have asum: "(\<Sum> j \<in> S. ?a j *\<^sub>R y j) \<in> C"  | 
|
628  | 
using insert convex_sum [OF \<open>finite S\<close> \<open>convex C\<close> a1 a_nonneg] by auto  | 
|
629  | 
have asum_le: "f (\<Sum> j \<in> S. ?a j *\<^sub>R y j) \<le> (\<Sum> j \<in> S. ?a j * f (y j))"  | 
|
630  | 
using a_nonneg a1 insert by blast  | 
|
631  | 
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)"  | 
|
632  | 
by (simp add: add.commute insert.hyps)  | 
|
633  | 
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)"  | 
|
634  | 
using i0 by auto  | 
|
635  | 
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)"  | 
|
636  | 
using scaleR_right.sum[of "inverse (1 - a i)" "\<lambda> j. a j *\<^sub>R y j" S, symmetric]  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
637  | 
by (auto simp: algebra_simps)  | 
| 78475 | 638  | 
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)"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
639  | 
by (auto simp: divide_inverse)  | 
| 78475 | 640  | 
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)"  | 
641  | 
using ai1 by (smt (verit) asum conv real_scaleR_def yai)  | 
|
642  | 
also have "\<dots> \<le> (1 - a i) * (\<Sum> j \<in> S. ?a j * f (y j)) + a i * f (y i)"  | 
|
643  | 
using asum_le i0 by fastforce  | 
|
644  | 
also have "\<dots> = (\<Sum> j \<in> S. a j * f (y j)) + a i * f (y i)"  | 
|
645  | 
using i0 by (auto simp: sum_distrib_left)  | 
|
646  | 
finally show ?thesis  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
647  | 
using insert by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
648  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
649  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
650  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
651  | 
lemma convex_on_alt:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
652  | 
fixes C :: "'a::real_vector set"  | 
| 
79582
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
653  | 
shows "convex_on C f \<longleftrightarrow> convex C \<and>  | 
| 78475 | 654  | 
(\<forall>x \<in> C. \<forall>y \<in> C. \<forall> \<mu> :: real. \<mu> \<ge> 0 \<and> \<mu> \<le> 1 \<longrightarrow>  | 
655  | 
f (\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y) \<le> \<mu> * f x + (1 - \<mu>) * f y)"  | 
|
656  | 
by (smt (verit) convex_on_def)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
657  | 
|
| 
79583
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
658  | 
lemma convex_on_slope_le:  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
659  | 
fixes f :: "real \<Rightarrow> real"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
660  | 
assumes f: "convex_on I f"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
661  | 
and I: "x \<in> I" "y \<in> I"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
662  | 
and t: "x < t" "t < y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
663  | 
shows "(f x - f t) / (x - t) \<le> (f x - f y) / (x - y)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
664  | 
and "(f x - f y) / (x - y) \<le> (f t - f y) / (t - y)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
665  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
666  | 
define a where "a \<equiv> (t - y) / (x - y)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
667  | 
with t have "0 \<le> a" "0 \<le> 1 - a"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
668  | 
by (auto simp: field_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
669  | 
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"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
670  | 
by (auto simp: convex_on_def)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
671  | 
have "a * x + (1 - a) * y = a * (x - y) + y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
672  | 
by (simp add: field_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
673  | 
also have "\<dots> = t"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
674  | 
unfolding a_def using \<open>x < t\<close> \<open>t < y\<close> by simp  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
675  | 
finally have "f t \<le> a * f x + (1 - a) * f y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
676  | 
using cvx by simp  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
677  | 
also have "\<dots> = a * (f x - f y) + f y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
678  | 
by (simp add: field_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
679  | 
finally have "f t - f y \<le> a * (f x - f y)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
680  | 
by simp  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
681  | 
with t show "(f x - f t) / (x - t) \<le> (f x - f y) / (x - y)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
682  | 
by (simp add: le_divide_eq divide_le_eq field_simps a_def)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
683  | 
with t show "(f x - f y) / (x - y) \<le> (f t - f y) / (t - y)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
684  | 
by (simp add: le_divide_eq divide_le_eq field_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
685  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
686  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
687  | 
lemma pos_convex_function:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
688  | 
fixes f :: "real \<Rightarrow> real"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
689  | 
assumes "convex C"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
690  | 
and leq: "\<And>x y. x \<in> C \<Longrightarrow> y \<in> C \<Longrightarrow> f' x * (y - x) \<le> f y - f x"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
691  | 
shows "convex_on C f"  | 
| 72385 | 692  | 
unfolding convex_on_alt  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
693  | 
using assms  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
694  | 
proof safe  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
695  | 
fix x y \<mu> :: real  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
696  | 
let ?x = "\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
697  | 
assume *: "convex C" "x \<in> C" "y \<in> C" "\<mu> \<ge> 0" "\<mu> \<le> 1"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
698  | 
then have "1 - \<mu> \<ge> 0" by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
699  | 
then have xpos: "?x \<in> C"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
700  | 
using * unfolding convex_alt by fastforce  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
701  | 
have geq: "\<mu> * (f x - f ?x) + (1 - \<mu>) * (f y - f ?x) \<ge>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
702  | 
\<mu> * f' ?x * (x - ?x) + (1 - \<mu>) * f' ?x * (y - ?x)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
703  | 
using add_mono [OF mult_left_mono [OF leq [OF xpos *(2)] \<open>\<mu> \<ge> 0\<close>]  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
704  | 
mult_left_mono [OF leq [OF xpos *(3)] \<open>1 - \<mu> \<ge> 0\<close>]]  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
705  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
706  | 
then have "\<mu> * f x + (1 - \<mu>) * f y - f ?x \<ge> 0"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
707  | 
by (auto simp: field_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
708  | 
then show "f (\<mu> *\<^sub>R x + (1 - \<mu>) *\<^sub>R y) \<le> \<mu> * f x + (1 - \<mu>) * f y"  | 
| 72385 | 709  | 
by auto  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
710  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
711  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
712  | 
lemma atMostAtLeast_subset_convex:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
713  | 
fixes C :: "real set"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
714  | 
assumes "convex C"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
715  | 
and "x \<in> C" "y \<in> C" "x < y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
716  | 
  shows "{x .. y} \<subseteq> C"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
717  | 
proof safe  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
718  | 
  fix z assume z: "z \<in> {x .. y}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
719  | 
have less: "z \<in> C" if *: "x < z" "z < y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
720  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
721  | 
let ?\<mu> = "(y - z) / (y - x)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
722  | 
have "0 \<le> ?\<mu>" "?\<mu> \<le> 1"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
723  | 
using assms * by (auto simp: field_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
724  | 
then have comb: "?\<mu> * x + (1 - ?\<mu>) * y \<in> C"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
725  | 
using assms iffD1[OF convex_alt, rule_format, of C y x ?\<mu>]  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
726  | 
by (simp add: algebra_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
727  | 
have "?\<mu> * x + (1 - ?\<mu>) * y = (y - z) * x / (y - x) + (1 - (y - z) / (y - x)) * y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
728  | 
by (auto simp: field_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
729  | 
also have "\<dots> = ((y - z) * x + (y - x - (y - z)) * y) / (y - x)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
730  | 
using assms by (simp only: add_divide_distrib) (auto simp: field_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
731  | 
also have "\<dots> = z"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
732  | 
using assms by (auto simp: field_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
733  | 
finally show ?thesis  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
734  | 
using comb by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
735  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
736  | 
show "z \<in> C"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
737  | 
using z less assms by (auto simp: le_less)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
738  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
739  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
740  | 
lemma f''_imp_f':  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
741  | 
fixes f :: "real \<Rightarrow> real"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
742  | 
assumes "convex C"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
743  | 
and f': "\<And>x. x \<in> C \<Longrightarrow> DERIV f x :> (f' x)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
744  | 
and f'': "\<And>x. x \<in> C \<Longrightarrow> DERIV f' x :> (f'' x)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
745  | 
and pos: "\<And>x. x \<in> C \<Longrightarrow> f'' x \<ge> 0"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
746  | 
and x: "x \<in> C"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
747  | 
and y: "y \<in> C"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
748  | 
shows "f' x * (y - x) \<le> f y - f x"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
749  | 
using assms  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
750  | 
proof -  | 
| 78475 | 751  | 
have "f y - f x \<ge> f' x * (y - x)" "f' y * (x - y) \<le> f x - f y"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
752  | 
if *: "x \<in> C" "y \<in> C" "y > x" for x y :: real  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
753  | 
proof -  | 
| 78475 | 754  | 
from * have ge: "y - x > 0" "y - x \<ge> 0" and le: "x - y < 0" "x - y \<le> 0"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
755  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
756  | 
then obtain z1 where z1: "z1 > x" "z1 < y" "f y - f x = (y - x) * f' z1"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
757  | 
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>],  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
758  | 
THEN f', THEN MVT2[OF \<open>x < y\<close>, rule_format, unfolded atLeastAtMost_iff[symmetric]]]  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
759  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
760  | 
then have "z1 \<in> C"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
761  | 
using atMostAtLeast_subset_convex \<open>convex C\<close> \<open>x \<in> C\<close> \<open>y \<in> C\<close> \<open>x < y\<close>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
762  | 
by fastforce  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
763  | 
obtain z2 where z2: "z2 > x" "z2 < z1" "f' z1 - f' x = (z1 - x) * f'' z2"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
764  | 
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>],  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
765  | 
THEN f'', THEN MVT2[OF \<open>x < z1\<close>, rule_format, unfolded atLeastAtMost_iff[symmetric]]] z1  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
766  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
767  | 
obtain z3 where z3: "z3 > z1" "z3 < y" "f' y - f' z1 = (y - z1) * f'' z3"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
768  | 
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>],  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
769  | 
THEN f'', THEN MVT2[OF \<open>z1 < y\<close>, rule_format, unfolded atLeastAtMost_iff[symmetric]]] z1  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
770  | 
by auto  | 
| 78475 | 771  | 
from z1 have "f x - f y = (x - y) * f' z1"  | 
772  | 
by (simp add: field_simps)  | 
|
773  | 
then have cool': "f' y - (f x - f y) / (x - y) = (y - z1) * f'' z3"  | 
|
774  | 
using le(1) z3(3) by auto  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
775  | 
have "z3 \<in> C"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
776  | 
using z3 * atMostAtLeast_subset_convex \<open>convex C\<close> \<open>x \<in> C\<close> \<open>z1 \<in> C\<close> \<open>x < z1\<close>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
777  | 
by fastforce  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
778  | 
then have B': "f'' z3 \<ge> 0"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
779  | 
using assms by auto  | 
| 78475 | 780  | 
with cool' have "f' y - (f x - f y) / (x - y) \<ge> 0"  | 
781  | 
using z1 by auto  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
782  | 
then have res: "f' y * (x - y) \<le> f x - f y"  | 
| 78475 | 783  | 
by (meson diff_ge_0_iff_ge le(1) neg_divide_le_eq)  | 
784  | 
have cool: "(f y - f x) / (y - x) - f' x = (z1 - x) * f'' z2"  | 
|
785  | 
using le(1) z1(3) z2(3) by auto  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
786  | 
have "z2 \<in> C"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
787  | 
using z2 z1 * atMostAtLeast_subset_convex \<open>convex C\<close> \<open>z1 \<in> C\<close> \<open>y \<in> C\<close> \<open>z1 < y\<close>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
788  | 
by fastforce  | 
| 78475 | 789  | 
with z1 assms have "(z1 - x) * f'' z2 \<ge> 0"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
790  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
791  | 
then show "f y - f x \<ge> f' x * (y - x)" "f' y * (x - y) \<le> f x - f y"  | 
| 78475 | 792  | 
using that(3) z1(3) res cool by auto  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
793  | 
qed  | 
| 78475 | 794  | 
then show ?thesis  | 
795  | 
using x y by fastforce  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
796  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
797  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
798  | 
lemma f''_ge0_imp_convex:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
799  | 
fixes f :: "real \<Rightarrow> real"  | 
| 78475 | 800  | 
assumes "convex C"  | 
801  | 
and "\<And>x. x \<in> C \<Longrightarrow> DERIV f x :> (f' x)"  | 
|
802  | 
and "\<And>x. x \<in> C \<Longrightarrow> DERIV f' x :> (f'' x)"  | 
|
803  | 
and "\<And>x. x \<in> C \<Longrightarrow> f'' x \<ge> 0"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
804  | 
shows "convex_on C f"  | 
| 78475 | 805  | 
by (metis assms f''_imp_f' pos_convex_function)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
806  | 
|
| 
74729
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
807  | 
lemma f''_le0_imp_concave:  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
808  | 
fixes f :: "real \<Rightarrow> real"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
809  | 
assumes "convex C"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
810  | 
and "\<And>x. x \<in> C \<Longrightarrow> DERIV f x :> (f' x)"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
811  | 
and "\<And>x. x \<in> C \<Longrightarrow> DERIV f' x :> (f'' x)"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
812  | 
and "\<And>x. x \<in> C \<Longrightarrow> f'' x \<le> 0"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
813  | 
shows "concave_on C f"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
814  | 
unfolding concave_on_def  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
815  | 
by (rule assms f''_ge0_imp_convex derivative_eq_intros | simp)+  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
816  | 
|
| 
79583
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
817  | 
lemma convex_power_even:  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
818  | 
assumes "even n"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
819  | 
shows "convex_on (UNIV::real set) (\<lambda>x. x^n)"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
820  | 
proof (intro f''_ge0_imp_convex)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
821  | 
show "((\<lambda>x. x ^ n) has_real_derivative of_nat n * x^(n-1)) (at x)" for x  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
822  | 
by (rule derivative_eq_intros | simp)+  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
823  | 
show "((\<lambda>x. of_nat n * x^(n-1)) has_real_derivative of_nat n * of_nat (n-1) * x^(n-2)) (at x)" for x  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
824  | 
by (rule derivative_eq_intros | simp add: eval_nat_numeral)+  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
825  | 
show "\<And>x. 0 \<le> real n * real (n - 1) * x ^ (n - 2)"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
826  | 
using assms by (auto simp: zero_le_mult_iff zero_le_even_power)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
827  | 
qed auto  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
828  | 
|
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
829  | 
lemma convex_power_odd:  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
830  | 
assumes "odd n"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
831  | 
  shows "convex_on {0::real..} (\<lambda>x. x^n)"
 | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
832  | 
proof (intro f''_ge0_imp_convex)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
833  | 
show "((\<lambda>x. x ^ n) has_real_derivative of_nat n * x^(n-1)) (at x)" for x  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
834  | 
by (rule derivative_eq_intros | simp)+  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
835  | 
show "((\<lambda>x. of_nat n * x^(n-1)) has_real_derivative of_nat n * of_nat (n-1) * x^(n-2)) (at x)" for x  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
836  | 
by (rule derivative_eq_intros | simp add: eval_nat_numeral)+  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
837  | 
  show "\<And>x. x \<in> {0::real..} \<Longrightarrow> 0 \<le> real n * real (n - 1) * x ^ (n - 2)"
 | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
838  | 
using assms by (auto simp: zero_le_mult_iff zero_le_even_power)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
839  | 
qed auto  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
840  | 
|
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
841  | 
lemma convex_power2: "convex_on (UNIV::real set) power2"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
842  | 
by (simp add: convex_power_even)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
843  | 
|
| 
74729
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
844  | 
lemma log_concave:  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
845  | 
fixes b :: real  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
846  | 
assumes "b > 1"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
847  | 
  shows "concave_on {0<..} (\<lambda> x. log b x)"
 | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
848  | 
using assms  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
849  | 
by (intro f''_le0_imp_concave derivative_eq_intros | simp)+  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
850  | 
|
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
851  | 
lemma ln_concave: "concave_on {0<..} ln"
 | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
852  | 
unfolding log_ln by (simp add: log_concave)  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
853  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
854  | 
lemma minus_log_convex:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
855  | 
fixes b :: real  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
856  | 
assumes "b > 1"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
857  | 
  shows "convex_on {0 <..} (\<lambda> x. - log b x)"
 | 
| 
74729
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
858  | 
using assms concave_on_def log_concave by blast  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
859  | 
|
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
860  | 
lemma powr_convex:  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
861  | 
  assumes "p \<ge> 1" shows "convex_on {0<..} (\<lambda>x. x powr p)"
 | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
862  | 
using assms  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
863  | 
by (intro f''_ge0_imp_convex derivative_eq_intros | simp)+  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
864  | 
|
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
865  | 
lemma exp_convex: "convex_on UNIV exp"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
866  | 
by (intro f''_ge0_imp_convex derivative_eq_intros | simp)+  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
867  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
868  | 
|
| 70136 | 869  | 
subsection\<^marker>\<open>tag unimportant\<close> \<open>Convexity of real functions\<close>  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
870  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
871  | 
lemma convex_on_realI:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
872  | 
assumes "connected A"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
873  | 
and "\<And>x. x \<in> A \<Longrightarrow> (f has_real_derivative f' x) (at x)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
874  | 
and "\<And>x y. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<le> y \<Longrightarrow> f' x \<le> f' y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
875  | 
shows "convex_on A f"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
876  | 
proof (rule convex_on_linorderI)  | 
| 
79582
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
877  | 
show "convex A"  | 
| 
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
878  | 
using \<open>connected A\<close> convex_real_interval interval_cases  | 
| 
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
879  | 
by (smt (verit, ccfv_SIG) connectedD_interval convex_UNIV convex_empty)  | 
| 
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
880  | 
\<comment> \<open>the equivalence of "connected" and "convex" for real intervals is proved later\<close>  | 
| 
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
881  | 
next  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
882  | 
fix t x y :: real  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
883  | 
assume t: "t > 0" "t < 1"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
884  | 
assume xy: "x \<in> A" "y \<in> A" "x < y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
885  | 
define z where "z = (1 - t) * x + t * y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
886  | 
  with \<open>connected A\<close> and xy have ivl: "{x..y} \<subseteq> A"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
887  | 
using connected_contains_Icc by blast  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
888  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
889  | 
from xy t have xz: "z > x"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
890  | 
by (simp add: z_def algebra_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
891  | 
have "y - z = (1 - t) * (y - x)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
892  | 
by (simp add: z_def algebra_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
893  | 
also from xy t have "\<dots> > 0"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
894  | 
by (intro mult_pos_pos) simp_all  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
895  | 
finally have yz: "z < y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
896  | 
by simp  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
897  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
898  | 
from assms xz yz ivl t have "\<exists>\<xi>. \<xi> > x \<and> \<xi> < z \<and> f z - f x = (z - x) * f' \<xi>"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
899  | 
by (intro MVT2) (auto intro!: assms(2))  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
900  | 
then obtain \<xi> where \<xi>: "\<xi> > x" "\<xi> < z" "f' \<xi> = (f z - f x) / (z - x)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
901  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
902  | 
from assms xz yz ivl t have "\<exists>\<eta>. \<eta> > z \<and> \<eta> < y \<and> f y - f z = (y - z) * f' \<eta>"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
903  | 
by (intro MVT2) (auto intro!: assms(2))  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
904  | 
then obtain \<eta> where \<eta>: "\<eta> > z" "\<eta> < y" "f' \<eta> = (f y - f z) / (y - z)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
905  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
906  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
907  | 
from \<eta>(3) have "(f y - f z) / (y - z) = f' \<eta>" ..  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
908  | 
also from \<xi> \<eta> ivl have "\<xi> \<in> A" "\<eta> \<in> A"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
909  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
910  | 
with \<xi> \<eta> have "f' \<eta> \<ge> f' \<xi>"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
911  | 
by (intro assms(3)) auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
912  | 
also from \<xi>(3) have "f' \<xi> = (f z - f x) / (z - x)" .  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
913  | 
finally have "(f y - f z) * (z - x) \<ge> (f z - f x) * (y - z)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
914  | 
using xz yz by (simp add: field_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
915  | 
also have "z - x = t * (y - x)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
916  | 
by (simp add: z_def algebra_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
917  | 
also have "y - z = (1 - t) * (y - x)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
918  | 
by (simp add: z_def algebra_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
919  | 
finally have "(f y - f z) * t \<ge> (f z - f x) * (1 - t)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
920  | 
using xy by simp  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
921  | 
then show "(1 - t) * f x + t * f y \<ge> f ((1 - t) *\<^sub>R x + t *\<^sub>R y)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
922  | 
by (simp add: z_def algebra_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
923  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
924  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
925  | 
lemma convex_on_inverse:  | 
| 78475 | 926  | 
fixes A :: "real set"  | 
| 
79582
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
927  | 
  assumes "A \<subseteq> {0<..}" "convex A"
 | 
| 78475 | 928  | 
shows "convex_on A inverse"  | 
929  | 
proof -  | 
|
930  | 
  have "convex_on {0::real<..} inverse"
 | 
|
931  | 
proof (intro convex_on_realI)  | 
|
932  | 
fix u v :: real  | 
|
933  | 
    assume "u \<in> {0<..}" "v \<in> {0<..}" "u \<le> v"
 | 
|
934  | 
with assms show "-inverse (u^2) \<le> -inverse (v^2)"  | 
|
935  | 
by simp  | 
|
936  | 
next  | 
|
937  | 
    show "\<And>x. x \<in> {0<..} \<Longrightarrow> (inverse has_real_derivative - inverse (x\<^sup>2)) (at x)"
 | 
|
938  | 
by (rule derivative_eq_intros | simp add: power2_eq_square)+  | 
|
939  | 
qed auto  | 
|
940  | 
then show ?thesis  | 
|
941  | 
using assms convex_on_subset by blast  | 
|
942  | 
qed  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
943  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
944  | 
lemma convex_onD_Icc':  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
945  | 
  assumes "convex_on {x..y} f" "c \<in> {x..y}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
946  | 
defines "d \<equiv> y - x"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
947  | 
shows "f c \<le> (f y - f x) / d * (c - x) + f x"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
948  | 
proof (cases x y rule: linorder_cases)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
949  | 
case less  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
950  | 
then have d: "d > 0"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
951  | 
by (simp add: d_def)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
952  | 
from assms(2) less have A: "0 \<le> (c - x) / d" "(c - x) / d \<le> 1"  | 
| 
70817
 
dd675800469d
dedicated fact collections for algebraic simplification rules potentially splitting goals
 
haftmann 
parents: 
70136 
diff
changeset
 | 
953  | 
by (simp_all add: d_def field_split_simps)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
954  | 
have "f c = f (x + (c - x) * 1)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
955  | 
by simp  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
956  | 
also from less have "1 = ((y - x) / d)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
957  | 
by (simp add: d_def)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
958  | 
also from d have "x + (c - x) * \<dots> = (1 - (c - x) / d) *\<^sub>R x + ((c - x) / d) *\<^sub>R y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
959  | 
by (simp add: field_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
960  | 
also have "f \<dots> \<le> (1 - (c - x) / d) * f x + (c - x) / d * f y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
961  | 
using assms less by (intro convex_onD_Icc) simp_all  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
962  | 
also from d have "\<dots> = (f y - f x) / d * (c - x) + f x"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
963  | 
by (simp add: field_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
964  | 
finally show ?thesis .  | 
| 78475 | 965  | 
qed (use assms in auto)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
966  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
967  | 
lemma convex_onD_Icc'':  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
968  | 
  assumes "convex_on {x..y} f" "c \<in> {x..y}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
969  | 
defines "d \<equiv> y - x"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
970  | 
shows "f c \<le> (f x - f y) / d * (y - c) + f y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
971  | 
proof (cases x y rule: linorder_cases)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
972  | 
case less  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
973  | 
then have d: "d > 0"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
974  | 
by (simp add: d_def)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
975  | 
from assms(2) less have A: "0 \<le> (y - c) / d" "(y - c) / d \<le> 1"  | 
| 
70817
 
dd675800469d
dedicated fact collections for algebraic simplification rules potentially splitting goals
 
haftmann 
parents: 
70136 
diff
changeset
 | 
976  | 
by (simp_all add: d_def field_split_simps)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
977  | 
have "f c = f (y - (y - c) * 1)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
978  | 
by simp  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
979  | 
also from less have "1 = ((y - x) / d)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
980  | 
by (simp add: d_def)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
981  | 
also from d have "y - (y - c) * \<dots> = (1 - (1 - (y - c) / d)) *\<^sub>R x + (1 - (y - c) / d) *\<^sub>R y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
982  | 
by (simp add: field_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
983  | 
also have "f \<dots> \<le> (1 - (1 - (y - c) / d)) * f x + (1 - (y - c) / d) * f y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
984  | 
using assms less by (intro convex_onD_Icc) (simp_all add: field_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
985  | 
also from d have "\<dots> = (f x - f y) / d * (y - c) + f y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
986  | 
by (simp add: field_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
987  | 
finally show ?thesis .  | 
| 78475 | 988  | 
qed (use assms in auto)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
989  | 
|
| 
79583
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
990  | 
subsection \<open>Some inequalities: Applications of convexity\<close>  | 
| 
74729
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
991  | 
|
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
992  | 
lemma Youngs_inequality_0:  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
993  | 
fixes a::real  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
994  | 
assumes "0 \<le> \<alpha>" "0 \<le> \<beta>" "\<alpha>+\<beta> = 1" "a>0" "b>0"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
995  | 
shows "a powr \<alpha> * b powr \<beta> \<le> \<alpha>*a + \<beta>*b"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
996  | 
proof -  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
997  | 
have "\<alpha> * ln a + \<beta> * ln b \<le> ln (\<alpha> * a + \<beta> * b)"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
998  | 
using assms ln_concave by (simp add: concave_on_iff)  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
999  | 
moreover have "0 < \<alpha> * a + \<beta> * b"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1000  | 
using assms by (smt (verit) mult_pos_pos split_mult_pos_le)  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1001  | 
ultimately show ?thesis  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1002  | 
using assms by (simp add: powr_def mult_exp_exp flip: ln_ge_iff)  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1003  | 
qed  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1004  | 
|
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1005  | 
lemma Youngs_inequality:  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1006  | 
fixes p::real  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1007  | 
assumes "p>1" "q>1" "1/p + 1/q = 1" "a\<ge>0" "b\<ge>0"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1008  | 
shows "a * b \<le> a powr p / p + b powr q / q"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1009  | 
proof (cases "a=0 \<or> b=0")  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1010  | 
case False  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1011  | 
then show ?thesis  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1012  | 
using Youngs_inequality_0 [of "1/p" "1/q" "a powr p" "b powr q"] assms  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1013  | 
by (simp add: powr_powr)  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1014  | 
qed (use assms in auto)  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1015  | 
|
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1016  | 
lemma Cauchy_Schwarz_ineq_sum:  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1017  | 
fixes a :: "'a \<Rightarrow> 'b::linordered_field"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1018  | 
shows "(\<Sum>i\<in>I. a i * b i)\<^sup>2 \<le> (\<Sum>i\<in>I. (a i)\<^sup>2) * (\<Sum>i\<in>I. (b i)\<^sup>2)"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1019  | 
proof (cases "(\<Sum>i\<in>I. (b i)\<^sup>2) > 0")  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1020  | 
case False  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1021  | 
then consider "\<And>i. i\<in>I \<Longrightarrow> b i = 0" | "infinite I"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1022  | 
by (metis (mono_tags, lifting) sum_pos2 zero_le_power2 zero_less_power2)  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1023  | 
thus ?thesis  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1024  | 
by fastforce  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1025  | 
next  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1026  | 
case True  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1027  | 
define r where "r \<equiv> (\<Sum>i\<in>I. a i * b i) / (\<Sum>i\<in>I. (b i)\<^sup>2)"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1028  | 
have "0 \<le> (\<Sum>i\<in>I. (a i - r * b i)\<^sup>2)"  | 
| 
79532
 
bb5d036f3523
Type class patch suggested by Achim Brucker, plus tidied lemma
 
paulson <lp15@cam.ac.uk> 
parents: 
78656 
diff
changeset
 | 
1029  | 
by (simp add: sum_nonneg)  | 
| 
74729
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1030  | 
also have "... = (\<Sum>i\<in>I. (a i)\<^sup>2) - 2 * r * (\<Sum>i\<in>I. a i * b i) + r\<^sup>2 * (\<Sum>i\<in>I. (b i)\<^sup>2)"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1031  | 
by (simp add: algebra_simps power2_eq_square sum_distrib_left flip: sum.distrib)  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1032  | 
also have "\<dots> = (\<Sum>i\<in>I. (a i)\<^sup>2) - ((\<Sum>i\<in>I. a i * b i))\<^sup>2 / (\<Sum>i\<in>I. (b i)\<^sup>2)"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1033  | 
by (simp add: r_def power2_eq_square)  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1034  | 
finally have "0 \<le> (\<Sum>i\<in>I. (a i)\<^sup>2) - ((\<Sum>i\<in>I. a i * b i))\<^sup>2 / (\<Sum>i\<in>I. (b i)\<^sup>2)" .  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1035  | 
hence "((\<Sum>i\<in>I. a i * b i))\<^sup>2 / (\<Sum>i\<in>I. (b i)\<^sup>2) \<le> (\<Sum>i\<in>I. (a i)\<^sup>2)"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1036  | 
by (simp add: le_diff_eq)  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1037  | 
thus "((\<Sum>i\<in>I. a i * b i))\<^sup>2 \<le> (\<Sum>i\<in>I. (a i)\<^sup>2) * (\<Sum>i\<in>I. (b i)\<^sup>2)"  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1038  | 
by (simp add: pos_divide_le_eq True)  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1039  | 
qed  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1040  | 
|
| 
79583
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
1041  | 
lemma sum_squared_le_sum_of_squares:  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
1042  | 
fixes f :: "'a \<Rightarrow> real"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
1043  | 
  assumes "\<And>i. i\<in>I \<Longrightarrow> f i \<ge> 0" "finite I" "I \<noteq> {}"
 | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
1044  | 
shows "(\<Sum>i\<in>I. f i)\<^sup>2 \<le> (\<Sum>y\<in>I. (f y)\<^sup>2) * card I"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
1045  | 
proof (cases "finite I \<and> I \<noteq> {}")
 | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
1046  | 
case True  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
1047  | 
have "(\<Sum>i\<in>I. f i / real (card I))\<^sup>2 \<le> (\<Sum>i\<in>I. (f i)\<^sup>2 / real (card I))"  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
1048  | 
using assms convex_on_sum [OF _ _ convex_power2, where a = "\<lambda>x. 1 / real(card I)" and S=I]  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
1049  | 
by simp  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
1050  | 
then show ?thesis  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
1051  | 
using assms  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
1052  | 
by (simp add: divide_simps power2_eq_square split: if_split_asm flip: sum_divide_distrib)  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
1053  | 
qed auto  | 
| 
 
a521c241e946
Further lemmas concerning complexity and measures
 
paulson <lp15@cam.ac.uk> 
parents: 
79582 
diff
changeset
 | 
1054  | 
|
| 
74729
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1055  | 
subsection \<open>Misc related lemmas\<close>  | 
| 
 
64b3d8d9bd10
new lemmas about convex, concave functions, + tidying
 
paulson <lp15@cam.ac.uk> 
parents: 
72385 
diff
changeset
 | 
1056  | 
|
| 69661 | 1057  | 
lemma convex_translation_eq [simp]:  | 
1058  | 
"convex ((+) a ` s) \<longleftrightarrow> convex s"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1059  | 
by (metis convex_translation translation_galois)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1060  | 
|
| 69661 | 1061  | 
lemma convex_translation_subtract_eq [simp]:  | 
1062  | 
"convex ((\<lambda>b. b - a) ` s) \<longleftrightarrow> convex s"  | 
|
1063  | 
using convex_translation_eq [of "- a"] by (simp cong: image_cong_simp)  | 
|
1064  | 
||
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1065  | 
lemma convex_linear_image_eq [simp]:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1066  | 
fixes f :: "'a::real_vector \<Rightarrow> 'b::real_vector"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1067  | 
shows "\<lbrakk>linear f; inj f\<rbrakk> \<Longrightarrow> convex (f ` s) \<longleftrightarrow> convex s"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1068  | 
by (metis (no_types) convex_linear_image convex_linear_vimage inj_vimage_image_eq)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1069  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1070  | 
lemma vector_choose_size:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1071  | 
assumes "0 \<le> c"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1072  | 
  obtains x :: "'a::{real_normed_vector, perfect_space}" where "norm x = c"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1073  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1074  | 
obtain a::'a where "a \<noteq> 0"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1075  | 
using UNIV_not_singleton UNIV_eq_I set_zero singletonI by fastforce  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1076  | 
then show ?thesis  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1077  | 
by (rule_tac x="scaleR (c / norm a) a" in that) (simp add: assms)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1078  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1079  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1080  | 
lemma vector_choose_dist:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1081  | 
assumes "0 \<le> c"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1082  | 
  obtains y :: "'a::{real_normed_vector, perfect_space}" where "dist x y = c"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1083  | 
by (metis add_diff_cancel_left' assms dist_commute dist_norm vector_choose_size)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1084  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1085  | 
lemma sum_delta'':  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1086  | 
fixes s::"'a::real_vector set"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1087  | 
assumes "finite s"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1088  | 
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)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1089  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1090  | 
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)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1091  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1092  | 
show ?thesis  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1093  | 
unfolding * using sum.delta[OF assms, of y "\<lambda>x. f x *\<^sub>R x"] by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1094  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1095  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1096  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1097  | 
subsection \<open>Cones\<close>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1098  | 
|
| 70136 | 1099  | 
definition\<^marker>\<open>tag important\<close> cone :: "'a::real_vector set \<Rightarrow> bool"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1100  | 
where "cone s \<longleftrightarrow> (\<forall>x\<in>s. \<forall>c\<ge>0. c *\<^sub>R x \<in> s)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1101  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1102  | 
lemma cone_empty[intro, simp]: "cone {}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1103  | 
unfolding cone_def by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1104  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1105  | 
lemma cone_univ[intro, simp]: "cone UNIV"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1106  | 
unfolding cone_def by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1107  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1108  | 
lemma cone_Inter[intro]: "\<forall>s\<in>f. cone s \<Longrightarrow> cone (\<Inter>f)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1109  | 
unfolding cone_def by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1110  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1111  | 
lemma subspace_imp_cone: "subspace S \<Longrightarrow> cone S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1112  | 
by (simp add: cone_def subspace_scale)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1113  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1114  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1115  | 
subsubsection \<open>Conic hull\<close>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1116  | 
|
| 72385 | 1117  | 
lemma cone_cone_hull: "cone (cone hull S)"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1118  | 
unfolding hull_def by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1119  | 
|
| 72385 | 1120  | 
lemma cone_hull_eq: "cone hull S = S \<longleftrightarrow> cone S"  | 
1121  | 
by (metis cone_cone_hull hull_same)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1122  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1123  | 
lemma mem_cone:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1124  | 
assumes "cone S" "x \<in> S" "c \<ge> 0"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1125  | 
shows "c *\<^sub>R x \<in> S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1126  | 
using assms cone_def[of S] by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1127  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1128  | 
lemma cone_contains_0:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1129  | 
assumes "cone S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1130  | 
  shows "S \<noteq> {} \<longleftrightarrow> 0 \<in> S"
 | 
| 72385 | 1131  | 
using assms mem_cone by fastforce  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1132  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1133  | 
lemma cone_0: "cone {0}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1134  | 
unfolding cone_def by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1135  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1136  | 
lemma cone_Union[intro]: "(\<forall>s\<in>f. cone s) \<longrightarrow> cone (\<Union>f)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1137  | 
unfolding cone_def by blast  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1138  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1139  | 
lemma cone_iff:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1140  | 
  assumes "S \<noteq> {}"
 | 
| 78475 | 1141  | 
shows "cone S \<longleftrightarrow> 0 \<in> S \<and> (\<forall>c. c > 0 \<longrightarrow> ((*\<^sub>R) c) ` S = S)" (is "_ = ?rhs")  | 
1142  | 
proof  | 
|
1143  | 
assume "cone S"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1144  | 
  {
 | 
| 78475 | 1145  | 
fix c :: real  | 
1146  | 
assume "c > 0"  | 
|
1147  | 
have "x \<in> ((*\<^sub>R) c) ` S" if "x \<in> S" for x  | 
|
1148  | 
using \<open>cone S\<close> \<open>c>0\<close> mem_cone[of S x "1/c"] that  | 
|
1149  | 
exI[of "(\<lambda>t. t \<in> S \<and> x = c *\<^sub>R t)" "(1 / c) *\<^sub>R x"]  | 
|
1150  | 
by auto  | 
|
1151  | 
then have "((*\<^sub>R) c) ` S = S"  | 
|
1152  | 
using \<open>0 < c\<close> \<open>cone S\<close> mem_cone by fastforce  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1153  | 
}  | 
| 78475 | 1154  | 
then show "0 \<in> S \<and> (\<forall>c. c > 0 \<longrightarrow> ((*\<^sub>R) c) ` S = S)"  | 
1155  | 
using \<open>cone S\<close> cone_contains_0[of S] assms by auto  | 
|
1156  | 
next  | 
|
1157  | 
show "?rhs \<Longrightarrow> cone S"  | 
|
1158  | 
by (metis Convex.cone_def imageI order_neq_le_trans scaleR_zero_left)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1159  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1160  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1161  | 
lemma cone_hull_empty: "cone hull {} = {}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1162  | 
by (metis cone_empty cone_hull_eq)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1163  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1164  | 
lemma cone_hull_empty_iff: "S = {} \<longleftrightarrow> cone hull S = {}"
 | 
| 78475 | 1165  | 
by (metis cone_hull_empty hull_subset subset_empty)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1166  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1167  | 
lemma cone_hull_contains_0: "S \<noteq> {} \<longleftrightarrow> 0 \<in> cone hull S"
 | 
| 78475 | 1168  | 
by (metis cone_cone_hull cone_contains_0 cone_hull_empty_iff)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1169  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1170  | 
lemma mem_cone_hull:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1171  | 
assumes "x \<in> S" "c \<ge> 0"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1172  | 
shows "c *\<^sub>R x \<in> cone hull S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1173  | 
by (metis assms cone_cone_hull hull_inc mem_cone)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1174  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1175  | 
proposition cone_hull_expl: "cone hull S = {c *\<^sub>R x | c x. c \<ge> 0 \<and> x \<in> S}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1176  | 
(is "?lhs = ?rhs")  | 
| 78475 | 1177  | 
proof  | 
1178  | 
have "?rhs \<in> Collect cone"  | 
|
1179  | 
using Convex.cone_def by fastforce  | 
|
1180  | 
moreover have "S \<subseteq> ?rhs"  | 
|
1181  | 
by (smt (verit) mem_Collect_eq scaleR_one subsetI)  | 
|
1182  | 
ultimately show "?lhs \<subseteq> ?rhs"  | 
|
1183  | 
using hull_minimal by blast  | 
|
1184  | 
qed (use mem_cone_hull in auto)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1185  | 
|
| 71242 | 1186  | 
lemma convex_cone:  | 
| 78475 | 1187  | 
"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)"  | 
| 71242 | 1188  | 
(is "?lhs = ?rhs")  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1189  | 
proof -  | 
| 71242 | 1190  | 
  {
 | 
1191  | 
fix x y  | 
|
| 78475 | 1192  | 
assume "x\<in>S" "y\<in>S" and ?lhs  | 
1193  | 
then have "2 *\<^sub>R x \<in>S" "2 *\<^sub>R y \<in> S" "convex S"  | 
|
| 71242 | 1194  | 
unfolding cone_def by auto  | 
| 78475 | 1195  | 
then have "x + y \<in> S"  | 
1196  | 
using convexD [OF \<open>convex S\<close>, of "2*\<^sub>R x" "2*\<^sub>R y"]  | 
|
1197  | 
by (smt (verit, ccfv_threshold) field_sum_of_halves scaleR_2 scaleR_half_double)  | 
|
| 71242 | 1198  | 
}  | 
1199  | 
then show ?thesis  | 
|
1200  | 
unfolding convex_def cone_def by blast  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1201  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1202  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1203  | 
|
| 70136 | 1204  | 
subsection\<^marker>\<open>tag unimportant\<close> \<open>Connectedness of convex sets\<close>  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1205  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1206  | 
lemma convex_connected:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1207  | 
fixes S :: "'a::real_normed_vector set"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1208  | 
assumes "convex S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1209  | 
shows "connected S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1210  | 
proof (rule connectedI)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1211  | 
fix A B  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1212  | 
  assume "open A" "open B" "A \<inter> B \<inter> S = {}" "S \<subseteq> A \<union> B"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1213  | 
moreover  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1214  | 
  assume "A \<inter> S \<noteq> {}" "B \<inter> S \<noteq> {}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1215  | 
then obtain a b where a: "a \<in> A" "a \<in> S" and b: "b \<in> B" "b \<in> S" by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1216  | 
define f where [abs_def]: "f u = u *\<^sub>R a + (1 - u) *\<^sub>R b" for u  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1217  | 
  then have "continuous_on {0 .. 1} f"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1218  | 
by (auto intro!: continuous_intros)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1219  | 
  then have "connected (f ` {0 .. 1})"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1220  | 
by (auto intro!: connected_continuous_image)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1221  | 
note connectedD[OF this, of A B]  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1222  | 
  moreover have "a \<in> A \<inter> f ` {0 .. 1}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1223  | 
using a by (auto intro!: image_eqI[of _ _ 1] simp: f_def)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1224  | 
  moreover have "b \<in> B \<inter> f ` {0 .. 1}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1225  | 
using b by (auto intro!: image_eqI[of _ _ 0] simp: f_def)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1226  | 
  moreover have "f ` {0 .. 1} \<subseteq> S"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1227  | 
using \<open>convex S\<close> a b unfolding convex_def f_def by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1228  | 
ultimately show False by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1229  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1230  | 
|
| 71136 | 1231  | 
corollary%unimportant connected_UNIV[intro]: "connected (UNIV :: 'a::real_normed_vector set)"  | 
| 78475 | 1232  | 
by (simp add: convex_connected)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1233  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1234  | 
lemma convex_prod:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1235  | 
  assumes "\<And>i. i \<in> Basis \<Longrightarrow> convex {x. P i x}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1236  | 
  shows "convex {x. \<forall>i\<in>Basis. P i (x\<bullet>i)}"
 | 
| 78475 | 1237  | 
using assms by (auto simp: inner_add_left convex_def)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1238  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1239  | 
lemma convex_positive_orthant: "convex {x::'a::euclidean_space. (\<forall>i\<in>Basis. 0 \<le> x\<bullet>i)}"
 | 
| 71136 | 1240  | 
by (rule convex_prod) (simp flip: atLeast_def)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1241  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1242  | 
subsection \<open>Convex hull\<close>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1243  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1244  | 
lemma convex_convex_hull [iff]: "convex (convex hull s)"  | 
| 78475 | 1245  | 
by (metis (mono_tags) convex_Inter hull_def mem_Collect_eq)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1246  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1247  | 
lemma convex_hull_subset:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1248  | 
"s \<subseteq> convex hull t \<Longrightarrow> convex hull s \<subseteq> convex hull t"  | 
| 71174 | 1249  | 
by (simp add: subset_hull)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1250  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1251  | 
lemma convex_hull_eq: "convex hull s = s \<longleftrightarrow> convex s"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1252  | 
by (metis convex_convex_hull hull_same)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1253  | 
|
| 70136 | 1254  | 
subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Convex hull is "preserved" by a linear function\<close>  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1255  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1256  | 
lemma convex_hull_linear_image:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1257  | 
assumes f: "linear f"  | 
| 78475 | 1258  | 
shows "f ` (convex hull S) = convex hull (f ` S)"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1259  | 
proof  | 
| 78475 | 1260  | 
show "convex hull (f ` S) \<subseteq> f ` (convex hull S)"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1261  | 
by (intro hull_minimal image_mono hull_subset convex_linear_image assms convex_convex_hull)  | 
| 78475 | 1262  | 
show "f ` (convex hull S) \<subseteq> convex hull (f ` S)"  | 
1263  | 
by (meson convex_convex_hull convex_linear_vimage f hull_minimal hull_subset image_subset_iff_subset_vimage)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1264  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1265  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1266  | 
lemma in_convex_hull_linear_image:  | 
| 78475 | 1267  | 
assumes "linear f" "x \<in> convex hull S"  | 
1268  | 
shows "f x \<in> convex hull (f ` S)"  | 
|
1269  | 
using assms convex_hull_linear_image image_eqI by blast  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1270  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1271  | 
lemma convex_hull_Times:  | 
| 78475 | 1272  | 
"convex hull (S \<times> T) = (convex hull S) \<times> (convex hull T)"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1273  | 
proof  | 
| 78475 | 1274  | 
show "convex hull (S \<times> T) \<subseteq> (convex hull S) \<times> (convex hull T)"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1275  | 
by (intro hull_minimal Sigma_mono hull_subset convex_Times convex_convex_hull)  | 
| 78475 | 1276  | 
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  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1277  | 
proof (rule hull_induct [OF x], rule hull_induct [OF y])  | 
| 78475 | 1278  | 
fix x y assume "x \<in> S" and "y \<in> T"  | 
1279  | 
then show "(x, y) \<in> convex hull (S \<times> T)"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1280  | 
by (simp add: hull_inc)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1281  | 
next  | 
| 78475 | 1282  | 
fix x let ?S = "((\<lambda>y. (0, y)) -` (\<lambda>p. (- x, 0) + p) ` (convex hull S \<times> T))"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1283  | 
have "convex ?S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1284  | 
by (intro convex_linear_vimage convex_translation convex_convex_hull,  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1285  | 
simp add: linear_iff)  | 
| 78475 | 1286  | 
    also have "?S = {y. (x, y) \<in> convex hull (S \<times> T)}"
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1287  | 
by (auto simp: image_def Bex_def)  | 
| 78475 | 1288  | 
    finally show "convex {y. (x, y) \<in> convex hull (S \<times> T)}" .
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1289  | 
next  | 
| 78475 | 1290  | 
    show "convex {x. (x, y) \<in> convex hull S \<times> T}"
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1291  | 
proof -  | 
| 78475 | 1292  | 
fix y let ?S = "((\<lambda>x. (x, 0)) -` (\<lambda>p. (0, - y) + p) ` (convex hull S \<times> T))"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1293  | 
have "convex ?S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1294  | 
by (intro convex_linear_vimage convex_translation convex_convex_hull,  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1295  | 
simp add: linear_iff)  | 
| 78475 | 1296  | 
      also have "?S = {x. (x, y) \<in> convex hull (S \<times> T)}"
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1297  | 
by (auto simp: image_def Bex_def)  | 
| 78475 | 1298  | 
      finally show "convex {x. (x, y) \<in> convex hull (S \<times> T)}" .
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1299  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1300  | 
qed  | 
| 78475 | 1301  | 
then show "(convex hull S) \<times> (convex hull T) \<subseteq> convex hull (S \<times> T)"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1302  | 
unfolding subset_eq split_paired_Ball_Sigma by blast  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1303  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1304  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1305  | 
|
| 70136 | 1306  | 
subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Stepping theorems for convex hulls of finite sets\<close>  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1307  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1308  | 
lemma convex_hull_empty[simp]: "convex hull {} = {}"
 | 
| 78475 | 1309  | 
by (simp add: hull_same)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1310  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1311  | 
lemma convex_hull_singleton[simp]: "convex hull {a} = {a}"
 | 
| 78475 | 1312  | 
by (simp add: hull_same)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1313  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1314  | 
lemma convex_hull_insert:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1315  | 
fixes S :: "'a::real_vector set"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1316  | 
  assumes "S \<noteq> {}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1317  | 
shows "convex hull (insert a S) =  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1318  | 
         {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)}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1319  | 
(is "_ = ?hull")  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1320  | 
proof (intro equalityI hull_minimal subsetI)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1321  | 
fix x  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1322  | 
assume "x \<in> insert a S"  | 
| 78475 | 1323  | 
then show "x \<in> ?hull"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1324  | 
unfolding insert_iff  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1325  | 
proof  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1326  | 
assume "x = a"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1327  | 
then show ?thesis  | 
| 78475 | 1328  | 
by (smt (verit, del_insts) add.right_neutral assms ex_in_conv hull_inc mem_Collect_eq scaleR_one scaleR_zero_left)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1329  | 
next  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1330  | 
assume "x \<in> S"  | 
| 78475 | 1331  | 
with hull_subset show ?thesis  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1332  | 
by force  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1333  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1334  | 
next  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1335  | 
fix x  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1336  | 
assume "x \<in> ?hull"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1337  | 
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"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1338  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1339  | 
have "a \<in> convex hull insert a S" "b \<in> convex hull insert a S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1340  | 
    using hull_mono[of S "insert a S" convex] hull_mono[of "{a}" "insert a S" convex] and obt(4)
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1341  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1342  | 
then show "x \<in> convex hull insert a S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1343  | 
unfolding obt(5) using obt(1-3)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1344  | 
by (rule convexD [OF convex_convex_hull])  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1345  | 
next  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1346  | 
show "convex ?hull"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1347  | 
proof (rule convexI)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1348  | 
fix x y u v  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1349  | 
assume as: "(0::real) \<le> u" "0 \<le> v" "u + v = 1" and x: "x \<in> ?hull" and y: "y \<in> ?hull"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1350  | 
from x obtain u1 v1 b1 where  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1351  | 
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"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1352  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1353  | 
from y obtain u2 v2 b2 where  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1354  | 
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"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1355  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1356  | 
have *: "\<And>(x::'a) s1 s2. x - s1 *\<^sub>R x - s2 *\<^sub>R x = ((1::real) - (s1 + s2)) *\<^sub>R x"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1357  | 
by (auto simp: algebra_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1358  | 
have "\<exists>b \<in> convex hull S. u *\<^sub>R x + v *\<^sub>R y =  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1359  | 
(u * u1) *\<^sub>R a + (v * u2) *\<^sub>R a + (b - (u * u1) *\<^sub>R b - (v * u2) *\<^sub>R b)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1360  | 
proof (cases "u * v1 + v * v2 = 0")  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1361  | 
case True  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1362  | 
have *: "\<And>(x::'a) s1 s2. x - s1 *\<^sub>R x - s2 *\<^sub>R x = ((1::real) - (s1 + s2)) *\<^sub>R x"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1363  | 
by (auto simp: algebra_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1364  | 
have eq0: "u * v1 = 0" "v * v2 = 0"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1365  | 
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>]  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1366  | 
by arith+  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1367  | 
then have "u * u1 + v * u2 = 1"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1368  | 
using as(3) obt1(3) obt2(3) by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1369  | 
then show ?thesis  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1370  | 
using "*" eq0 as obt1(4) xeq yeq by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1371  | 
next  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1372  | 
case False  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1373  | 
have "1 - (u * u1 + v * u2) = (u + v) - (u * u1 + v * u2)"  | 
| 78475 | 1374  | 
by (simp add: as(3))  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1375  | 
also have "\<dots> = u * v1 + v * v2"  | 
| 78475 | 1376  | 
by (smt (verit, ccfv_SIG) distrib_left mult_cancel_left1 obt1(3) obt2(3))  | 
1377  | 
finally have **:"1 - (u * u1 + v * u2) = u * v1 + v * v2" .  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1378  | 
let ?b = "((u * v1) / (u * v1 + v * v2)) *\<^sub>R b1 + ((v * v2) / (u * v1 + v * v2)) *\<^sub>R b2"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1379  | 
have zeroes: "0 \<le> u * v1 + v * v2" "0 \<le> u * v1" "0 \<le> u * v1 + v * v2" "0 \<le> v * v2"  | 
| 78475 | 1380  | 
using as obt1 obt2 by auto  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1381  | 
show ?thesis  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1382  | 
proof  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1383  | 
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)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1384  | 
unfolding xeq yeq * **  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1385  | 
using False by (auto simp: scaleR_left_distrib scaleR_right_distrib)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1386  | 
show "?b \<in> convex hull S"  | 
| 78475 | 1387  | 
using False mem_convex_alt obt1(4) obt2(4) zeroes(2) zeroes(4) by fastforce  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1388  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1389  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1390  | 
then obtain b where b: "b \<in> convex hull S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1391  | 
"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)" ..  | 
| 78475 | 1392  | 
obtain u1: "u1 \<le> 1" and u2: "u2 \<le> 1"  | 
1393  | 
using obt1 obt2 by auto  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1394  | 
have "u1 * u + u2 * v \<le> max u1 u2 * u + max u1 u2 * v"  | 
| 78475 | 1395  | 
by (smt (verit, ccfv_SIG) as mult_right_mono)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1396  | 
also have "\<dots> \<le> 1"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1397  | 
unfolding distrib_left[symmetric] and as(3) using u1 u2 by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1398  | 
finally have le1: "u1 * u + u2 * v \<le> 1" .  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1399  | 
show "u *\<^sub>R x + v *\<^sub>R y \<in> ?hull"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1400  | 
proof (intro CollectI exI conjI)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1401  | 
show "0 \<le> u * u1 + v * u2"  | 
| 78475 | 1402  | 
by (simp add: as obt1(1) obt2(1))  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1403  | 
show "0 \<le> 1 - u * u1 - v * u2"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1404  | 
by (simp add: le1 diff_diff_add mult.commute)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1405  | 
qed (use b in \<open>auto simp: algebra_simps\<close>)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1406  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1407  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1408  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1409  | 
lemma convex_hull_insert_alt:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1410  | 
"convex hull (insert a S) =  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1411  | 
     (if S = {} then {a}
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1412  | 
      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})"
 | 
| 78475 | 1413  | 
apply (simp add: convex_hull_insert)  | 
1414  | 
using diff_add_cancel diff_ge_0_iff_ge  | 
|
1415  | 
by (smt (verit, del_insts) Collect_cong)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1416  | 
|
| 70136 | 1417  | 
subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Explicit expression for convex hull\<close>  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1418  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1419  | 
proposition convex_hull_indexed:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1420  | 
fixes S :: "'a::real_vector set"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1421  | 
shows "convex hull S =  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1422  | 
    {y. \<exists>k u x. (\<forall>i\<in>{1::nat .. k}. 0 \<le> u i \<and> x i \<in> S) \<and>
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1423  | 
                (sum u {1..k} = 1) \<and> (\<Sum>i = 1..k. u i *\<^sub>R x i) = y}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1424  | 
(is "?xyz = ?hull")  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1425  | 
proof (rule hull_unique [OF _ convexI])  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1426  | 
show "S \<subseteq> ?hull"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1427  | 
by (clarsimp, rule_tac x=1 in exI, rule_tac x="\<lambda>x. 1" in exI, auto)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1428  | 
next  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1429  | 
fix T  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1430  | 
assume "S \<subseteq> T" "convex T"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1431  | 
then show "?hull \<subseteq> T"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1432  | 
by (blast intro: convex_sum)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1433  | 
next  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1434  | 
fix x y u v  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1435  | 
assume uv: "0 \<le> u" "0 \<le> v" "u + v = (1::real)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1436  | 
assume xy: "x \<in> ?hull" "y \<in> ?hull"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1437  | 
from xy obtain k1 u1 x1 where  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1438  | 
    x [rule_format]: "\<forall>i\<in>{1::nat..k1}. 0\<le>u1 i \<and> x1 i \<in> S" 
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1439  | 
                      "sum u1 {Suc 0..k1} = 1" "(\<Sum>i = Suc 0..k1. u1 i *\<^sub>R x1 i) = x"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1440  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1441  | 
from xy obtain k2 u2 x2 where  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1442  | 
    y [rule_format]: "\<forall>i\<in>{1::nat..k2}. 0\<le>u2 i \<and> x2 i \<in> S" 
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1443  | 
                     "sum u2 {Suc 0..k2} = 1" "(\<Sum>i = Suc 0..k2. u2 i *\<^sub>R x2 i) = y"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1444  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1445  | 
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)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1446  | 
          "{1..k1 + k2} \<inter> {1..k1} = {1..k1}" "{1..k1 + k2} \<inter> - {1..k1} = (\<lambda>i. i + k1) ` {1..k2}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1447  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1448  | 
  have inj: "inj_on (\<lambda>i. i + k1) {1..k2}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1449  | 
unfolding inj_on_def by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1450  | 
  let ?uu = "\<lambda>i. if i \<in> {1..k1} then u * u1 i else v * u2 (i - k1)"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1451  | 
  let ?xx = "\<lambda>i. if i \<in> {1..k1} then x1 i else x2 (i - k1)"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1452  | 
show "u *\<^sub>R x + v *\<^sub>R y \<in> ?hull"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1453  | 
proof (intro CollectI exI conjI ballI)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1454  | 
    show "0 \<le> ?uu i" "?xx i \<in> S" if "i \<in> {1..k1+k2}" for i
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1455  | 
using that by (auto simp add: le_diff_conv uv(1) x(1) uv(2) y(1))  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1456  | 
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"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1457  | 
unfolding * sum.If_cases[OF finite_atLeastAtMost[of 1 "k1 + k2"]]  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1458  | 
sum.reindex[OF inj] Collect_mem_eq o_def  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1459  | 
unfolding scaleR_scaleR[symmetric] scaleR_right.sum [symmetric] sum_distrib_left[symmetric]  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1460  | 
by (simp_all add: sum_distrib_left[symmetric] x(2,3) y(2,3) uv(3))  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1461  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1462  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1463  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1464  | 
lemma convex_hull_finite:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1465  | 
fixes S :: "'a::real_vector set"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1466  | 
assumes "finite S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1467  | 
  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}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1468  | 
(is "?HULL = _")  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1469  | 
proof (rule hull_unique [OF _ convexI]; clarify)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1470  | 
fix x  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1471  | 
assume "x \<in> S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1472  | 
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"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1473  | 
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])  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1474  | 
next  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1475  | 
fix u v :: real  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1476  | 
assume uv: "0 \<le> u" "0 \<le> v" "u + v = 1"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1477  | 
fix ux assume ux [rule_format]: "\<forall>x\<in>S. 0 \<le> ux x" "sum ux S = (1::real)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1478  | 
fix uy assume uy [rule_format]: "\<forall>x\<in>S. 0 \<le> uy x" "sum uy S = (1::real)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1479  | 
have "0 \<le> u * ux x + v * uy x" if "x\<in>S" for x  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1480  | 
by (simp add: that uv ux(1) uy(1))  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1481  | 
moreover  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1482  | 
have "(\<Sum>x\<in>S. u * ux x + v * uy x) = 1"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1483  | 
unfolding sum.distrib and sum_distrib_left[symmetric] ux(2) uy(2)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1484  | 
using uv(3) by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1485  | 
moreover  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1486  | 
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)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1487  | 
unfolding scaleR_left_distrib sum.distrib scaleR_scaleR[symmetric] scaleR_right.sum [symmetric]  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1488  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1489  | 
ultimately  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1490  | 
show "\<exists>uc. (\<forall>x\<in>S. 0 \<le> uc x) \<and> sum uc S = 1 \<and>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1491  | 
(\<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)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1492  | 
by (rule_tac x="\<lambda>x. u * ux x + v * uy x" in exI, auto)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1493  | 
qed (use assms in \<open>auto simp: convex_explicit\<close>)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1494  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1495  | 
|
| 70136 | 1496  | 
subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Another formulation\<close>  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1497  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1498  | 
text "Formalized by Lars Schewe."  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1499  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1500  | 
lemma convex_hull_explicit:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1501  | 
fixes p :: "'a::real_vector set"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1502  | 
shows "convex hull p =  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1503  | 
    {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}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1504  | 
(is "?lhs = ?rhs")  | 
| 78475 | 1505  | 
proof (intro subset_antisym subsetI)  | 
1506  | 
fix x  | 
|
1507  | 
assume "x \<in> convex hull p"  | 
|
1508  | 
then obtain k u y where  | 
|
1509  | 
    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"
 | 
|
1510  | 
unfolding convex_hull_indexed by auto  | 
|
1511  | 
  have fin: "finite {1..k}" by auto
 | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1512  | 
  {
 | 
| 78475 | 1513  | 
fix j  | 
1514  | 
    assume "j\<in>{1..k}"
 | 
|
1515  | 
    then have "y j \<in> p \<and> 0 \<le> sum u {i. Suc 0 \<le> i \<and> i \<le> k \<and> y i = y j}"
 | 
|
1516  | 
by (metis (mono_tags, lifting) One_nat_def atLeastAtMost_iff mem_Collect_eq obt(1) sum_nonneg)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1517  | 
}  | 
| 78475 | 1518  | 
  moreover have "(\<Sum>v\<in>y ` {1..k}. sum u {i \<in> {1..k}. y i = v}) = 1"
 | 
1519  | 
unfolding sum.image_gen[OF fin, symmetric] using obt(2) by auto  | 
|
1520  | 
  moreover have "(\<Sum>v\<in>y ` {1..k}. sum u {i \<in> {1..k}. y i = v} *\<^sub>R v) = x"
 | 
|
1521  | 
using sum.image_gen[OF fin, of "\<lambda>i. u i *\<^sub>R y i" y, symmetric]  | 
|
1522  | 
unfolding scaleR_left.sum using obt(3) by auto  | 
|
1523  | 
ultimately  | 
|
1524  | 
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"  | 
|
1525  | 
by (smt (verit, ccfv_SIG) imageE mem_Collect_eq obt(1) subsetI sum.cong sum.infinite sum_nonneg)  | 
|
1526  | 
then show "x \<in> ?rhs" by auto  | 
|
1527  | 
next  | 
|
1528  | 
fix y  | 
|
1529  | 
assume "y \<in> ?rhs"  | 
|
1530  | 
then obtain S u where  | 
|
1531  | 
S: "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"  | 
|
1532  | 
by auto  | 
|
1533  | 
  obtain f where f: "inj_on f {1..card S}" "f ` {1..card S} = S"
 | 
|
1534  | 
using ex_bij_betw_nat_finite_1[OF S(1)] unfolding bij_betw_def by auto  | 
|
1535  | 
  then have "0 \<le> u (f i)" "f i \<in> p" if "i \<in> {1..card S}" for i
 | 
|
1536  | 
    using S \<open>i \<in> {1..card S}\<close> by blast+
 | 
|
1537  | 
moreover  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1538  | 
  {
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1539  | 
fix y  | 
| 78475 | 1540  | 
assume "y\<in>S"  | 
1541  | 
    then obtain i where "i\<in>{1..card S}" "f i = y"
 | 
|
1542  | 
by (metis f(2) image_iff)  | 
|
1543  | 
    then have "{x. Suc 0 \<le> x \<and> x \<le> card S \<and> f x = y} = {i}"
 | 
|
1544  | 
using f(1) inj_onD by fastforce  | 
|
1545  | 
    then have "(\<Sum>x\<in>{x \<in> {1..card S}. f x = y}. u (f x)) = u y"
 | 
|
1546  | 
      "(\<Sum>x\<in>{x \<in> {1..card S}. f x = y}. u (f x) *\<^sub>R f x) = u y *\<^sub>R y"
 | 
|
1547  | 
by (simp_all add: sum_constant_scaleR \<open>f i = y\<close>)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1548  | 
}  | 
| 78475 | 1549  | 
then have "(\<Sum>x = 1..card S. u (f x)) = 1" "(\<Sum>i = 1..card S. u (f i) *\<^sub>R f i) = y"  | 
1550  | 
by (metis (mono_tags, lifting) S(4,5) f sum.reindex_cong)+  | 
|
1551  | 
ultimately  | 
|
1552  | 
show "y \<in> convex hull p"  | 
|
1553  | 
unfolding convex_hull_indexed  | 
|
1554  | 
by (smt (verit, del_insts) mem_Collect_eq sum.cong)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1555  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1556  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1557  | 
|
| 70136 | 1558  | 
subsubsection\<^marker>\<open>tag unimportant\<close> \<open>A stepping theorem for that expansion\<close>  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1559  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1560  | 
lemma convex_hull_finite_step:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1561  | 
fixes S :: "'a::real_vector set"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1562  | 
assumes "finite S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1563  | 
shows  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1564  | 
"(\<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)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1565  | 
\<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)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1566  | 
(is "?lhs = ?rhs")  | 
| 72385 | 1567  | 
proof (cases "a \<in> S")  | 
1568  | 
case True  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1569  | 
then have *: "insert a S = S" by auto  | 
| 72385 | 1570  | 
show ?thesis  | 
1571  | 
proof  | 
|
1572  | 
assume ?lhs  | 
|
1573  | 
then show ?rhs  | 
|
1574  | 
unfolding * by force  | 
|
1575  | 
next  | 
|
1576  | 
have fin: "finite (insert a S)" using assms by auto  | 
|
1577  | 
assume ?rhs  | 
|
1578  | 
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"  | 
|
1579  | 
by auto  | 
|
1580  | 
then show ?lhs  | 
|
1581  | 
using uv True assms  | 
|
1582  | 
apply (rule_tac x = "\<lambda>x. (if a = x then v else 0) + u x" in exI)  | 
|
1583  | 
apply (auto simp: sum_clauses scaleR_left_distrib sum.distrib sum_delta''[OF fin])  | 
|
1584  | 
done  | 
|
1585  | 
qed  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1586  | 
next  | 
| 72385 | 1587  | 
case False  | 
1588  | 
show ?thesis  | 
|
1589  | 
proof  | 
|
1590  | 
assume ?lhs  | 
|
1591  | 
then obtain u where 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"  | 
|
1592  | 
by auto  | 
|
1593  | 
then show ?rhs  | 
|
1594  | 
using u \<open>a\<notin>S\<close> by (rule_tac x="u a" in exI) (auto simp: sum_clauses assms)  | 
|
1595  | 
next  | 
|
1596  | 
assume ?rhs  | 
|
1597  | 
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"  | 
|
1598  | 
by auto  | 
|
1599  | 
moreover  | 
|
1600  | 
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)"  | 
|
1601  | 
using False by (auto intro!: sum.cong)  | 
|
1602  | 
ultimately show ?lhs  | 
|
1603  | 
using False by (rule_tac x="\<lambda>x. if a = x then v else u x" in exI) (auto simp: sum_clauses(2)[OF assms])  | 
|
1604  | 
qed  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1605  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1606  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1607  | 
|
| 70136 | 1608  | 
subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Hence some special cases\<close>  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1609  | 
|
| 72385 | 1610  | 
lemma convex_hull_2: "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}"
 | 
1611  | 
(is "?lhs = ?rhs")  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1612  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1613  | 
  have **: "finite {b}" by auto
 | 
| 72385 | 1614  | 
have "\<And>x v u. \<lbrakk>0 \<le> v; v \<le> 1; (1 - v) *\<^sub>R b = x - v *\<^sub>R a\<rbrakk>  | 
1615  | 
\<Longrightarrow> \<exists>u v. x = u *\<^sub>R a + v *\<^sub>R b \<and> 0 \<le> u \<and> 0 \<le> v \<and> u + v = 1"  | 
|
1616  | 
by (metis add.commute diff_add_cancel diff_ge_0_iff_ge)  | 
|
1617  | 
moreover  | 
|
1618  | 
have "\<And>u v. \<lbrakk>0 \<le> u; 0 \<le> v; u + v = 1\<rbrakk>  | 
|
1619  | 
\<Longrightarrow> \<exists>p\<ge>0. \<exists>q. 0 \<le> q b \<and> q b = 1 - p \<and> q b *\<^sub>R b = u *\<^sub>R a + v *\<^sub>R b - p *\<^sub>R a"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1620  | 
apply (rule_tac x=u in exI, simp)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1621  | 
apply (rule_tac x="\<lambda>x. v" in exI, simp)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1622  | 
done  | 
| 72385 | 1623  | 
ultimately show ?thesis  | 
1624  | 
using convex_hull_finite_step[OF **, of a 1]  | 
|
1625  | 
by (auto simp add: convex_hull_finite)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1626  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1627  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1628  | 
lemma convex_hull_2_alt: "convex hull {a,b} = {a + u *\<^sub>R (b - a) | u.  0 \<le> u \<and> u \<le> 1}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1629  | 
unfolding convex_hull_2  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1630  | 
proof (rule Collect_cong)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1631  | 
have *: "\<And>x y ::real. x + y = 1 \<longleftrightarrow> x = 1 - y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1632  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1633  | 
fix x  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1634  | 
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>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1635  | 
(\<exists>u. x = a + u *\<^sub>R (b - a) \<and> 0 \<le> u \<and> u \<le> 1)"  | 
| 72385 | 1636  | 
apply (simp add: *)  | 
1637  | 
by (rule ex_cong1) (auto simp: algebra_simps)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1638  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1639  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1640  | 
lemma convex_hull_3:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1641  | 
  "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}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1642  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1643  | 
  have fin: "finite {a,b,c}" "finite {b,c}" "finite {c}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1644  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1645  | 
have *: "\<And>x y z ::real. x + y + z = 1 \<longleftrightarrow> x = 1 - y - z"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1646  | 
by (auto simp: field_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1647  | 
show ?thesis  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1648  | 
unfolding convex_hull_finite[OF fin(1)] and convex_hull_finite_step[OF fin(2)] and *  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1649  | 
unfolding convex_hull_finite_step[OF fin(3)]  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1650  | 
apply (rule Collect_cong, simp)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1651  | 
apply auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1652  | 
apply (rule_tac x=va in exI)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1653  | 
apply (rule_tac x="u c" in exI, simp)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1654  | 
apply (rule_tac x="1 - v - w" in exI, simp)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1655  | 
apply (rule_tac x=v in exI, simp)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1656  | 
apply (rule_tac x="\<lambda>x. w" in exI, simp)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1657  | 
done  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1658  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1659  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1660  | 
lemma convex_hull_3_alt:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1661  | 
  "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}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1662  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1663  | 
have *: "\<And>x y z ::real. x + y + z = 1 \<longleftrightarrow> x = 1 - y - z"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1664  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1665  | 
show ?thesis  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1666  | 
unfolding convex_hull_3  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1667  | 
apply (auto simp: *)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1668  | 
apply (rule_tac x=v in exI)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1669  | 
apply (rule_tac x=w in exI)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1670  | 
apply (simp add: algebra_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1671  | 
apply (rule_tac x=u in exI)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1672  | 
apply (rule_tac x=v in exI)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1673  | 
apply (simp add: algebra_simps)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1674  | 
done  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1675  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1676  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1677  | 
|
| 70136 | 1678  | 
subsection\<^marker>\<open>tag unimportant\<close> \<open>Relations among closure notions and corresponding hulls\<close>  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1679  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1680  | 
lemma affine_imp_convex: "affine s \<Longrightarrow> convex s"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1681  | 
unfolding affine_def convex_def by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1682  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1683  | 
lemma convex_affine_hull [simp]: "convex (affine hull S)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1684  | 
by (simp add: affine_imp_convex)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1685  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1686  | 
lemma subspace_imp_convex: "subspace s \<Longrightarrow> convex s"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1687  | 
using subspace_imp_affine affine_imp_convex by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1688  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1689  | 
lemma convex_hull_subset_span: "(convex hull s) \<subseteq> (span s)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1690  | 
by (metis hull_minimal span_superset subspace_imp_convex subspace_span)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1691  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1692  | 
lemma convex_hull_subset_affine_hull: "(convex hull s) \<subseteq> (affine hull s)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1693  | 
by (metis affine_affine_hull affine_imp_convex hull_minimal hull_subset)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1694  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1695  | 
lemma aff_dim_convex_hull:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1696  | 
fixes S :: "'n::euclidean_space set"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1697  | 
shows "aff_dim (convex hull S) = aff_dim S"  | 
| 78475 | 1698  | 
by (smt (verit) aff_dim_affine_hull aff_dim_subset convex_hull_subset_affine_hull hull_subset)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1699  | 
|
| 71242 | 1700  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1701  | 
subsection \<open>Caratheodory's theorem\<close>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1702  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1703  | 
lemma convex_hull_caratheodory_aff_dim:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1704  | 
  fixes p :: "('a::euclidean_space) set"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1705  | 
shows "convex hull p =  | 
| 72385 | 1706  | 
    {y. \<exists>S u. finite S \<and> S \<subseteq> p \<and> card S \<le> aff_dim p + 1 \<and>
 | 
1707  | 
(\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) S = y}"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1708  | 
unfolding convex_hull_explicit set_eq_iff mem_Collect_eq  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1709  | 
proof (intro allI iffI)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1710  | 
fix y  | 
| 72385 | 1711  | 
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>  | 
1712  | 
sum u S = 1 \<and> (\<Sum>v\<in>S. u v *\<^sub>R v) = y"  | 
|
1713  | 
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"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1714  | 
then obtain N where "?P N" by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1715  | 
then have "\<exists>n\<le>N. (\<forall>k<n. \<not> ?P k) \<and> ?P n"  | 
| 72385 | 1716  | 
by (rule_tac ex_least_nat_le, auto)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1717  | 
then obtain n where "?P n" and smallest: "\<forall>k<n. \<not> ?P k"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1718  | 
by blast  | 
| 78475 | 1719  | 
then obtain S u where S: "finite S" "card S = n" "S\<subseteq>p"  | 
1720  | 
and u: "\<forall>x\<in>S. 0 \<le> u x" "sum u S = 1" "(\<Sum>v\<in>S. u v *\<^sub>R v) = y" by auto  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1721  | 
|
| 72385 | 1722  | 
have "card S \<le> aff_dim p + 1"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1723  | 
proof (rule ccontr, simp only: not_le)  | 
| 72385 | 1724  | 
assume "aff_dim p + 1 < card S"  | 
1725  | 
then have "affine_dependent S"  | 
|
| 78475 | 1726  | 
by (smt (verit) independent_card_le_aff_dim S(3))  | 
| 72385 | 1727  | 
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"  | 
| 78475 | 1728  | 
using affine_dependent_explicit_finite[OF S(1)] by auto  | 
| 72385 | 1729  | 
    define i where "i = (\<lambda>v. (u v) / (- w v)) ` {v\<in>S. w v < 0}"
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1730  | 
define t where "t = Min i"  | 
| 72385 | 1731  | 
have "\<exists>x\<in>S. w x < 0"  | 
| 78475 | 1732  | 
by (smt (verit, best) S(1) sum_pos2 wv)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1733  | 
    then have "i \<noteq> {}" unfolding i_def by auto
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1734  | 
then have "t \<ge> 0"  | 
| 78475 | 1735  | 
using Min_ge_iff[of i 0] and S(1) u[unfolded le_less]  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1736  | 
unfolding t_def i_def  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1737  | 
by (auto simp: divide_le_0_iff)  | 
| 72385 | 1738  | 
have t: "\<forall>v\<in>S. u v + t * w v \<ge> 0"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1739  | 
proof  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1740  | 
fix v  | 
| 72385 | 1741  | 
assume "v \<in> S"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1742  | 
then have v: "0 \<le> u v"  | 
| 78475 | 1743  | 
using u(1) by blast  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1744  | 
show "0 \<le> u v + t * w v"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1745  | 
proof (cases "w v < 0")  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1746  | 
case False  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1747  | 
thus ?thesis using v \<open>t\<ge>0\<close> by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1748  | 
next  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1749  | 
case True  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1750  | 
then have "t \<le> u v / (- w v)"  | 
| 78475 | 1751  | 
using \<open>v\<in>S\<close> S unfolding t_def i_def by (auto intro: Min_le)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1752  | 
then show ?thesis  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1753  | 
unfolding real_0_le_add_iff  | 
| 72385 | 1754  | 
using True neg_le_minus_divide_eq by auto  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1755  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1756  | 
qed  | 
| 72385 | 1757  | 
obtain a where "a \<in> S" and "t = (\<lambda>v. (u v) / (- w v)) a" and "w a < 0"  | 
| 78475 | 1758  | 
      using Min_in[OF _ \<open>i\<noteq>{}\<close>] and S(1) unfolding i_def t_def by auto
 | 
| 72385 | 1759  | 
then have a: "a \<in> S" "u a + t * w a = 0" by auto  | 
1760  | 
    have *: "\<And>f. sum f (S - {a}) = sum f S - ((f a)::'b::ab_group_add)"
 | 
|
| 78475 | 1761  | 
unfolding sum.remove[OF S(1) \<open>a\<in>S\<close>] by auto  | 
| 72385 | 1762  | 
have "(\<Sum>v\<in>S. u v + t * w v) = 1"  | 
| 78475 | 1763  | 
by (metis add.right_neutral mult_zero_right sum.distrib sum_distrib_left u(2) wv(1))  | 
| 72385 | 1764  | 
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"  | 
| 78475 | 1765  | 
unfolding sum.distrib u(3) scaleR_scaleR[symmetric] scaleR_right.sum [symmetric] wv(4)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1766  | 
using a(2) [THEN eq_neg_iff_add_eq_0 [THEN iffD2]] by simp  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1767  | 
ultimately have "?P (n - 1)"  | 
| 72385 | 1768  | 
      apply (rule_tac x="(S - {a})" in exI)
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1769  | 
apply (rule_tac x="\<lambda>v. u v + t * w v" in exI)  | 
| 78475 | 1770  | 
using S t a  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1771  | 
apply (auto simp: * scaleR_left_distrib)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1772  | 
done  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1773  | 
then show False  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1774  | 
using smallest[THEN spec[where x="n - 1"]] by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1775  | 
qed  | 
| 72385 | 1776  | 
then show "\<exists>S u. finite S \<and> S \<subseteq> p \<and> card S \<le> aff_dim p + 1 \<and>  | 
1777  | 
(\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S = 1 \<and> (\<Sum>v\<in>S. u v *\<^sub>R v) = y"  | 
|
| 78475 | 1778  | 
using S u by auto  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1779  | 
qed auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1780  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1781  | 
lemma caratheodory_aff_dim:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1782  | 
  fixes p :: "('a::euclidean_space) set"
 | 
| 72385 | 1783  | 
  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}"
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1784  | 
(is "?lhs = ?rhs")  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1785  | 
proof  | 
| 72385 | 1786  | 
have "\<And>x S u. \<lbrakk>finite S; S \<subseteq> p; int (card S) \<le> aff_dim p + 1; \<forall>x\<in>S. 0 \<le> u x; sum u S = 1\<rbrakk>  | 
1787  | 
\<Longrightarrow> (\<Sum>v\<in>S. u v *\<^sub>R v) \<in> convex hull S"  | 
|
| 78475 | 1788  | 
by (metis (mono_tags, lifting) convex_convex_hull convex_explicit hull_subset)  | 
| 72385 | 1789  | 
then show "?lhs \<subseteq> ?rhs"  | 
1790  | 
by (subst convex_hull_caratheodory_aff_dim, auto)  | 
|
1791  | 
qed (use hull_mono in auto)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1792  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1793  | 
lemma convex_hull_caratheodory:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1794  | 
  fixes p :: "('a::euclidean_space) set"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1795  | 
shows "convex hull p =  | 
| 72385 | 1796  | 
            {y. \<exists>S u. finite S \<and> S \<subseteq> p \<and> card S \<le> DIM('a) + 1 \<and>
 | 
1797  | 
(\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) S = y}"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1798  | 
(is "?lhs = ?rhs")  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1799  | 
proof (intro set_eqI iffI)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1800  | 
fix x  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1801  | 
assume "x \<in> ?lhs" then show "x \<in> ?rhs"  | 
| 72385 | 1802  | 
unfolding convex_hull_caratheodory_aff_dim  | 
1803  | 
using aff_dim_le_DIM [of p] by fastforce  | 
|
1804  | 
qed (auto simp: convex_hull_explicit)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1805  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1806  | 
theorem caratheodory:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1807  | 
"convex hull p =  | 
| 72385 | 1808  | 
    {x::'a::euclidean_space. \<exists>S. finite S \<and> S \<subseteq> p \<and> card S \<le> DIM('a) + 1 \<and> x \<in> convex hull S}"
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1809  | 
proof safe  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1810  | 
fix x  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1811  | 
assume "x \<in> convex hull p"  | 
| 72385 | 1812  | 
  then obtain S u where "finite S" "S \<subseteq> p" "card S \<le> DIM('a) + 1"
 | 
1813  | 
"\<forall>x\<in>S. 0 \<le> u x" "sum u S = 1" "(\<Sum>v\<in>S. u v *\<^sub>R v) = x"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1814  | 
unfolding convex_hull_caratheodory by auto  | 
| 72385 | 1815  | 
  then show "\<exists>S. finite S \<and> S \<subseteq> p \<and> card S \<le> DIM('a) + 1 \<and> x \<in> convex hull S"
 | 
1816  | 
using convex_hull_finite by fastforce  | 
|
1817  | 
qed (use hull_mono in force)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1818  | 
|
| 70136 | 1819  | 
subsection\<^marker>\<open>tag unimportant\<close>\<open>Some Properties of subset of standard basis\<close>  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1820  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1821  | 
lemma affine_hull_substd_basis:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1822  | 
assumes "d \<subseteq> Basis"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1823  | 
  shows "affine hull (insert 0 d) = {x::'a::euclidean_space. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1824  | 
(is "affine hull (insert 0 ?A) = ?B")  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1825  | 
proof -  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1826  | 
have *: "\<And>A. (+) (0::'a) ` A = A" "\<And>A. (+) (- (0::'a)) ` A = A"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1827  | 
by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1828  | 
show ?thesis  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1829  | 
unfolding affine_hull_insert_span_gen span_substd_basis[OF assms,symmetric] * ..  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1830  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1831  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1832  | 
lemma affine_hull_convex_hull [simp]: "affine hull (convex hull S) = affine hull S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1833  | 
by (metis Int_absorb1 Int_absorb2 convex_hull_subset_affine_hull hull_hull hull_mono hull_subset)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1834  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1835  | 
|
| 70136 | 1836  | 
subsection\<^marker>\<open>tag unimportant\<close> \<open>Moving and scaling convex hulls\<close>  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1837  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1838  | 
lemma convex_hull_set_plus:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1839  | 
"convex hull (S + T) = convex hull S + convex hull T"  | 
| 78475 | 1840  | 
by (simp add: set_plus_image linear_iff scaleR_right_distrib convex_hull_Times  | 
1841  | 
flip: convex_hull_linear_image)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1842  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1843  | 
lemma translation_eq_singleton_plus: "(\<lambda>x. a + x) ` T = {a} + T"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1844  | 
unfolding set_plus_def by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1845  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1846  | 
lemma convex_hull_translation:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1847  | 
"convex hull ((\<lambda>x. a + x) ` S) = (\<lambda>x. a + x) ` (convex hull S)"  | 
| 78475 | 1848  | 
by (simp add: convex_hull_set_plus translation_eq_singleton_plus)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1849  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1850  | 
lemma convex_hull_scaling:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1851  | 
"convex hull ((\<lambda>x. c *\<^sub>R x) ` S) = (\<lambda>x. c *\<^sub>R x) ` (convex hull S)"  | 
| 78475 | 1852  | 
by (simp add: convex_hull_linear_image)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1853  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1854  | 
lemma convex_hull_affinity:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1855  | 
"convex hull ((\<lambda>x. a + c *\<^sub>R x) ` S) = (\<lambda>x. a + c *\<^sub>R x) ` (convex hull S)"  | 
| 72385 | 1856  | 
by (metis convex_hull_scaling convex_hull_translation image_image)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1857  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1858  | 
|
| 70136 | 1859  | 
subsection\<^marker>\<open>tag unimportant\<close> \<open>Convexity of cone hulls\<close>  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1860  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1861  | 
lemma convex_cone_hull:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1862  | 
assumes "convex S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1863  | 
shows "convex (cone hull S)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1864  | 
proof (rule convexI)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1865  | 
fix x y  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1866  | 
assume xy: "x \<in> cone hull S" "y \<in> cone hull S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1867  | 
  then have "S \<noteq> {}"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1868  | 
using cone_hull_empty_iff[of S] by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1869  | 
fix u v :: real  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1870  | 
assume uv: "u \<ge> 0" "v \<ge> 0" "u + v = 1"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1871  | 
then have *: "u *\<^sub>R x \<in> cone hull S" "v *\<^sub>R y \<in> cone hull S"  | 
| 78475 | 1872  | 
by (simp_all add: cone_cone_hull mem_cone uv xy)  | 
1873  | 
then obtain cx :: real and xx  | 
|
1874  | 
and cy :: real and yy where x: "u *\<^sub>R x = cx *\<^sub>R xx" "cx \<ge> 0" "xx \<in> S"  | 
|
1875  | 
and y: "v *\<^sub>R y = cy *\<^sub>R yy" "cy \<ge> 0" "yy \<in> S"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1876  | 
using cone_hull_expl[of S] by auto  | 
| 78475 | 1877  | 
|
1878  | 
have "u *\<^sub>R x + v *\<^sub>R y \<in> cone hull S" if "cx + cy \<le> 0"  | 
|
1879  | 
using "*"(1) nless_le that x(2) y by fastforce  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1880  | 
moreover  | 
| 78475 | 1881  | 
have "u *\<^sub>R x + v *\<^sub>R y \<in> cone hull S" if "cx + cy > 0"  | 
1882  | 
proof -  | 
|
1883  | 
have "(cx / (cx + cy)) *\<^sub>R xx + (cy / (cx + cy)) *\<^sub>R yy \<in> S"  | 
|
1884  | 
using assms mem_convex_alt[of S xx yy cx cy] x y that by auto  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1885  | 
then have "cx *\<^sub>R xx + cy *\<^sub>R yy \<in> cone hull S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1886  | 
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>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1887  | 
by (auto simp: scaleR_right_distrib)  | 
| 78475 | 1888  | 
then show ?thesis  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1889  | 
using x y by auto  | 
| 78475 | 1890  | 
qed  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1891  | 
moreover have "cx + cy \<le> 0 \<or> cx + cy > 0" by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1892  | 
ultimately show "u *\<^sub>R x + v *\<^sub>R y \<in> cone hull S" by blast  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1893  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1894  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1895  | 
lemma cone_convex_hull:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1896  | 
assumes "cone S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1897  | 
shows "cone (convex hull S)"  | 
| 78475 | 1898  | 
by (metis (no_types, lifting) affine_hull_convex_hull affine_hull_eq_empty assms cone_iff convex_hull_scaling hull_inc)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
1899  | 
|
| 
78656
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1900  | 
section \<open>Conic sets and conic hull\<close>  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1901  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1902  | 
definition conic :: "'a::real_vector set \<Rightarrow> bool"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1903  | 
where "conic S \<equiv> \<forall>x c. x \<in> S \<longrightarrow> 0 \<le> c \<longrightarrow> (c *\<^sub>R x) \<in> S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1904  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1905  | 
lemma conicD: "\<lbrakk>conic S; x \<in> S; 0 \<le> c\<rbrakk> \<Longrightarrow> (c *\<^sub>R x) \<in> S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1906  | 
by (meson conic_def)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1907  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1908  | 
lemma subspace_imp_conic: "subspace S \<Longrightarrow> conic S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1909  | 
by (simp add: conic_def subspace_def)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1910  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1911  | 
lemma conic_empty [simp]: "conic {}"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1912  | 
using conic_def by blast  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1913  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1914  | 
lemma conic_UNIV: "conic UNIV"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1915  | 
by (simp add: conic_def)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1916  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1917  | 
lemma conic_Inter: "(\<And>S. S \<in> \<F> \<Longrightarrow> conic S) \<Longrightarrow> conic(\<Inter>\<F>)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1918  | 
by (simp add: conic_def)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1919  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1920  | 
lemma conic_linear_image:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1921  | 
"\<lbrakk>conic S; linear f\<rbrakk> \<Longrightarrow> conic(f ` S)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1922  | 
by (smt (verit) conic_def image_iff linear.scaleR)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1923  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1924  | 
lemma conic_linear_image_eq:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1925  | 
"\<lbrakk>linear f; inj f\<rbrakk> \<Longrightarrow> conic (f ` S) \<longleftrightarrow> conic S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1926  | 
by (smt (verit) conic_def conic_linear_image inj_image_mem_iff linear_cmul)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1927  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1928  | 
lemma conic_mul: "\<lbrakk>conic S; x \<in> S; 0 \<le> c\<rbrakk> \<Longrightarrow> (c *\<^sub>R x) \<in> S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1929  | 
using conic_def by blast  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1930  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1931  | 
lemma conic_conic_hull: "conic(conic hull S)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1932  | 
by (metis (no_types, lifting) conic_Inter hull_def mem_Collect_eq)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1933  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1934  | 
lemma conic_hull_eq: "(conic hull S = S) \<longleftrightarrow> conic S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1935  | 
by (metis conic_conic_hull hull_same)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1936  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1937  | 
lemma conic_hull_UNIV [simp]: "conic hull UNIV = UNIV"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1938  | 
by simp  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1939  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1940  | 
lemma conic_negations: "conic S \<Longrightarrow> conic (image uminus S)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1941  | 
by (auto simp: conic_def image_iff)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1942  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1943  | 
lemma conic_span [iff]: "conic(span S)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1944  | 
by (simp add: subspace_imp_conic)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1945  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1946  | 
lemma conic_hull_explicit:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1947  | 
   "conic hull S = {c *\<^sub>R x| c x. 0 \<le> c \<and> x \<in> S}"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1948  | 
proof (rule hull_unique)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1949  | 
    show "S \<subseteq> {c *\<^sub>R x |c x. 0 \<le> c \<and> x \<in> S}"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1950  | 
by (metis (no_types) cone_hull_expl hull_subset)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1951  | 
  show "conic {c *\<^sub>R x |c x. 0 \<le> c \<and> x \<in> S}"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1952  | 
using mult_nonneg_nonneg by (force simp: conic_def)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1953  | 
qed (auto simp: conic_def)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1954  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1955  | 
lemma conic_hull_as_image:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1956  | 
   "conic hull S = (\<lambda>z. fst z *\<^sub>R snd z) ` ({0..} \<times> S)"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1957  | 
by (force simp: conic_hull_explicit)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1958  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1959  | 
lemma conic_hull_linear_image:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1960  | 
"linear f \<Longrightarrow> conic hull f ` S = f ` (conic hull S)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1961  | 
by (force simp: conic_hull_explicit image_iff set_eq_iff linear_scale)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1962  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1963  | 
lemma conic_hull_image_scale:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1964  | 
assumes "\<And>x. x \<in> S \<Longrightarrow> 0 < c x"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1965  | 
shows "conic hull (\<lambda>x. c x *\<^sub>R x) ` S = conic hull S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1966  | 
proof  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1967  | 
show "conic hull (\<lambda>x. c x *\<^sub>R x) ` S \<subseteq> conic hull S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1968  | 
proof (rule hull_minimal)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1969  | 
show "(\<lambda>x. c x *\<^sub>R x) ` S \<subseteq> conic hull S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1970  | 
using assms conic_hull_explicit by fastforce  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1971  | 
qed (simp add: conic_conic_hull)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1972  | 
show "conic hull S \<subseteq> conic hull (\<lambda>x. c x *\<^sub>R x) ` S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1973  | 
proof (rule hull_minimal)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1974  | 
show "S \<subseteq> conic hull (\<lambda>x. c x *\<^sub>R x) ` S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1975  | 
proof clarsimp  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1976  | 
fix x  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1977  | 
assume "x \<in> S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1978  | 
then have "x = inverse(c x) *\<^sub>R c x *\<^sub>R x"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1979  | 
using assms by fastforce  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1980  | 
then show "x \<in> conic hull (\<lambda>x. c x *\<^sub>R x) ` S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1981  | 
by (smt (verit, best) \<open>x \<in> S\<close> assms conic_conic_hull conic_mul hull_inc image_eqI inverse_nonpositive_iff_nonpositive)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1982  | 
qed  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1983  | 
qed (simp add: conic_conic_hull)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1984  | 
qed  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1985  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1986  | 
lemma convex_conic_hull:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1987  | 
assumes "convex S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1988  | 
shows "convex (conic hull S)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1989  | 
proof (clarsimp simp add: conic_hull_explicit convex_alt)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1990  | 
fix c x d y and u :: real  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1991  | 
assume \<section>: "(0::real) \<le> c" "x \<in> S" "(0::real) \<le> d" "y \<in> S" "0 \<le> u" "u \<le> 1"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1992  | 
show "\<exists>c'' x''. ((1 - u) * c) *\<^sub>R x + (u * d) *\<^sub>R y = c'' *\<^sub>R x'' \<and> 0 \<le> c'' \<and> x'' \<in> S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1993  | 
proof (cases "(1 - u) * c = 0")  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1994  | 
case True  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1995  | 
with \<open>0 \<le> d\<close> \<open>y \<in> S\<close>\<open>0 \<le> u\<close>  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1996  | 
show ?thesis by force  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1997  | 
next  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1998  | 
case False  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
1999  | 
define \<xi> where "\<xi> \<equiv> (1 - u) * c + u * d"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2000  | 
have *: "c * u \<le> c"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2001  | 
by (simp add: "\<section>" mult_left_le)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2002  | 
have "\<xi> > 0"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2003  | 
using False \<section> by (smt (verit, best) \<xi>_def split_mult_pos_le)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2004  | 
then have **: "c + d * u = \<xi> + c * u"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2005  | 
by (simp add: \<xi>_def mult.commute right_diff_distrib')  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2006  | 
show ?thesis  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2007  | 
proof (intro exI conjI)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2008  | 
show "0 \<le> \<xi>"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2009  | 
using \<open>0 < \<xi>\<close> by auto  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2010  | 
show "((1 - u) * c) *\<^sub>R x + (u * d) *\<^sub>R y = \<xi> *\<^sub>R (((1 - u) * c / \<xi>) *\<^sub>R x + (u * d / \<xi>) *\<^sub>R y)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2011  | 
using \<open>\<xi> > 0\<close> by (simp add: algebra_simps diff_divide_distrib)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2012  | 
show "((1 - u) * c / \<xi>) *\<^sub>R x + (u * d / \<xi>) *\<^sub>R y \<in> S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2013  | 
using \<open>0 < \<xi>\<close>  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2014  | 
by (intro convexD [OF assms]) (auto simp: \<section> field_split_simps * **)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2015  | 
qed  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2016  | 
qed  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2017  | 
qed  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2018  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2019  | 
lemma conic_halfspace_le: "conic {x. a \<bullet> x \<le> 0}"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2020  | 
by (auto simp: conic_def mult_le_0_iff)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2021  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2022  | 
lemma conic_halfspace_ge: "conic {x. a \<bullet> x \<ge> 0}"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2023  | 
by (auto simp: conic_def mult_le_0_iff)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2024  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2025  | 
lemma conic_hull_empty [simp]: "conic hull {} = {}"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2026  | 
by (simp add: conic_hull_eq)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2027  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2028  | 
lemma conic_contains_0: "conic S \<Longrightarrow> (0 \<in> S \<longleftrightarrow> S \<noteq> {})"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2029  | 
by (simp add: Convex.cone_def cone_contains_0 conic_def)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2030  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2031  | 
lemma conic_hull_eq_empty: "conic hull S = {} \<longleftrightarrow> (S = {})"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2032  | 
using conic_hull_explicit by fastforce  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2033  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2034  | 
lemma conic_sums: "\<lbrakk>conic S; conic T\<rbrakk> \<Longrightarrow> conic (\<Union>x\<in> S. \<Union>y \<in> T. {x + y})"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2035  | 
by (simp add: conic_def) (metis scaleR_right_distrib)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2036  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2037  | 
lemma conic_Times: "\<lbrakk>conic S; conic T\<rbrakk> \<Longrightarrow> conic(S \<times> T)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2038  | 
by (auto simp: conic_def)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2039  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2040  | 
lemma conic_Times_eq:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2041  | 
   "conic(S \<times> T) \<longleftrightarrow> S = {} \<or> T = {} \<or> conic S \<and> conic T" (is "?lhs = ?rhs")
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2042  | 
proof  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2043  | 
show "?lhs \<Longrightarrow> ?rhs"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2044  | 
by (force simp: conic_def)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2045  | 
show "?rhs \<Longrightarrow> ?lhs"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2046  | 
by (force simp: conic_Times)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2047  | 
qed  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2048  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2049  | 
lemma conic_hull_0 [simp]: "conic hull {0} = {0}"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2050  | 
by (simp add: conic_hull_eq subspace_imp_conic)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2051  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2052  | 
lemma conic_hull_contains_0 [simp]: "0 \<in> conic hull S \<longleftrightarrow> (S \<noteq> {})"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2053  | 
by (simp add: conic_conic_hull conic_contains_0 conic_hull_eq_empty)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2054  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2055  | 
lemma conic_hull_eq_sing:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2056  | 
  "conic hull S = {x} \<longleftrightarrow> S = {0} \<and> x = 0"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2057  | 
proof  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2058  | 
  show "conic hull S = {x} \<Longrightarrow> S = {0} \<and> x = 0"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2059  | 
by (metis conic_conic_hull conic_contains_0 conic_def conic_hull_eq hull_inc insert_not_empty singleton_iff)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2060  | 
qed simp  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2061  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2062  | 
lemma conic_hull_Int_affine_hull:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2063  | 
assumes "T \<subseteq> S" "0 \<notin> affine hull S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2064  | 
shows "(conic hull T) \<inter> (affine hull S) = T"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2065  | 
proof -  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2066  | 
have TaffS: "T \<subseteq> affine hull S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2067  | 
using \<open>T \<subseteq> S\<close> hull_subset by fastforce  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2068  | 
moreover  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2069  | 
have "conic hull T \<inter> affine hull S \<subseteq> T"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2070  | 
proof (clarsimp simp: conic_hull_explicit)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2071  | 
fix c x  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2072  | 
assume "c *\<^sub>R x \<in> affine hull S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2073  | 
and "0 \<le> c"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2074  | 
and "x \<in> T"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2075  | 
show "c *\<^sub>R x \<in> T"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2076  | 
proof (cases "c=1")  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2077  | 
case True  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2078  | 
then show ?thesis  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2079  | 
by (simp add: \<open>x \<in> T\<close>)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2080  | 
next  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2081  | 
case False  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2082  | 
then have "x /\<^sub>R (1 - c) = x + (c * inverse (1 - c)) *\<^sub>R x"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2083  | 
by (smt (verit, ccfv_SIG) diff_add_cancel mult.commute real_vector_affinity_eq scaleR_collapse scaleR_scaleR)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2084  | 
then have "0 = inverse(1 - c) *\<^sub>R c *\<^sub>R x + (1 - inverse(1 - c)) *\<^sub>R x"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2085  | 
by (simp add: algebra_simps)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2086  | 
then have "0 \<in> affine hull S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2087  | 
by (smt (verit) \<open>c *\<^sub>R x \<in> affine hull S\<close> \<open>x \<in> T\<close> affine_affine_hull TaffS in_mono mem_affine)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2088  | 
then show ?thesis  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2089  | 
using assms by auto  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2090  | 
qed  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2091  | 
qed  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2092  | 
ultimately show ?thesis  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2093  | 
by (auto simp: hull_inc)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2094  | 
qed  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2095  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2096  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2097  | 
section \<open>Convex cones and corresponding hulls\<close>  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2098  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2099  | 
definition convex_cone :: "'a::real_vector set \<Rightarrow> bool"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2100  | 
  where "convex_cone \<equiv> \<lambda>S. S \<noteq> {} \<and> convex S \<and> conic S"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2101  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2102  | 
lemma convex_cone_iff:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2103  | 
"convex_cone S \<longleftrightarrow>  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2104  | 
0 \<in> S \<and> (\<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)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2105  | 
by (metis cone_def conic_contains_0 conic_def convex_cone convex_cone_def)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2106  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2107  | 
lemma convex_cone_add: "\<lbrakk>convex_cone S; x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> x+y \<in> S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2108  | 
by (simp add: convex_cone_iff)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2109  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2110  | 
lemma convex_cone_scaleR: "\<lbrakk>convex_cone S; 0 \<le> c; x \<in> S\<rbrakk> \<Longrightarrow> c *\<^sub>R x \<in> S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2111  | 
by (simp add: convex_cone_iff)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2112  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2113  | 
lemma convex_cone_nonempty: "convex_cone S \<Longrightarrow> S \<noteq> {}"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2114  | 
by (simp add: convex_cone_def)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2115  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2116  | 
lemma convex_cone_linear_image:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2117  | 
"convex_cone S \<and> linear f \<Longrightarrow> convex_cone(f ` S)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2118  | 
by (simp add: conic_linear_image convex_cone_def convex_linear_image)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2119  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2120  | 
lemma convex_cone_linear_image_eq:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2121  | 
"\<lbrakk>linear f; inj f\<rbrakk> \<Longrightarrow> (convex_cone(f ` S) \<longleftrightarrow> convex_cone S)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2122  | 
by (simp add: conic_linear_image_eq convex_cone_def)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2123  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2124  | 
lemma convex_cone_halfspace_ge: "convex_cone {x. a \<bullet> x \<ge> 0}"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2125  | 
by (simp add: convex_cone_iff inner_simps(2))  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2126  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2127  | 
lemma convex_cone_halfspace_le: "convex_cone {x. a \<bullet> x \<le> 0}"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2128  | 
by (simp add: convex_cone_iff inner_right_distrib mult_nonneg_nonpos)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2129  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2130  | 
lemma convex_cone_contains_0: "convex_cone S \<Longrightarrow> 0 \<in> S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2131  | 
using convex_cone_iff by blast  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2132  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2133  | 
lemma convex_cone_Inter:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2134  | 
"(\<And>S. S \<in> f \<Longrightarrow> convex_cone S) \<Longrightarrow> convex_cone(\<Inter> f)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2135  | 
by (simp add: convex_cone_iff)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2136  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2137  | 
lemma convex_cone_convex_cone_hull: "convex_cone(convex_cone hull S)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2138  | 
by (metis (no_types, lifting) convex_cone_Inter hull_def mem_Collect_eq)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2139  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2140  | 
lemma convex_convex_cone_hull: "convex(convex_cone hull S)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2141  | 
by (meson convex_cone_convex_cone_hull convex_cone_def)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2142  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2143  | 
lemma conic_convex_cone_hull: "conic(convex_cone hull S)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2144  | 
by (metis convex_cone_convex_cone_hull convex_cone_def)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2145  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2146  | 
lemma convex_cone_hull_nonempty: "convex_cone hull S \<noteq> {}"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2147  | 
by (simp add: convex_cone_convex_cone_hull convex_cone_nonempty)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2148  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2149  | 
lemma convex_cone_hull_contains_0: "0 \<in> convex_cone hull S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2150  | 
by (simp add: convex_cone_contains_0 convex_cone_convex_cone_hull)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2151  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2152  | 
lemma convex_cone_hull_add:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2153  | 
"\<lbrakk>x \<in> convex_cone hull S; y \<in> convex_cone hull S\<rbrakk> \<Longrightarrow> x + y \<in> convex_cone hull S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2154  | 
by (simp add: convex_cone_add convex_cone_convex_cone_hull)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2155  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2156  | 
lemma convex_cone_hull_mul:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2157  | 
"\<lbrakk>x \<in> convex_cone hull S; 0 \<le> c\<rbrakk> \<Longrightarrow> (c *\<^sub>R x) \<in> convex_cone hull S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2158  | 
by (simp add: conic_convex_cone_hull conic_mul)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2159  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2160  | 
thm convex_sums  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2161  | 
lemma convex_cone_sums:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2162  | 
   "\<lbrakk>convex_cone S; convex_cone T\<rbrakk> \<Longrightarrow> convex_cone (\<Union>x\<in> S. \<Union>y \<in> T. {x + y})"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2163  | 
by (simp add: convex_cone_def conic_sums convex_sums)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2164  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2165  | 
lemma convex_cone_Times:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2166  | 
"\<lbrakk>convex_cone S; convex_cone T\<rbrakk> \<Longrightarrow> convex_cone(S \<times> T)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2167  | 
by (simp add: conic_Times convex_Times convex_cone_def)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2168  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2169  | 
lemma convex_cone_Times_D1: "convex_cone (S \<times> T) \<Longrightarrow> convex_cone S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2170  | 
by (metis Times_empty conic_Times_eq convex_cone_def convex_convex_hull convex_hull_Times hull_same times_eq_iff)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2171  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2172  | 
lemma convex_cone_Times_eq:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2173  | 
"convex_cone(S \<times> T) \<longleftrightarrow> convex_cone S \<and> convex_cone T"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2174  | 
proof (cases "S={} \<or> T={}")
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2175  | 
case True  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2176  | 
then show ?thesis  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2177  | 
by (auto dest: convex_cone_nonempty)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2178  | 
next  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2179  | 
case False  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2180  | 
then have "convex_cone (S \<times> T) \<Longrightarrow> convex_cone T"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2181  | 
by (metis conic_Times_eq convex_cone_def convex_convex_hull convex_hull_Times hull_same times_eq_iff)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2182  | 
then show ?thesis  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2183  | 
using convex_cone_Times convex_cone_Times_D1 by blast  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2184  | 
qed  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2185  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2186  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2187  | 
lemma convex_cone_hull_Un:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2188  | 
  "convex_cone hull(S \<union> T) = (\<Union>x \<in> convex_cone hull S. \<Union>y \<in> convex_cone hull T. {x + y})"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2189  | 
(is "?lhs = ?rhs")  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2190  | 
proof  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2191  | 
show "?lhs \<subseteq> ?rhs"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2192  | 
proof (rule hull_minimal)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2193  | 
    show "S \<union> T \<subseteq> (\<Union>x\<in>convex_cone hull S. \<Union>y\<in>convex_cone hull T. {x + y})"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2194  | 
apply (clarsimp simp: subset_iff)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2195  | 
by (metis add_0 convex_cone_hull_contains_0 group_cancel.rule0 hull_inc)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2196  | 
    show "convex_cone (\<Union>x\<in>convex_cone hull S. \<Union>y\<in>convex_cone hull T. {x + y})"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2197  | 
by (simp add: convex_cone_convex_cone_hull convex_cone_sums)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2198  | 
qed  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2199  | 
next  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2200  | 
show "?rhs \<subseteq> ?lhs"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2201  | 
by clarify (metis convex_cone_hull_add hull_mono le_sup_iff subsetD subsetI)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2202  | 
qed  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2203  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2204  | 
lemma convex_cone_singleton [iff]: "convex_cone {0}"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2205  | 
by (simp add: convex_cone_iff)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2206  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2207  | 
lemma convex_hull_subset_convex_cone_hull:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2208  | 
"convex hull S \<subseteq> convex_cone hull S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2209  | 
by (simp add: convex_convex_cone_hull hull_minimal hull_subset)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2210  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2211  | 
lemma conic_hull_subset_convex_cone_hull:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2212  | 
"conic hull S \<subseteq> convex_cone hull S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2213  | 
by (simp add: conic_convex_cone_hull hull_minimal hull_subset)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2214  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2215  | 
lemma subspace_imp_convex_cone: "subspace S \<Longrightarrow> convex_cone S"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2216  | 
by (simp add: convex_cone_iff subspace_def)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2217  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2218  | 
lemma convex_cone_span: "convex_cone(span S)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2219  | 
by (simp add: subspace_imp_convex_cone)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2220  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2221  | 
lemma convex_cone_negations:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2222  | 
"convex_cone S \<Longrightarrow> convex_cone (image uminus S)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2223  | 
by (simp add: convex_cone_linear_image module_hom_uminus)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2224  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2225  | 
lemma subspace_convex_cone_symmetric:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2226  | 
"subspace S \<longleftrightarrow> convex_cone S \<and> (\<forall>x \<in> S. -x \<in> S)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2227  | 
by (smt (verit) convex_cone_iff scaleR_left.minus subspace_def subspace_neg)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2228  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2229  | 
lemma convex_cone_hull_separate_nonempty:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2230  | 
  assumes "S \<noteq> {}"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2231  | 
shows "convex_cone hull S = conic hull (convex hull S)" (is "?lhs = ?rhs")  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2232  | 
proof  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2233  | 
show "?lhs \<subseteq> ?rhs"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2234  | 
by (metis assms conic_conic_hull convex_cone_def convex_conic_hull convex_convex_hull hull_subset subset_empty subset_hull)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2235  | 
show "?rhs \<subseteq> ?lhs"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2236  | 
by (simp add: conic_convex_cone_hull convex_hull_subset_convex_cone_hull subset_hull)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2237  | 
qed  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2238  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2239  | 
lemma convex_cone_hull_empty [simp]: "convex_cone hull {} = {0}"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2240  | 
by (metis convex_cone_hull_contains_0 convex_cone_singleton hull_redundant hull_same)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2241  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2242  | 
lemma convex_cone_hull_separate:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2243  | 
"convex_cone hull S = insert 0 (conic hull (convex hull S))"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2244  | 
proof(cases "S={}")
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2245  | 
case False  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2246  | 
then show ?thesis  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2247  | 
using convex_cone_hull_contains_0 convex_cone_hull_separate_nonempty by blast  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2248  | 
qed auto  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2249  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2250  | 
lemma convex_cone_hull_convex_hull_nonempty:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2251  | 
   "S \<noteq> {} \<Longrightarrow> convex_cone hull S = (\<Union>x \<in> convex hull S. \<Union>c\<in>{0..}. {c *\<^sub>R x})"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2252  | 
by (force simp: convex_cone_hull_separate_nonempty conic_hull_as_image)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2253  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2254  | 
lemma convex_cone_hull_convex_hull:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2255  | 
   "convex_cone hull S = insert 0 (\<Union>x \<in> convex hull S. \<Union>c\<in>{0..}. {c *\<^sub>R x})"
 | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2256  | 
by (force simp: convex_cone_hull_separate conic_hull_as_image)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2257  | 
|
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2258  | 
lemma convex_cone_hull_linear_image:  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2259  | 
"linear f \<Longrightarrow> convex_cone hull (f ` S) = image f (convex_cone hull S)"  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2260  | 
by (metis (no_types, lifting) conic_hull_linear_image convex_cone_hull_separate convex_hull_linear_image image_insert linear_0)  | 
| 
 
4da1e18a9633
Loads of new material related to porting the Euler Polyhedron Formula from HOL Light
 
paulson <lp15@cam.ac.uk> 
parents: 
78475 
diff
changeset
 | 
2261  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2262  | 
subsection \<open>Radon's theorem\<close>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2263  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2264  | 
text "Formalized by Lars Schewe."  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2265  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2266  | 
lemma Radon_ex_lemma:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2267  | 
assumes "finite c" "affine_dependent c"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2268  | 
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"  | 
| 78475 | 2269  | 
using affine_dependent_explicit_finite assms by blast  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2270  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2271  | 
lemma Radon_s_lemma:  | 
| 72385 | 2272  | 
assumes "finite S"  | 
2273  | 
and "sum f S = (0::real)"  | 
|
2274  | 
  shows "sum f {x\<in>S. 0 < f x} = - sum f {x\<in>S. f x < 0}"
 | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2275  | 
proof -  | 
| 78475 | 2276  | 
have "\<And>x. (if f x < 0 then f x else 0) + (if 0 < f x then f x else 0) = f x"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2277  | 
by auto  | 
| 78475 | 2278  | 
then show ?thesis  | 
2279  | 
using assms by (simp add: sum.inter_filter flip: sum.distrib add_eq_0_iff)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2280  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2281  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2282  | 
lemma Radon_v_lemma:  | 
| 72385 | 2283  | 
assumes "finite S"  | 
2284  | 
and "sum f S = 0"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2285  | 
and "\<forall>x. g x = (0::real) \<longrightarrow> f x = (0::'a::euclidean_space)"  | 
| 72385 | 2286  | 
  shows "(sum f {x\<in>S. 0 < g x}) = - sum f {x\<in>S. g x < 0}"
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2287  | 
proof -  | 
| 78475 | 2288  | 
have "\<And>x. (if 0 < g x then f x else 0) + (if g x < 0 then f x else 0) = f x"  | 
2289  | 
using assms by auto  | 
|
2290  | 
then show ?thesis  | 
|
2291  | 
using assms by (simp add: sum.inter_filter eq_neg_iff_add_eq_0 flip: sum.distrib add_eq_0_iff)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2292  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2293  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2294  | 
lemma Radon_partition:  | 
| 72385 | 2295  | 
assumes "finite C" "affine_dependent C"  | 
| 78475 | 2296  | 
  shows "\<exists>M P. M \<inter> P = {} \<and> M \<union> P = C \<and> (convex hull M) \<inter> (convex hull P) \<noteq> {}"
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2297  | 
proof -  | 
| 72385 | 2298  | 
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"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2299  | 
using Radon_ex_lemma[OF assms] by auto  | 
| 72385 | 2300  | 
  have fin: "finite {x \<in> C. 0 < u x}" "finite {x \<in> C. 0 > u x}"
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2301  | 
using assms(1) by auto  | 
| 72385 | 2302  | 
  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}"
 | 
2303  | 
  have "sum u {x \<in> C. 0 < u x} \<noteq> 0"
 | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2304  | 
proof (cases "u v \<ge> 0")  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2305  | 
case False  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2306  | 
then have "u v < 0" by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2307  | 
then show ?thesis  | 
| 78475 | 2308  | 
by (smt (verit) assms(1) fin(1) mem_Collect_eq sum.neutral_const sum_mono_inv uv)  | 
2309  | 
next  | 
|
2310  | 
case True  | 
|
2311  | 
    with fin uv show "sum u {x \<in> C. 0 < u x} \<noteq> 0"
 | 
|
2312  | 
by (smt (verit) fin(1) mem_Collect_eq sum_nonneg_eq_0_iff uv)  | 
|
2313  | 
qed  | 
|
| 72385 | 2314  | 
  then have *: "sum u {x\<in>C. u x > 0} > 0"
 | 
2315  | 
unfolding less_le by (metis (no_types, lifting) mem_Collect_eq sum_nonneg)  | 
|
2316  | 
  moreover have "sum u ({x \<in> C. 0 < u x} \<union> {x \<in> C. u x < 0}) = sum u C"
 | 
|
2317  | 
    "(\<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)"
 | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2318  | 
using assms(1)  | 
| 72385 | 2319  | 
by (rule_tac[!] sum.mono_neutral_left, auto)  | 
2320  | 
  then have "sum u {x \<in> C. 0 < u x} = - sum u {x \<in> C. 0 > u x}"
 | 
|
2321  | 
    "(\<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)"
 | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2322  | 
unfolding eq_neg_iff_add_eq_0  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2323  | 
using uv(1,4)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2324  | 
by (auto simp: sum.union_inter_neutral[OF fin, symmetric])  | 
| 72385 | 2325  | 
  moreover have "\<forall>x\<in>{v \<in> C. u v < 0}. 0 \<le> inverse (sum u {x \<in> C. 0 < u x}) * - u x"
 | 
2326  | 
using * by (fastforce intro: mult_nonneg_nonneg)  | 
|
2327  | 
  ultimately have "z \<in> convex hull {v \<in> C. u v \<le> 0}"
 | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2328  | 
unfolding convex_hull_explicit mem_Collect_eq  | 
| 72385 | 2329  | 
    apply (rule_tac x="{v \<in> C. u v < 0}" in exI)
 | 
2330  | 
    apply (rule_tac x="\<lambda>y. inverse (sum u {x\<in>C. u x > 0}) * - u y" in exI)
 | 
|
2331  | 
using assms(1) unfolding scaleR_scaleR[symmetric] scaleR_right.sum [symmetric]  | 
|
2332  | 
by (auto simp: z_def sum_negf sum_distrib_left[symmetric])  | 
|
2333  | 
  moreover have "\<forall>x\<in>{v \<in> C. 0 < u v}. 0 \<le> inverse (sum u {x \<in> C. 0 < u x}) * u x"
 | 
|
2334  | 
using * by (fastforce intro: mult_nonneg_nonneg)  | 
|
2335  | 
  then have "z \<in> convex hull {v \<in> C. u v > 0}"
 | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2336  | 
unfolding convex_hull_explicit mem_Collect_eq  | 
| 72385 | 2337  | 
    apply (rule_tac x="{v \<in> C. 0 < u v}" in exI)
 | 
2338  | 
    apply (rule_tac x="\<lambda>y. inverse (sum u {x\<in>C. u x > 0}) * u y" in exI)
 | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2339  | 
using assms(1)  | 
| 72385 | 2340  | 
unfolding scaleR_scaleR[symmetric] scaleR_right.sum [symmetric]  | 
2341  | 
using * by (auto simp: z_def sum_negf sum_distrib_left[symmetric])  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2342  | 
ultimately show ?thesis  | 
| 72385 | 2343  | 
    apply (rule_tac x="{v\<in>C. u v \<le> 0}" in exI)
 | 
2344  | 
    apply (rule_tac x="{v\<in>C. u v > 0}" in exI, auto)
 | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2345  | 
done  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2346  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2347  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2348  | 
theorem Radon:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2349  | 
assumes "affine_dependent c"  | 
| 78475 | 2350  | 
  obtains M P where "M \<subseteq> c" "P \<subseteq> c" "M \<inter> P = {}" "(convex hull M) \<inter> (convex hull P) \<noteq> {}"
 | 
2351  | 
by (smt (verit) Radon_partition affine_dependent_explicit affine_dependent_explicit_finite assms le_sup_iff)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2352  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2353  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2354  | 
subsection \<open>Helly's theorem\<close>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2355  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2356  | 
lemma Helly_induct:  | 
| 78475 | 2357  | 
fixes \<F> :: "'a::euclidean_space set set"  | 
2358  | 
assumes "card \<F> = n"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2359  | 
    and "n \<ge> DIM('a) + 1"
 | 
| 78475 | 2360  | 
    and "\<forall>S\<in>\<F>. convex S" "\<forall>T\<subseteq>\<F>. card T = DIM('a) + 1 \<longrightarrow> \<Inter>T \<noteq> {}"
 | 
2361  | 
  shows "\<Inter>\<F> \<noteq> {}"
 | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2362  | 
using assms  | 
| 78475 | 2363  | 
proof (induction n arbitrary: \<F>)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2364  | 
case 0  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2365  | 
then show ?case by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2366  | 
next  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2367  | 
case (Suc n)  | 
| 78475 | 2368  | 
have "finite \<F>"  | 
2369  | 
using \<open>card \<F> = Suc n\<close> by (auto intro: card_ge_0_finite)  | 
|
2370  | 
  show "\<Inter>\<F> \<noteq> {}"
 | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2371  | 
  proof (cases "n = DIM('a)")
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2372  | 
case True  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2373  | 
then show ?thesis  | 
| 78475 | 2374  | 
by (simp add: Suc.prems)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2375  | 
next  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2376  | 
case False  | 
| 78475 | 2377  | 
    have "\<Inter>(\<F> - {S}) \<noteq> {}" if "S \<in> \<F>" for S
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2378  | 
proof (rule Suc.IH[rule_format])  | 
| 78475 | 2379  | 
      show "card (\<F> - {S}) = n"
 | 
2380  | 
by (simp add: Suc.prems(1) \<open>finite \<F>\<close> that)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2381  | 
      show "DIM('a) + 1 \<le> n"
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2382  | 
using False Suc.prems(2) by linarith  | 
| 78475 | 2383  | 
      show "\<And>t. \<lbrakk>t \<subseteq> \<F> - {S}; card t = DIM('a) + 1\<rbrakk> \<Longrightarrow> \<Inter>t \<noteq> {}"
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2384  | 
by (simp add: Suc.prems(4) subset_Diff_insert)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2385  | 
qed (use Suc in auto)  | 
| 78475 | 2386  | 
    then have "\<forall>S\<in>\<F>. \<exists>x. x \<in> \<Inter>(\<F> - {S})"
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2387  | 
by blast  | 
| 78475 | 2388  | 
    then obtain X where X: "\<And>S. S\<in>\<F> \<Longrightarrow> X S \<in> \<Inter>(\<F> - {S})"
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2389  | 
by metis  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2390  | 
show ?thesis  | 
| 78475 | 2391  | 
proof (cases "inj_on X \<F>")  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2392  | 
case False  | 
| 78475 | 2393  | 
then obtain S T where "S\<noteq>T" and st: "S\<in>\<F>" "T\<in>\<F>" "X S = X T"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2394  | 
unfolding inj_on_def by auto  | 
| 78475 | 2395  | 
      then have *: "\<Inter>\<F> = \<Inter>(\<F> - {S}) \<inter> \<Inter>(\<F> - {T})" by auto
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2396  | 
show ?thesis  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2397  | 
by (metis "*" X disjoint_iff_not_equal st)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2398  | 
next  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2399  | 
case True  | 
| 78475 | 2400  | 
      then obtain M P where mp: "M \<inter> P = {}" "M \<union> P = X ` \<F>" "convex hull M \<inter> convex hull P \<noteq> {}"
 | 
2401  | 
using Radon_partition[of "X ` \<F>"] and affine_dependent_biggerset[of "X ` \<F>"]  | 
|
2402  | 
unfolding card_image[OF True] and \<open>card \<F> = Suc n\<close>  | 
|
2403  | 
using Suc(3) \<open>finite \<F>\<close> and False  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2404  | 
by auto  | 
| 78475 | 2405  | 
have "M \<subseteq> X ` \<F>" "P \<subseteq> X ` \<F>"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2406  | 
using mp(2) by auto  | 
| 78475 | 2407  | 
then obtain \<G> \<H> where gh:"M = X ` \<G>" "P = X ` \<H>" "\<G> \<subseteq> \<F>" "\<H> \<subseteq> \<F>"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2408  | 
unfolding subset_image_iff by auto  | 
| 78475 | 2409  | 
then have "\<F> \<union> (\<G> \<union> \<H>) = \<F>" by auto  | 
2410  | 
then have \<F>: "\<F> = \<G> \<union> \<H>"  | 
|
2411  | 
using inj_on_Un_image_eq_iff[of X \<F> "\<G> \<union> \<H>"] and True  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2412  | 
unfolding mp(2)[unfolded image_Un[symmetric] gh]  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2413  | 
by auto  | 
| 78475 | 2414  | 
      have *: "\<G> \<inter> \<H> = {}"
 | 
2415  | 
using gh local.mp(1) by blast  | 
|
2416  | 
have "convex hull (X ` \<H>) \<subseteq> \<Inter>\<G>" "convex hull (X ` \<G>) \<subseteq> \<Inter>\<H>"  | 
|
2417  | 
by (rule hull_minimal; use X * \<F> in \<open>auto simp: Suc.prems(3) convex_Inter\<close>)+  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2418  | 
then show ?thesis  | 
| 78475 | 2419  | 
unfolding \<F> using mp(3)[unfolded gh] by blast  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2420  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2421  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2422  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2423  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2424  | 
theorem Helly:  | 
| 78475 | 2425  | 
fixes \<F> :: "'a::euclidean_space set set"  | 
2426  | 
  assumes "card \<F> \<ge> DIM('a) + 1" "\<forall>s\<in>\<F>. convex s"
 | 
|
2427  | 
    and "\<And>t. \<lbrakk>t\<subseteq>\<F>; card t = DIM('a) + 1\<rbrakk> \<Longrightarrow> \<Inter>t \<noteq> {}"
 | 
|
2428  | 
  shows "\<Inter>\<F> \<noteq> {}"
 | 
|
| 72385 | 2429  | 
using Helly_induct assms by blast  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2430  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2431  | 
subsection \<open>Epigraphs of convex functions\<close>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2432  | 
|
| 70136 | 2433  | 
definition\<^marker>\<open>tag important\<close> "epigraph S (f :: _ \<Rightarrow> real) = {xy. fst xy \<in> S \<and> f (fst xy) \<le> snd xy}"
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2434  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2435  | 
lemma mem_epigraph: "(x, y) \<in> epigraph S f \<longleftrightarrow> x \<in> S \<and> f x \<le> y"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2436  | 
unfolding epigraph_def by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2437  | 
|
| 
79582
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
2438  | 
lemma convex_epigraph: "convex (epigraph S f) \<longleftrightarrow> convex_on S f"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2439  | 
proof safe  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2440  | 
assume L: "convex (epigraph S f)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2441  | 
then show "convex_on S f"  | 
| 
79582
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
2442  | 
by (fastforce simp: convex_def convex_on_def epigraph_def)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2443  | 
next  | 
| 
79582
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
2444  | 
assume "convex_on S f"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2445  | 
then show "convex (epigraph S f)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2446  | 
unfolding convex_def convex_on_def epigraph_def  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2447  | 
apply safe  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2448  | 
apply (rule_tac [2] y="u * f a + v * f aa" in order_trans)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2449  | 
apply (auto intro!:mult_left_mono add_mono)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2450  | 
done  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2451  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2452  | 
|
| 
79582
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
2453  | 
lemma convex_epigraphI: "convex_on S f \<Longrightarrow> convex (epigraph S f)"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2454  | 
unfolding convex_epigraph by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2455  | 
|
| 
79582
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
2456  | 
lemma convex_epigraph_convex: "convex_on S f \<longleftrightarrow> convex(epigraph S f)"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2457  | 
by (simp add: convex_epigraph)  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2458  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2459  | 
|
| 70136 | 2460  | 
subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Use this to derive general bound property of convex function\<close>  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2461  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2462  | 
lemma convex_on:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2463  | 
assumes "convex S"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2464  | 
shows "convex_on S f \<longleftrightarrow>  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2465  | 
    (\<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>
 | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2466  | 
      f (sum (\<lambda>i. u i *\<^sub>R x i) {1..k}) \<le> sum (\<lambda>i. u i * f(x i)) {1..k})"
 | 
| 72385 | 2467  | 
(is "?lhs = (\<forall>k u x. ?rhs k u x)")  | 
2468  | 
proof  | 
|
2469  | 
assume ?lhs  | 
|
2470  | 
  then have \<section>: "convex {xy. fst xy \<in> S \<and> f (fst xy) \<le> snd xy}"
 | 
|
2471  | 
by (metis assms convex_epigraph epigraph_def)  | 
|
2472  | 
show "\<forall>k u x. ?rhs k u x"  | 
|
2473  | 
proof (intro allI)  | 
|
2474  | 
fix k u x  | 
|
2475  | 
show "?rhs k u x"  | 
|
2476  | 
using \<section>  | 
|
2477  | 
unfolding convex mem_Collect_eq fst_sum snd_sum  | 
|
2478  | 
apply safe  | 
|
2479  | 
apply (drule_tac x=k in spec)  | 
|
2480  | 
apply (drule_tac x=u in spec)  | 
|
2481  | 
apply (drule_tac x="\<lambda>i. (x i, f (x i))" in spec)  | 
|
2482  | 
apply simp  | 
|
2483  | 
done  | 
|
2484  | 
qed  | 
|
2485  | 
next  | 
|
2486  | 
assume "\<forall>k u x. ?rhs k u x"  | 
|
2487  | 
then show ?lhs  | 
|
| 
79582
 
7822b55b26ce
Correct the definition of a convex function, and updated the proofs
 
paulson <lp15@cam.ac.uk> 
parents: 
79532 
diff
changeset
 | 
2488  | 
unfolding convex_epigraph_convex convex epigraph_def Ball_def mem_Collect_eq fst_sum snd_sum  | 
| 72385 | 2489  | 
using assms[unfolded convex] apply clarsimp  | 
2490  | 
apply (rule_tac y="\<Sum>i = 1..k. u i * f (fst (x i))" in order_trans)  | 
|
2491  | 
by (auto simp add: mult_left_mono intro: sum_mono)  | 
|
2492  | 
qed  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2493  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2494  | 
|
| 70136 | 2495  | 
subsection\<^marker>\<open>tag unimportant\<close> \<open>A bound within a convex hull\<close>  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2496  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2497  | 
lemma convex_on_convex_hull_bound:  | 
| 72385 | 2498  | 
assumes "convex_on (convex hull S) f"  | 
2499  | 
and "\<forall>x\<in>S. f x \<le> b"  | 
|
2500  | 
shows "\<forall>x\<in> convex hull S. f x \<le> b"  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2501  | 
proof  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2502  | 
fix x  | 
| 72385 | 2503  | 
assume "x \<in> convex hull S"  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2504  | 
then obtain k u v where  | 
| 72385 | 2505  | 
    u: "\<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"
 | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2506  | 
unfolding convex_hull_indexed mem_Collect_eq by auto  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2507  | 
have "(\<Sum>i = 1..k. u i * f (v i)) \<le> b"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2508  | 
    using sum_mono[of "{1..k}" "\<lambda>i. u i * f (v i)" "\<lambda>i. u i * b"]
 | 
| 72385 | 2509  | 
unfolding sum_distrib_right[symmetric] u(2) mult_1  | 
2510  | 
using assms(2) mult_left_mono u(1) by blast  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2511  | 
then show "f x \<le> b"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2512  | 
using assms(1)[unfolded convex_on[OF convex_convex_hull], rule_format, of k u v]  | 
| 72385 | 2513  | 
using hull_inc u by fastforce  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2514  | 
qed  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2515  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2516  | 
lemma convex_set_plus:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2517  | 
assumes "convex S" and "convex T" shows "convex (S + T)"  | 
| 78475 | 2518  | 
by (metis assms convex_hull_eq convex_hull_set_plus)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2519  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2520  | 
lemma convex_set_sum:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2521  | 
assumes "\<And>i. i \<in> A \<Longrightarrow> convex (B i)"  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2522  | 
shows "convex (\<Sum>i\<in>A. B i)"  | 
| 78475 | 2523  | 
using assms  | 
2524  | 
by (induction A rule: infinite_finite_induct) (auto simp: convex_set_plus)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2525  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2526  | 
lemma finite_set_sum:  | 
| 78475 | 2527  | 
assumes "\<forall>i\<in>A. finite (B i)" shows "finite (\<Sum>i\<in>A. B i)"  | 
2528  | 
using assms  | 
|
2529  | 
by (induction A rule: infinite_finite_induct) (auto simp: finite_set_plus)  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2530  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2531  | 
lemma box_eq_set_sum_Basis:  | 
| 72385 | 2532  | 
  "{x. \<forall>i\<in>Basis. x\<bullet>i \<in> B i} = (\<Sum>i\<in>Basis. (\<lambda>x. x *\<^sub>R i) ` (B i))" (is "?lhs = ?rhs")
 | 
2533  | 
proof -  | 
|
2534  | 
have "\<And>x. \<forall>i\<in>Basis. x \<bullet> i \<in> B i \<Longrightarrow>  | 
|
2535  | 
\<exists>s. x = sum s Basis \<and> (\<forall>i\<in>Basis. s i \<in> (\<lambda>x. x *\<^sub>R i) ` B i)"  | 
|
2536  | 
by (metis (mono_tags, lifting) euclidean_representation image_iff)  | 
|
2537  | 
moreover  | 
|
2538  | 
have "sum f Basis \<bullet> i \<in> B i" if "i \<in> Basis" and f: "\<forall>i\<in>Basis. f i \<in> (\<lambda>x. x *\<^sub>R i) ` B i" for i f  | 
|
2539  | 
proof -  | 
|
2540  | 
    have "(\<Sum>x\<in>Basis - {i}. f x \<bullet> i) = 0"
 | 
|
| 78475 | 2541  | 
proof (intro strip sum.neutral)  | 
| 72385 | 2542  | 
      show "f x \<bullet> i = 0" if "x \<in> Basis - {i}" for x
 | 
2543  | 
using that f \<open>i \<in> Basis\<close> inner_Basis that by fastforce  | 
|
2544  | 
qed  | 
|
2545  | 
then have "(\<Sum>x\<in>Basis. f x \<bullet> i) = f i \<bullet> i"  | 
|
2546  | 
by (metis (no_types) \<open>i \<in> Basis\<close> add.right_neutral sum.remove [OF finite_Basis])  | 
|
2547  | 
then have "(\<Sum>x\<in>Basis. f x \<bullet> i) \<in> B i"  | 
|
2548  | 
using f that(1) by auto  | 
|
2549  | 
then show ?thesis  | 
|
2550  | 
by (simp add: inner_sum_left)  | 
|
2551  | 
qed  | 
|
2552  | 
ultimately show ?thesis  | 
|
2553  | 
by (subst set_sum_alt [OF finite_Basis]) auto  | 
|
2554  | 
qed  | 
|
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2555  | 
|
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2556  | 
lemma convex_hull_set_sum:  | 
| 
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2557  | 
"convex hull (\<Sum>i\<in>A. B i) = (\<Sum>i\<in>A. convex hull (B i))"  | 
| 78475 | 2558  | 
by (induction A rule: infinite_finite_induct) (auto simp: convex_hull_set_plus)  | 
| 
69619
 
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
 
immler 
parents:  
diff
changeset
 | 
2559  | 
|
| 
79532
 
bb5d036f3523
Type class patch suggested by Achim Brucker, plus tidied lemma
 
paulson <lp15@cam.ac.uk> 
parents: 
78656 
diff
changeset
 | 
2560  | 
end  |