author | nipkow |
Fri, 06 Dec 2019 17:03:58 +0100 | |
changeset 71244 | 38457af660bc |
parent 71225 | 1249859d23dd |
child 71633 | 07bec530f02e |
permissions | -rw-r--r-- |
63969
f4b4fba60b1d
HOL-Analysis: move Library/Convex to Convex_Euclidean_Space
hoelzl
parents:
63967
diff
changeset
|
1 |
(* Title: HOL/Analysis/Convex_Euclidean_Space.thy |
f4b4fba60b1d
HOL-Analysis: move Library/Convex to Convex_Euclidean_Space
hoelzl
parents:
63967
diff
changeset
|
2 |
Author: L C Paulson, University of Cambridge |
f4b4fba60b1d
HOL-Analysis: move Library/Convex to Convex_Euclidean_Space
hoelzl
parents:
63967
diff
changeset
|
3 |
Author: Robert Himmelmann, TU Muenchen |
f4b4fba60b1d
HOL-Analysis: move Library/Convex to Convex_Euclidean_Space
hoelzl
parents:
63967
diff
changeset
|
4 |
Author: Bogdan Grechuk, University of Edinburgh |
f4b4fba60b1d
HOL-Analysis: move Library/Convex to Convex_Euclidean_Space
hoelzl
parents:
63967
diff
changeset
|
5 |
Author: Armin Heller, TU Muenchen |
f4b4fba60b1d
HOL-Analysis: move Library/Convex to Convex_Euclidean_Space
hoelzl
parents:
63967
diff
changeset
|
6 |
Author: Johannes Hoelzl, TU Muenchen |
33175 | 7 |
*) |
8 |
||
69619
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
immler
parents:
69618
diff
changeset
|
9 |
section \<open>Convex Sets and Functions on (Normed) Euclidean Spaces\<close> |
33175 | 10 |
|
11 |
theory Convex_Euclidean_Space |
|
44132 | 12 |
imports |
69619
3f7d8e05e0f2
split off Convex.thy: material that does not require Topology_Euclidean_Space
immler
parents:
69618
diff
changeset
|
13 |
Convex |
69617 | 14 |
Topology_Euclidean_Space |
33175 | 15 |
begin |
16 |
||
70136 | 17 |
subsection\<^marker>\<open>tag unimportant\<close> \<open>Topological Properties of Convex Sets and Functions\<close> |
63969
f4b4fba60b1d
HOL-Analysis: move Library/Convex to Convex_Euclidean_Space
hoelzl
parents:
63967
diff
changeset
|
18 |
|
40377 | 19 |
lemma aff_dim_cball: |
53347 | 20 |
fixes a :: "'n::euclidean_space" |
21 |
assumes "e > 0" |
|
22 |
shows "aff_dim (cball a e) = int (DIM('n))" |
|
23 |
proof - |
|
24 |
have "(\<lambda>x. a + x) ` (cball 0 e) \<subseteq> cball a e" |
|
25 |
unfolding cball_def dist_norm by auto |
|
26 |
then have "aff_dim (cball (0 :: 'n::euclidean_space) e) \<le> aff_dim (cball a e)" |
|
27 |
using aff_dim_translation_eq[of a "cball 0 e"] |
|
67399 | 28 |
aff_dim_subset[of "(+) a ` cball 0 e" "cball a e"] |
53347 | 29 |
by auto |
30 |
moreover have "aff_dim (cball (0 :: 'n::euclidean_space) e) = int (DIM('n))" |
|
31 |
using hull_inc[of "(0 :: 'n::euclidean_space)" "cball 0 e"] |
|
32 |
centre_in_cball[of "(0 :: 'n::euclidean_space)"] assms |
|
33 |
by (simp add: dim_cball[of e] aff_dim_zero[of "cball 0 e"]) |
|
34 |
ultimately show ?thesis |
|
63007
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
35 |
using aff_dim_le_DIM[of "cball a e"] by auto |
40377 | 36 |
qed |
37 |
||
38 |
lemma aff_dim_open: |
|
53347 | 39 |
fixes S :: "'n::euclidean_space set" |
40 |
assumes "open S" |
|
41 |
and "S \<noteq> {}" |
|
42 |
shows "aff_dim S = int (DIM('n))" |
|
43 |
proof - |
|
44 |
obtain x where "x \<in> S" |
|
45 |
using assms by auto |
|
46 |
then obtain e where e: "e > 0" "cball x e \<subseteq> S" |
|
47 |
using open_contains_cball[of S] assms by auto |
|
48 |
then have "aff_dim (cball x e) \<le> aff_dim S" |
|
49 |
using aff_dim_subset by auto |
|
50 |
with e show ?thesis |
|
63007
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
51 |
using aff_dim_cball[of e x] aff_dim_le_DIM[of S] by auto |
40377 | 52 |
qed |
53 |
||
54 |
lemma low_dim_interior: |
|
53347 | 55 |
fixes S :: "'n::euclidean_space set" |
56 |
assumes "\<not> aff_dim S = int (DIM('n))" |
|
57 |
shows "interior S = {}" |
|
58 |
proof - |
|
59 |
have "aff_dim(interior S) \<le> aff_dim S" |
|
60 |
using interior_subset aff_dim_subset[of "interior S" S] by auto |
|
61 |
then show ?thesis |
|
63007
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
62 |
using aff_dim_open[of "interior S"] aff_dim_le_DIM[of S] assms by auto |
40377 | 63 |
qed |
64 |
||
60307
75e1aa7a450e
Convex hulls: theorems about interior, etc. And a few simple lemmas.
paulson <lp15@cam.ac.uk>
parents:
60303
diff
changeset
|
65 |
corollary empty_interior_lowdim: |
75e1aa7a450e
Convex hulls: theorems about interior, etc. And a few simple lemmas.
paulson <lp15@cam.ac.uk>
parents:
60303
diff
changeset
|
66 |
fixes S :: "'n::euclidean_space set" |
75e1aa7a450e
Convex hulls: theorems about interior, etc. And a few simple lemmas.
paulson <lp15@cam.ac.uk>
parents:
60303
diff
changeset
|
67 |
shows "dim S < DIM ('n) \<Longrightarrow> interior S = {}" |
63007
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
68 |
by (metis low_dim_interior affine_hull_UNIV dim_affine_hull less_not_refl dim_UNIV) |
60307
75e1aa7a450e
Convex hulls: theorems about interior, etc. And a few simple lemmas.
paulson <lp15@cam.ac.uk>
parents:
60303
diff
changeset
|
69 |
|
63016
3590590699b1
numerous theorems about affine hulls, hyperplanes, etc.
paulson <lp15@cam.ac.uk>
parents:
63007
diff
changeset
|
70 |
corollary aff_dim_nonempty_interior: |
3590590699b1
numerous theorems about affine hulls, hyperplanes, etc.
paulson <lp15@cam.ac.uk>
parents:
63007
diff
changeset
|
71 |
fixes S :: "'a::euclidean_space set" |
3590590699b1
numerous theorems about affine hulls, hyperplanes, etc.
paulson <lp15@cam.ac.uk>
parents:
63007
diff
changeset
|
72 |
shows "interior S \<noteq> {} \<Longrightarrow> aff_dim S = DIM('a)" |
3590590699b1
numerous theorems about affine hulls, hyperplanes, etc.
paulson <lp15@cam.ac.uk>
parents:
63007
diff
changeset
|
73 |
by (metis low_dim_interior) |
3590590699b1
numerous theorems about affine hulls, hyperplanes, etc.
paulson <lp15@cam.ac.uk>
parents:
63007
diff
changeset
|
74 |
|
63881
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
75 |
|
60420 | 76 |
subsection \<open>Relative interior of a set\<close> |
40377 | 77 |
|
70136 | 78 |
definition\<^marker>\<open>tag important\<close> "rel_interior S = |
69922
4a9167f377b0
new material about topology, etc.; also fixes for yesterday's
paulson <lp15@cam.ac.uk>
parents:
69710
diff
changeset
|
79 |
{x. \<exists>T. openin (top_of_set (affine hull S)) T \<and> x \<in> T \<and> T \<subseteq> S}" |
53347 | 80 |
|
64287 | 81 |
lemma rel_interior_mono: |
82 |
"\<lbrakk>S \<subseteq> T; affine hull S = affine hull T\<rbrakk> |
|
83 |
\<Longrightarrow> (rel_interior S) \<subseteq> (rel_interior T)" |
|
84 |
by (auto simp: rel_interior_def) |
|
85 |
||
86 |
lemma rel_interior_maximal: |
|
69922
4a9167f377b0
new material about topology, etc.; also fixes for yesterday's
paulson <lp15@cam.ac.uk>
parents:
69710
diff
changeset
|
87 |
"\<lbrakk>T \<subseteq> S; openin(top_of_set (affine hull S)) T\<rbrakk> \<Longrightarrow> T \<subseteq> (rel_interior S)" |
64287 | 88 |
by (auto simp: rel_interior_def) |
89 |
||
53347 | 90 |
lemma rel_interior: |
91 |
"rel_interior S = {x \<in> S. \<exists>T. open T \<and> x \<in> T \<and> T \<inter> affine hull S \<subseteq> S}" |
|
92 |
unfolding rel_interior_def[of S] openin_open[of "affine hull S"] |
|
93 |
apply auto |
|
94 |
proof - |
|
95 |
fix x T |
|
96 |
assume *: "x \<in> S" "open T" "x \<in> T" "T \<inter> affine hull S \<subseteq> S" |
|
97 |
then have **: "x \<in> T \<inter> affine hull S" |
|
98 |
using hull_inc by auto |
|
54465 | 99 |
show "\<exists>Tb. (\<exists>Ta. open Ta \<and> Tb = affine hull S \<inter> Ta) \<and> x \<in> Tb \<and> Tb \<subseteq> S" |
100 |
apply (rule_tac x = "T \<inter> (affine hull S)" in exI) |
|
53347 | 101 |
using * ** |
102 |
apply auto |
|
103 |
done |
|
104 |
qed |
|
105 |
||
106 |
lemma mem_rel_interior: "x \<in> rel_interior S \<longleftrightarrow> (\<exists>T. open T \<and> x \<in> T \<inter> S \<and> T \<inter> affine hull S \<subseteq> S)" |
|
68031 | 107 |
by (auto simp: rel_interior) |
53347 | 108 |
|
109 |
lemma mem_rel_interior_ball: |
|
110 |
"x \<in> rel_interior S \<longleftrightarrow> x \<in> S \<and> (\<exists>e. e > 0 \<and> ball x e \<inter> affine hull S \<subseteq> S)" |
|
40377 | 111 |
apply (simp add: rel_interior, safe) |
68031 | 112 |
apply (force simp: open_contains_ball) |
113 |
apply (rule_tac x = "ball x e" in exI, simp) |
|
40377 | 114 |
done |
115 |
||
49531 | 116 |
lemma rel_interior_ball: |
53347 | 117 |
"rel_interior S = {x \<in> S. \<exists>e. e > 0 \<and> ball x e \<inter> affine hull S \<subseteq> S}" |
118 |
using mem_rel_interior_ball [of _ S] by auto |
|
119 |
||
120 |
lemma mem_rel_interior_cball: |
|
121 |
"x \<in> rel_interior S \<longleftrightarrow> x \<in> S \<and> (\<exists>e. e > 0 \<and> cball x e \<inter> affine hull S \<subseteq> S)" |
|
49531 | 122 |
apply (simp add: rel_interior, safe) |
68031 | 123 |
apply (force simp: open_contains_cball) |
53347 | 124 |
apply (rule_tac x = "ball x e" in exI) |
68031 | 125 |
apply (simp add: subset_trans [OF ball_subset_cball], auto) |
40377 | 126 |
done |
127 |
||
53347 | 128 |
lemma rel_interior_cball: |
129 |
"rel_interior S = {x \<in> S. \<exists>e. e > 0 \<and> cball x e \<inter> affine hull S \<subseteq> S}" |
|
130 |
using mem_rel_interior_cball [of _ S] by auto |
|
40377 | 131 |
|
60303 | 132 |
lemma rel_interior_empty [simp]: "rel_interior {} = {}" |
68031 | 133 |
by (auto simp: rel_interior_def) |
40377 | 134 |
|
60303 | 135 |
lemma affine_hull_sing [simp]: "affine hull {a :: 'n::euclidean_space} = {a}" |
53347 | 136 |
by (metis affine_hull_eq affine_sing) |
40377 | 137 |
|
63114
27afe7af7379
Lots of new material for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
63092
diff
changeset
|
138 |
lemma rel_interior_sing [simp]: |
27afe7af7379
Lots of new material for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
63092
diff
changeset
|
139 |
fixes a :: "'n::euclidean_space" shows "rel_interior {a} = {a}" |
27afe7af7379
Lots of new material for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
63092
diff
changeset
|
140 |
apply (auto simp: rel_interior_ball) |
68031 | 141 |
apply (rule_tac x=1 in exI, force) |
53347 | 142 |
done |
40377 | 143 |
|
144 |
lemma subset_rel_interior: |
|
53347 | 145 |
fixes S T :: "'n::euclidean_space set" |
146 |
assumes "S \<subseteq> T" |
|
147 |
and "affine hull S = affine hull T" |
|
148 |
shows "rel_interior S \<subseteq> rel_interior T" |
|
68031 | 149 |
using assms by (auto simp: rel_interior_def) |
49531 | 150 |
|
53347 | 151 |
lemma rel_interior_subset: "rel_interior S \<subseteq> S" |
68031 | 152 |
by (auto simp: rel_interior_def) |
53347 | 153 |
|
154 |
lemma rel_interior_subset_closure: "rel_interior S \<subseteq> closure S" |
|
68031 | 155 |
using rel_interior_subset by (auto simp: closure_def) |
53347 | 156 |
|
157 |
lemma interior_subset_rel_interior: "interior S \<subseteq> rel_interior S" |
|
68031 | 158 |
by (auto simp: rel_interior interior_def) |
40377 | 159 |
|
160 |
lemma interior_rel_interior: |
|
53347 | 161 |
fixes S :: "'n::euclidean_space set" |
162 |
assumes "aff_dim S = int(DIM('n))" |
|
163 |
shows "rel_interior S = interior S" |
|
40377 | 164 |
proof - |
53347 | 165 |
have "affine hull S = UNIV" |
63007
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
166 |
using assms affine_hull_UNIV[of S] by auto |
53347 | 167 |
then show ?thesis |
168 |
unfolding rel_interior interior_def by auto |
|
40377 | 169 |
qed |
170 |
||
60303 | 171 |
lemma rel_interior_interior: |
172 |
fixes S :: "'n::euclidean_space set" |
|
173 |
assumes "affine hull S = UNIV" |
|
174 |
shows "rel_interior S = interior S" |
|
175 |
using assms unfolding rel_interior interior_def by auto |
|
176 |
||
40377 | 177 |
lemma rel_interior_open: |
53347 | 178 |
fixes S :: "'n::euclidean_space set" |
179 |
assumes "open S" |
|
180 |
shows "rel_interior S = S" |
|
181 |
by (metis assms interior_eq interior_subset_rel_interior rel_interior_subset set_eq_subset) |
|
40377 | 182 |
|
183 |
lemma interior_rel_interior_gen: |
|
53347 | 184 |
fixes S :: "'n::euclidean_space set" |
185 |
shows "interior S = (if aff_dim S = int(DIM('n)) then rel_interior S else {})" |
|
186 |
by (metis interior_rel_interior low_dim_interior) |
|
40377 | 187 |
|
63007
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
188 |
lemma rel_interior_nonempty_interior: |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
189 |
fixes S :: "'n::euclidean_space set" |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
190 |
shows "interior S \<noteq> {} \<Longrightarrow> rel_interior S = interior S" |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
191 |
by (metis interior_rel_interior_gen) |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
192 |
|
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
193 |
lemma affine_hull_nonempty_interior: |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
194 |
fixes S :: "'n::euclidean_space set" |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
195 |
shows "interior S \<noteq> {} \<Longrightarrow> affine hull S = UNIV" |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
196 |
by (metis affine_hull_UNIV interior_rel_interior_gen) |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
197 |
|
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
198 |
lemma rel_interior_affine_hull [simp]: |
53347 | 199 |
fixes S :: "'n::euclidean_space set" |
200 |
shows "rel_interior (affine hull S) = affine hull S" |
|
201 |
proof - |
|
202 |
have *: "rel_interior (affine hull S) \<subseteq> affine hull S" |
|
203 |
using rel_interior_subset by auto |
|
204 |
{ |
|
205 |
fix x |
|
206 |
assume x: "x \<in> affine hull S" |
|
63040 | 207 |
define e :: real where "e = 1" |
53347 | 208 |
then have "e > 0" "ball x e \<inter> affine hull (affine hull S) \<subseteq> affine hull S" |
209 |
using hull_hull[of _ S] by auto |
|
210 |
then have "x \<in> rel_interior (affine hull S)" |
|
211 |
using x rel_interior_ball[of "affine hull S"] by auto |
|
212 |
} |
|
213 |
then show ?thesis using * by auto |
|
40377 | 214 |
qed |
215 |
||
63007
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
216 |
lemma rel_interior_UNIV [simp]: "rel_interior (UNIV :: ('n::euclidean_space) set) = UNIV" |
53347 | 217 |
by (metis open_UNIV rel_interior_open) |
40377 | 218 |
|
219 |
lemma rel_interior_convex_shrink: |
|
53347 | 220 |
fixes S :: "'a::euclidean_space set" |
221 |
assumes "convex S" |
|
222 |
and "c \<in> rel_interior S" |
|
223 |
and "x \<in> S" |
|
224 |
and "0 < e" |
|
225 |
and "e \<le> 1" |
|
226 |
shows "x - e *\<^sub>R (x - c) \<in> rel_interior S" |
|
227 |
proof - |
|
54465 | 228 |
obtain d where "d > 0" and d: "ball c d \<inter> affine hull S \<subseteq> S" |
53347 | 229 |
using assms(2) unfolding mem_rel_interior_ball by auto |
230 |
{ |
|
231 |
fix y |
|
232 |
assume as: "dist (x - e *\<^sub>R (x - c)) y < e * d" "y \<in> affine hull S" |
|
233 |
have *: "y = (1 - (1 - e)) *\<^sub>R ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) + (1 - e) *\<^sub>R x" |
|
68031 | 234 |
using \<open>e > 0\<close> by (auto simp: scaleR_left_diff_distrib scaleR_right_diff_distrib) |
53347 | 235 |
have "x \<in> affine hull S" |
236 |
using assms hull_subset[of S] by auto |
|
49531 | 237 |
moreover have "1 / e + - ((1 - e) / e) = 1" |
60420 | 238 |
using \<open>e > 0\<close> left_diff_distrib[of "1" "(1-e)" "1/e"] by auto |
53347 | 239 |
ultimately have **: "(1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x \<in> affine hull S" |
240 |
using as affine_affine_hull[of S] mem_affine[of "affine hull S" y x "(1 / e)" "-((1 - e) / e)"] |
|
241 |
by (simp add: algebra_simps) |
|
61945 | 242 |
have "dist c ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) = \<bar>1/e\<bar> * norm (e *\<^sub>R c - y + (1 - e) *\<^sub>R x)" |
53347 | 243 |
unfolding dist_norm norm_scaleR[symmetric] |
244 |
apply (rule arg_cong[where f=norm]) |
|
60420 | 245 |
using \<open>e > 0\<close> |
68031 | 246 |
apply (auto simp: euclidean_eq_iff[where 'a='a] field_simps inner_simps) |
53347 | 247 |
done |
61945 | 248 |
also have "\<dots> = \<bar>1/e\<bar> * norm (x - e *\<^sub>R (x - c) - y)" |
53347 | 249 |
by (auto intro!:arg_cong[where f=norm] simp add: algebra_simps) |
250 |
also have "\<dots> < d" |
|
60420 | 251 |
using as[unfolded dist_norm] and \<open>e > 0\<close> |
68031 | 252 |
by (auto simp:pos_divide_less_eq[OF \<open>e > 0\<close>] mult.commute) |
53347 | 253 |
finally have "y \<in> S" |
254 |
apply (subst *) |
|
255 |
apply (rule assms(1)[unfolded convex_alt,rule_format]) |
|
68058 | 256 |
apply (rule d[THEN subsetD]) |
53347 | 257 |
unfolding mem_ball |
258 |
using assms(3-5) ** |
|
259 |
apply auto |
|
260 |
done |
|
261 |
} |
|
262 |
then have "ball (x - e *\<^sub>R (x - c)) (e*d) \<inter> affine hull S \<subseteq> S" |
|
263 |
by auto |
|
264 |
moreover have "e * d > 0" |
|
60420 | 265 |
using \<open>e > 0\<close> \<open>d > 0\<close> by simp |
53347 | 266 |
moreover have c: "c \<in> S" |
267 |
using assms rel_interior_subset by auto |
|
268 |
moreover from c have "x - e *\<^sub>R (x - c) \<in> S" |
|
61426
d53db136e8fd
new material on path_component_sets, inside, outside, etc. And more default simprules
paulson <lp15@cam.ac.uk>
parents:
61222
diff
changeset
|
269 |
using convexD_alt[of S x c e] |
53347 | 270 |
apply (simp add: algebra_simps) |
271 |
using assms |
|
272 |
apply auto |
|
273 |
done |
|
274 |
ultimately show ?thesis |
|
60420 | 275 |
using mem_rel_interior_ball[of "x - e *\<^sub>R (x - c)" S] \<open>e > 0\<close> by auto |
40377 | 276 |
qed |
277 |
||
69710
61372780515b
some renamings and a bit of new material
paulson <lp15@cam.ac.uk>
parents:
69619
diff
changeset
|
278 |
lemma interior_real_atLeast [simp]: |
53347 | 279 |
fixes a :: real |
280 |
shows "interior {a..} = {a<..}" |
|
281 |
proof - |
|
282 |
{ |
|
283 |
fix y |
|
284 |
assume "a < y" |
|
285 |
then have "y \<in> interior {a..}" |
|
286 |
apply (simp add: mem_interior) |
|
287 |
apply (rule_tac x="(y-a)" in exI) |
|
68031 | 288 |
apply (auto simp: dist_norm) |
53347 | 289 |
done |
290 |
} |
|
291 |
moreover |
|
292 |
{ |
|
293 |
fix y |
|
294 |
assume "y \<in> interior {a..}" |
|
295 |
then obtain e where e: "e > 0" "cball y e \<subseteq> {a..}" |
|
296 |
using mem_interior_cball[of y "{a..}"] by auto |
|
297 |
moreover from e have "y - e \<in> cball y e" |
|
68031 | 298 |
by (auto simp: cball_def dist_norm) |
60307
75e1aa7a450e
Convex hulls: theorems about interior, etc. And a few simple lemmas.
paulson <lp15@cam.ac.uk>
parents:
60303
diff
changeset
|
299 |
ultimately have "a \<le> y - e" by blast |
53347 | 300 |
then have "a < y" using e by auto |
301 |
} |
|
302 |
ultimately show ?thesis by auto |
|
40377 | 303 |
qed |
304 |
||
61880
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
305 |
lemma continuous_ge_on_Ioo: |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
306 |
assumes "continuous_on {c..d} g" "\<And>x. x \<in> {c<..<d} \<Longrightarrow> g x \<ge> a" "c < d" "x \<in> {c..d}" |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
307 |
shows "g (x::real) \<ge> (a::real)" |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
308 |
proof- |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
309 |
from assms(3) have "{c..d} = closure {c<..<d}" by (rule closure_greaterThanLessThan[symmetric]) |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
310 |
also from assms(2) have "{c<..<d} \<subseteq> (g -` {a..} \<inter> {c..d})" by auto |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
311 |
hence "closure {c<..<d} \<subseteq> closure (g -` {a..} \<inter> {c..d})" by (rule closure_mono) |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
312 |
also from assms(1) have "closed (g -` {a..} \<inter> {c..d})" |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
313 |
by (auto simp: continuous_on_closed_vimage) |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
314 |
hence "closure (g -` {a..} \<inter> {c..d}) = g -` {a..} \<inter> {c..d}" by simp |
62087
44841d07ef1d
revisions to limits and derivatives, plus new lemmas
paulson
parents:
61952
diff
changeset
|
315 |
finally show ?thesis using \<open>x \<in> {c..d}\<close> by auto |
44841d07ef1d
revisions to limits and derivatives, plus new lemmas
paulson
parents:
61952
diff
changeset
|
316 |
qed |
61880
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
317 |
|
69710
61372780515b
some renamings and a bit of new material
paulson <lp15@cam.ac.uk>
parents:
69619
diff
changeset
|
318 |
lemma interior_real_atMost [simp]: |
61880
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
319 |
fixes a :: real |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
320 |
shows "interior {..a} = {..<a}" |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
321 |
proof - |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
322 |
{ |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
323 |
fix y |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
324 |
assume "a > y" |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
325 |
then have "y \<in> interior {..a}" |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
326 |
apply (simp add: mem_interior) |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
327 |
apply (rule_tac x="(a-y)" in exI) |
68031 | 328 |
apply (auto simp: dist_norm) |
61880
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
329 |
done |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
330 |
} |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
331 |
moreover |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
332 |
{ |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
333 |
fix y |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
334 |
assume "y \<in> interior {..a}" |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
335 |
then obtain e where e: "e > 0" "cball y e \<subseteq> {..a}" |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
336 |
using mem_interior_cball[of y "{..a}"] by auto |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
337 |
moreover from e have "y + e \<in> cball y e" |
68031 | 338 |
by (auto simp: cball_def dist_norm) |
61880
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
339 |
ultimately have "a \<ge> y + e" by auto |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
340 |
then have "a > y" using e by auto |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
341 |
} |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
342 |
ultimately show ?thesis by auto |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
343 |
qed |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
344 |
|
64773
223b2ebdda79
Many new theorems, and more tidying
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
345 |
lemma interior_atLeastAtMost_real [simp]: "interior {a..b} = {a<..<b :: real}" |
61880
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
346 |
proof- |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
347 |
have "{a..b} = {a..} \<inter> {..b}" by auto |
68031 | 348 |
also have "interior \<dots> = {a<..} \<inter> {..<b}" |
69710
61372780515b
some renamings and a bit of new material
paulson <lp15@cam.ac.uk>
parents:
69619
diff
changeset
|
349 |
by (simp add: interior_real_atLeast interior_real_atMost) |
68031 | 350 |
also have "\<dots> = {a<..<b}" by auto |
61880
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
351 |
finally show ?thesis . |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
352 |
qed |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
353 |
|
66793
deabce3ccf1f
new material about connectedness, etc.
paulson <lp15@cam.ac.uk>
parents:
66641
diff
changeset
|
354 |
lemma interior_atLeastLessThan [simp]: |
deabce3ccf1f
new material about connectedness, etc.
paulson <lp15@cam.ac.uk>
parents:
66641
diff
changeset
|
355 |
fixes a::real shows "interior {a..<b} = {a<..<b}" |
69710
61372780515b
some renamings and a bit of new material
paulson <lp15@cam.ac.uk>
parents:
69619
diff
changeset
|
356 |
by (metis atLeastLessThan_def greaterThanLessThan_def interior_atLeastAtMost_real interior_Int interior_interior interior_real_atLeast) |
66793
deabce3ccf1f
new material about connectedness, etc.
paulson <lp15@cam.ac.uk>
parents:
66641
diff
changeset
|
357 |
|
deabce3ccf1f
new material about connectedness, etc.
paulson <lp15@cam.ac.uk>
parents:
66641
diff
changeset
|
358 |
lemma interior_lessThanAtMost [simp]: |
deabce3ccf1f
new material about connectedness, etc.
paulson <lp15@cam.ac.uk>
parents:
66641
diff
changeset
|
359 |
fixes a::real shows "interior {a<..b} = {a<..<b}" |
deabce3ccf1f
new material about connectedness, etc.
paulson <lp15@cam.ac.uk>
parents:
66641
diff
changeset
|
360 |
by (metis atLeastAtMost_def greaterThanAtMost_def interior_atLeastAtMost_real interior_Int |
69710
61372780515b
some renamings and a bit of new material
paulson <lp15@cam.ac.uk>
parents:
69619
diff
changeset
|
361 |
interior_interior interior_real_atLeast) |
66793
deabce3ccf1f
new material about connectedness, etc.
paulson <lp15@cam.ac.uk>
parents:
66641
diff
changeset
|
362 |
|
64773
223b2ebdda79
Many new theorems, and more tidying
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
363 |
lemma interior_greaterThanLessThan_real [simp]: "interior {a<..<b} = {a<..<b :: real}" |
223b2ebdda79
Many new theorems, and more tidying
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
364 |
by (metis interior_atLeastAtMost_real interior_interior) |
223b2ebdda79
Many new theorems, and more tidying
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
365 |
|
69710
61372780515b
some renamings and a bit of new material
paulson <lp15@cam.ac.uk>
parents:
69619
diff
changeset
|
366 |
lemma frontier_real_atMost [simp]: |
61880
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
367 |
fixes a :: real |
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
368 |
shows "frontier {..a} = {a}" |
69710
61372780515b
some renamings and a bit of new material
paulson <lp15@cam.ac.uk>
parents:
69619
diff
changeset
|
369 |
unfolding frontier_def by (auto simp: interior_real_atMost) |
61372780515b
some renamings and a bit of new material
paulson <lp15@cam.ac.uk>
parents:
69619
diff
changeset
|
370 |
|
61372780515b
some renamings and a bit of new material
paulson <lp15@cam.ac.uk>
parents:
69619
diff
changeset
|
371 |
lemma frontier_real_atLeast [simp]: "frontier {a..} = {a::real}" |
61372780515b
some renamings and a bit of new material
paulson <lp15@cam.ac.uk>
parents:
69619
diff
changeset
|
372 |
by (auto simp: frontier_def) |
61372780515b
some renamings and a bit of new material
paulson <lp15@cam.ac.uk>
parents:
69619
diff
changeset
|
373 |
|
61372780515b
some renamings and a bit of new material
paulson <lp15@cam.ac.uk>
parents:
69619
diff
changeset
|
374 |
lemma frontier_real_greaterThan [simp]: "frontier {a<..} = {a::real}" |
61372780515b
some renamings and a bit of new material
paulson <lp15@cam.ac.uk>
parents:
69619
diff
changeset
|
375 |
by (auto simp: interior_open frontier_def) |
61372780515b
some renamings and a bit of new material
paulson <lp15@cam.ac.uk>
parents:
69619
diff
changeset
|
376 |
|
61372780515b
some renamings and a bit of new material
paulson <lp15@cam.ac.uk>
parents:
69619
diff
changeset
|
377 |
lemma frontier_real_lessThan [simp]: "frontier {..<a} = {a::real}" |
61372780515b
some renamings and a bit of new material
paulson <lp15@cam.ac.uk>
parents:
69619
diff
changeset
|
378 |
by (auto simp: interior_open frontier_def) |
61880
ff4d33058566
moved some theorems from the CLT proof; reordered some theorems / notation
hoelzl
parents:
61848
diff
changeset
|
379 |
|
64773
223b2ebdda79
Many new theorems, and more tidying
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
380 |
lemma rel_interior_real_box [simp]: |
53347 | 381 |
fixes a b :: real |
382 |
assumes "a < b" |
|
56188 | 383 |
shows "rel_interior {a .. b} = {a <..< b}" |
53347 | 384 |
proof - |
54775
2d3df8633dad
prefer box over greaterThanLessThan on euclidean_space
immler
parents:
54465
diff
changeset
|
385 |
have "box a b \<noteq> {}" |
53347 | 386 |
using assms |
387 |
unfolding set_eq_iff |
|
56189
c4daa97ac57a
removed dependencies on theory Ordered_Euclidean_Space
immler
parents:
56188
diff
changeset
|
388 |
by (auto intro!: exI[of _ "(a + b) / 2"] simp: box_def) |
40377 | 389 |
then show ?thesis |
56188 | 390 |
using interior_rel_interior_gen[of "cbox a b", symmetric] |
62390 | 391 |
by (simp split: if_split_asm del: box_real add: box_real[symmetric] interior_cbox) |
40377 | 392 |
qed |
393 |
||
64773
223b2ebdda79
Many new theorems, and more tidying
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
394 |
lemma rel_interior_real_semiline [simp]: |
53347 | 395 |
fixes a :: real |
396 |
shows "rel_interior {a..} = {a<..}" |
|
397 |
proof - |
|
398 |
have *: "{a<..} \<noteq> {}" |
|
399 |
unfolding set_eq_iff by (auto intro!: exI[of _ "a + 1"]) |
|
69710
61372780515b
some renamings and a bit of new material
paulson <lp15@cam.ac.uk>
parents:
69619
diff
changeset
|
400 |
then show ?thesis using interior_real_atLeast interior_rel_interior_gen[of "{a..}"] |
62390 | 401 |
by (auto split: if_split_asm) |
40377 | 402 |
qed |
403 |
||
60420 | 404 |
subsubsection \<open>Relative open sets\<close> |
40377 | 405 |
|
70136 | 406 |
definition\<^marker>\<open>tag important\<close> "rel_open S \<longleftrightarrow> rel_interior S = S" |
53347 | 407 |
|
69922
4a9167f377b0
new material about topology, etc.; also fixes for yesterday's
paulson <lp15@cam.ac.uk>
parents:
69710
diff
changeset
|
408 |
lemma rel_open: "rel_open S \<longleftrightarrow> openin (top_of_set (affine hull S)) S" |
53347 | 409 |
unfolding rel_open_def rel_interior_def |
410 |
apply auto |
|
69922
4a9167f377b0
new material about topology, etc.; also fixes for yesterday's
paulson <lp15@cam.ac.uk>
parents:
69710
diff
changeset
|
411 |
using openin_subopen[of "top_of_set (affine hull S)" S] |
53347 | 412 |
apply auto |
413 |
done |
|
414 |
||
69922
4a9167f377b0
new material about topology, etc.; also fixes for yesterday's
paulson <lp15@cam.ac.uk>
parents:
69710
diff
changeset
|
415 |
lemma openin_rel_interior: "openin (top_of_set (affine hull S)) (rel_interior S)" |
40377 | 416 |
apply (simp add: rel_interior_def) |
68031 | 417 |
apply (subst openin_subopen, blast) |
53347 | 418 |
done |
40377 | 419 |
|
63469
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
420 |
lemma openin_set_rel_interior: |
69922
4a9167f377b0
new material about topology, etc.; also fixes for yesterday's
paulson <lp15@cam.ac.uk>
parents:
69710
diff
changeset
|
421 |
"openin (top_of_set S) (rel_interior S)" |
63469
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
422 |
by (rule openin_subset_trans [OF openin_rel_interior rel_interior_subset hull_subset]) |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
423 |
|
49531 | 424 |
lemma affine_rel_open: |
53347 | 425 |
fixes S :: "'n::euclidean_space set" |
426 |
assumes "affine S" |
|
427 |
shows "rel_open S" |
|
428 |
unfolding rel_open_def |
|
63007
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
429 |
using assms rel_interior_affine_hull[of S] affine_hull_eq[of S] |
53347 | 430 |
by metis |
40377 | 431 |
|
49531 | 432 |
lemma affine_closed: |
53347 | 433 |
fixes S :: "'n::euclidean_space set" |
434 |
assumes "affine S" |
|
435 |
shows "closed S" |
|
436 |
proof - |
|
437 |
{ |
|
438 |
assume "S \<noteq> {}" |
|
439 |
then obtain L where L: "subspace L" "affine_parallel S L" |
|
440 |
using assms affine_parallel_subspace[of S] by auto |
|
67399 | 441 |
then obtain a where a: "S = ((+) a ` L)" |
53347 | 442 |
using affine_parallel_def[of L S] affine_parallel_commut by auto |
443 |
from L have "closed L" using closed_subspace by auto |
|
444 |
then have "closed S" |
|
445 |
using closed_translation a by auto |
|
446 |
} |
|
447 |
then show ?thesis by auto |
|
40377 | 448 |
qed |
449 |
||
450 |
lemma closure_affine_hull: |
|
53347 | 451 |
fixes S :: "'n::euclidean_space set" |
452 |
shows "closure S \<subseteq> affine hull S" |
|
44524 | 453 |
by (intro closure_minimal hull_subset affine_closed affine_affine_hull) |
40377 | 454 |
|
71225 | 455 |
lemma closed_affine_hull [iff]: |
456 |
fixes S :: "'n::euclidean_space set" |
|
457 |
shows "closed (affine hull S)" |
|
458 |
by (metis affine_affine_hull affine_closed) |
|
459 |
||
62948
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
460 |
lemma closure_same_affine_hull [simp]: |
53347 | 461 |
fixes S :: "'n::euclidean_space set" |
40377 | 462 |
shows "affine hull (closure S) = affine hull S" |
53347 | 463 |
proof - |
464 |
have "affine hull (closure S) \<subseteq> affine hull S" |
|
465 |
using hull_mono[of "closure S" "affine hull S" "affine"] |
|
466 |
closure_affine_hull[of S] hull_hull[of "affine" S] |
|
467 |
by auto |
|
468 |
moreover have "affine hull (closure S) \<supseteq> affine hull S" |
|
469 |
using hull_mono[of "S" "closure S" "affine"] closure_subset by auto |
|
470 |
ultimately show ?thesis by auto |
|
49531 | 471 |
qed |
472 |
||
63114
27afe7af7379
Lots of new material for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
63092
diff
changeset
|
473 |
lemma closure_aff_dim [simp]: |
53347 | 474 |
fixes S :: "'n::euclidean_space set" |
40377 | 475 |
shows "aff_dim (closure S) = aff_dim S" |
53347 | 476 |
proof - |
477 |
have "aff_dim S \<le> aff_dim (closure S)" |
|
478 |
using aff_dim_subset closure_subset by auto |
|
479 |
moreover have "aff_dim (closure S) \<le> aff_dim (affine hull S)" |
|
63075
60a42a4166af
lemmas about dimension, hyperplanes, span, etc.
paulson <lp15@cam.ac.uk>
parents:
63072
diff
changeset
|
480 |
using aff_dim_subset closure_affine_hull by blast |
53347 | 481 |
moreover have "aff_dim (affine hull S) = aff_dim S" |
482 |
using aff_dim_affine_hull by auto |
|
483 |
ultimately show ?thesis by auto |
|
40377 | 484 |
qed |
485 |
||
486 |
lemma rel_interior_closure_convex_shrink: |
|
53347 | 487 |
fixes S :: "_::euclidean_space set" |
488 |
assumes "convex S" |
|
489 |
and "c \<in> rel_interior S" |
|
490 |
and "x \<in> closure S" |
|
491 |
and "e > 0" |
|
492 |
and "e \<le> 1" |
|
493 |
shows "x - e *\<^sub>R (x - c) \<in> rel_interior S" |
|
494 |
proof - |
|
495 |
obtain d where "d > 0" and d: "ball c d \<inter> affine hull S \<subseteq> S" |
|
496 |
using assms(2) unfolding mem_rel_interior_ball by auto |
|
497 |
have "\<exists>y \<in> S. norm (y - x) * (1 - e) < e * d" |
|
498 |
proof (cases "x \<in> S") |
|
499 |
case True |
|
60420 | 500 |
then show ?thesis using \<open>e > 0\<close> \<open>d > 0\<close> |
68031 | 501 |
apply (rule_tac bexI[where x=x], auto) |
53347 | 502 |
done |
503 |
next |
|
504 |
case False |
|
505 |
then have x: "x islimpt S" |
|
506 |
using assms(3)[unfolded closure_def] by auto |
|
507 |
show ?thesis |
|
508 |
proof (cases "e = 1") |
|
509 |
case True |
|
510 |
obtain y where "y \<in> S" "y \<noteq> x" "dist y x < 1" |
|
40377 | 511 |
using x[unfolded islimpt_approachable,THEN spec[where x=1]] by auto |
53347 | 512 |
then show ?thesis |
513 |
apply (rule_tac x=y in bexI) |
|
514 |
unfolding True |
|
60420 | 515 |
using \<open>d > 0\<close> |
53347 | 516 |
apply auto |
517 |
done |
|
518 |
next |
|
519 |
case False |
|
520 |
then have "0 < e * d / (1 - e)" and *: "1 - e > 0" |
|
68031 | 521 |
using \<open>e \<le> 1\<close> \<open>e > 0\<close> \<open>d > 0\<close> by auto |
53347 | 522 |
then obtain y where "y \<in> S" "y \<noteq> x" "dist y x < e * d / (1 - e)" |
40377 | 523 |
using x[unfolded islimpt_approachable,THEN spec[where x="e*d / (1 - e)"]] by auto |
53347 | 524 |
then show ?thesis |
525 |
apply (rule_tac x=y in bexI) |
|
526 |
unfolding dist_norm |
|
527 |
using pos_less_divide_eq[OF *] |
|
528 |
apply auto |
|
529 |
done |
|
530 |
qed |
|
531 |
qed |
|
532 |
then obtain y where "y \<in> S" and y: "norm (y - x) * (1 - e) < e * d" |
|
533 |
by auto |
|
63040 | 534 |
define z where "z = c + ((1 - e) / e) *\<^sub>R (x - y)" |
53347 | 535 |
have *: "x - e *\<^sub>R (x - c) = y - e *\<^sub>R (y - z)" |
60420 | 536 |
unfolding z_def using \<open>e > 0\<close> |
68031 | 537 |
by (auto simp: scaleR_right_diff_distrib scaleR_right_distrib scaleR_left_diff_distrib) |
53347 | 538 |
have zball: "z \<in> ball c d" |
539 |
using mem_ball z_def dist_norm[of c] |
|
540 |
using y and assms(4,5) |
|
70802
160eaf566bcb
formally augmented corresponding rules for field_simps
haftmann
parents:
70136
diff
changeset
|
541 |
by (simp add: norm_minus_commute) (simp add: field_simps) |
53347 | 542 |
have "x \<in> affine hull S" |
543 |
using closure_affine_hull assms by auto |
|
544 |
moreover have "y \<in> affine hull S" |
|
60420 | 545 |
using \<open>y \<in> S\<close> hull_subset[of S] by auto |
53347 | 546 |
moreover have "c \<in> affine hull S" |
547 |
using assms rel_interior_subset hull_subset[of S] by auto |
|
548 |
ultimately have "z \<in> affine hull S" |
|
49531 | 549 |
using z_def affine_affine_hull[of S] |
53347 | 550 |
mem_affine_3_minus [of "affine hull S" c x y "(1 - e) / e"] |
551 |
assms |
|
70802
160eaf566bcb
formally augmented corresponding rules for field_simps
haftmann
parents:
70136
diff
changeset
|
552 |
by simp |
53347 | 553 |
then have "z \<in> S" using d zball by auto |
554 |
obtain d1 where "d1 > 0" and d1: "ball z d1 \<le> ball c d" |
|
40377 | 555 |
using zball open_ball[of c d] openE[of "ball c d" z] by auto |
53347 | 556 |
then have "ball z d1 \<inter> affine hull S \<subseteq> ball c d \<inter> affine hull S" |
557 |
by auto |
|
558 |
then have "ball z d1 \<inter> affine hull S \<subseteq> S" |
|
559 |
using d by auto |
|
560 |
then have "z \<in> rel_interior S" |
|
60420 | 561 |
using mem_rel_interior_ball using \<open>d1 > 0\<close> \<open>z \<in> S\<close> by auto |
53347 | 562 |
then have "y - e *\<^sub>R (y - z) \<in> rel_interior S" |
60420 | 563 |
using rel_interior_convex_shrink[of S z y e] assms \<open>y \<in> S\<close> by auto |
53347 | 564 |
then show ?thesis using * by auto |
565 |
qed |
|
566 |
||
62620
d21dab28b3f9
New results about paths, segments, etc. The notion of simply_connected.
paulson <lp15@cam.ac.uk>
parents:
62618
diff
changeset
|
567 |
lemma rel_interior_eq: |
69922
4a9167f377b0
new material about topology, etc.; also fixes for yesterday's
paulson <lp15@cam.ac.uk>
parents:
69710
diff
changeset
|
568 |
"rel_interior s = s \<longleftrightarrow> openin(top_of_set (affine hull s)) s" |
62620
d21dab28b3f9
New results about paths, segments, etc. The notion of simply_connected.
paulson <lp15@cam.ac.uk>
parents:
62618
diff
changeset
|
569 |
using rel_open rel_open_def by blast |
d21dab28b3f9
New results about paths, segments, etc. The notion of simply_connected.
paulson <lp15@cam.ac.uk>
parents:
62618
diff
changeset
|
570 |
|
d21dab28b3f9
New results about paths, segments, etc. The notion of simply_connected.
paulson <lp15@cam.ac.uk>
parents:
62618
diff
changeset
|
571 |
lemma rel_interior_openin: |
69922
4a9167f377b0
new material about topology, etc.; also fixes for yesterday's
paulson <lp15@cam.ac.uk>
parents:
69710
diff
changeset
|
572 |
"openin(top_of_set (affine hull s)) s \<Longrightarrow> rel_interior s = s" |
62620
d21dab28b3f9
New results about paths, segments, etc. The notion of simply_connected.
paulson <lp15@cam.ac.uk>
parents:
62618
diff
changeset
|
573 |
by (simp add: rel_interior_eq) |
d21dab28b3f9
New results about paths, segments, etc. The notion of simply_connected.
paulson <lp15@cam.ac.uk>
parents:
62618
diff
changeset
|
574 |
|
63469
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
575 |
lemma rel_interior_affine: |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
576 |
fixes S :: "'n::euclidean_space set" |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
577 |
shows "affine S \<Longrightarrow> rel_interior S = S" |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
578 |
using affine_rel_open rel_open_def by auto |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
579 |
|
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
580 |
lemma rel_interior_eq_closure: |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
581 |
fixes S :: "'n::euclidean_space set" |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
582 |
shows "rel_interior S = closure S \<longleftrightarrow> affine S" |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
583 |
proof (cases "S = {}") |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
584 |
case True |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
585 |
then show ?thesis |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
586 |
by auto |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
587 |
next |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
588 |
case False show ?thesis |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
589 |
proof |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
590 |
assume eq: "rel_interior S = closure S" |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
591 |
have "S = {} \<or> S = affine hull S" |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
592 |
apply (rule connected_clopen [THEN iffD1, rule_format]) |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
593 |
apply (simp add: affine_imp_convex convex_connected) |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
594 |
apply (rule conjI) |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
595 |
apply (metis eq closure_subset openin_rel_interior rel_interior_subset subset_antisym) |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
596 |
apply (metis closed_subset closure_subset_eq eq hull_subset rel_interior_subset) |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
597 |
done |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
598 |
with False have "affine hull S = S" |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
599 |
by auto |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
600 |
then show "affine S" |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
601 |
by (metis affine_hull_eq) |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
602 |
next |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
603 |
assume "affine S" |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
604 |
then show "rel_interior S = closure S" |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
605 |
by (simp add: rel_interior_affine affine_closed) |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
606 |
qed |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
607 |
qed |
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
608 |
|
40377 | 609 |
|
70136 | 610 |
subsubsection\<^marker>\<open>tag unimportant\<close>\<open>Relative interior preserves under linear transformations\<close> |
40377 | 611 |
|
612 |
lemma rel_interior_translation_aux: |
|
53347 | 613 |
fixes a :: "'n::euclidean_space" |
614 |
shows "((\<lambda>x. a + x) ` rel_interior S) \<subseteq> rel_interior ((\<lambda>x. a + x) ` S)" |
|
615 |
proof - |
|
616 |
{ |
|
617 |
fix x |
|
618 |
assume x: "x \<in> rel_interior S" |
|
619 |
then obtain T where "open T" "x \<in> T \<inter> S" "T \<inter> affine hull S \<subseteq> S" |
|
620 |
using mem_rel_interior[of x S] by auto |
|
621 |
then have "open ((\<lambda>x. a + x) ` T)" |
|
622 |
and "a + x \<in> ((\<lambda>x. a + x) ` T) \<inter> ((\<lambda>x. a + x) ` S)" |
|
623 |
and "((\<lambda>x. a + x) ` T) \<inter> affine hull ((\<lambda>x. a + x) ` S) \<subseteq> (\<lambda>x. a + x) ` S" |
|
624 |
using affine_hull_translation[of a S] open_translation[of T a] x by auto |
|
625 |
then have "a + x \<in> rel_interior ((\<lambda>x. a + x) ` S)" |
|
626 |
using mem_rel_interior[of "a+x" "((\<lambda>x. a + x) ` S)"] by auto |
|
627 |
} |
|
628 |
then show ?thesis by auto |
|
60809
457abb82fb9e
the Cauchy integral theorem and related material
paulson <lp15@cam.ac.uk>
parents:
60800
diff
changeset
|
629 |
qed |
40377 | 630 |
|
631 |
lemma rel_interior_translation: |
|
53347 | 632 |
fixes a :: "'n::euclidean_space" |
633 |
shows "rel_interior ((\<lambda>x. a + x) ` S) = (\<lambda>x. a + x) ` rel_interior S" |
|
634 |
proof - |
|
635 |
have "(\<lambda>x. (-a) + x) ` rel_interior ((\<lambda>x. a + x) ` S) \<subseteq> rel_interior S" |
|
636 |
using rel_interior_translation_aux[of "-a" "(\<lambda>x. a + x) ` S"] |
|
637 |
translation_assoc[of "-a" "a"] |
|
638 |
by auto |
|
639 |
then have "((\<lambda>x. a + x) ` rel_interior S) \<supseteq> rel_interior ((\<lambda>x. a + x) ` S)" |
|
67399 | 640 |
using translation_inverse_subset[of a "rel_interior ((+) a ` S)" "rel_interior S"] |
53347 | 641 |
by auto |
642 |
then show ?thesis |
|
643 |
using rel_interior_translation_aux[of a S] by auto |
|
40377 | 644 |
qed |
645 |
||
646 |
||
647 |
lemma affine_hull_linear_image: |
|
53347 | 648 |
assumes "bounded_linear f" |
649 |
shows "f ` (affine hull s) = affine hull f ` s" |
|
650 |
proof - |
|
40377 | 651 |
interpret f: bounded_linear f by fact |
68058 | 652 |
have "affine {x. f x \<in> affine hull f ` s}" |
53347 | 653 |
unfolding affine_def |
68031 | 654 |
by (auto simp: f.scaleR f.add affine_affine_hull[unfolded affine_def, rule_format]) |
68058 | 655 |
moreover have "affine {x. x \<in> f ` (affine hull s)}" |
53347 | 656 |
using affine_affine_hull[unfolded affine_def, of s] |
68031 | 657 |
unfolding affine_def by (auto simp: f.scaleR [symmetric] f.add [symmetric]) |
68058 | 658 |
ultimately show ?thesis |
659 |
by (auto simp: hull_inc elim!: hull_induct) |
|
660 |
qed |
|
40377 | 661 |
|
662 |
||
663 |
lemma rel_interior_injective_on_span_linear_image: |
|
53347 | 664 |
fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space" |
665 |
and S :: "'m::euclidean_space set" |
|
666 |
assumes "bounded_linear f" |
|
667 |
and "inj_on f (span S)" |
|
668 |
shows "rel_interior (f ` S) = f ` (rel_interior S)" |
|
669 |
proof - |
|
670 |
{ |
|
671 |
fix z |
|
672 |
assume z: "z \<in> rel_interior (f ` S)" |
|
673 |
then have "z \<in> f ` S" |
|
674 |
using rel_interior_subset[of "f ` S"] by auto |
|
675 |
then obtain x where x: "x \<in> S" "f x = z" by auto |
|
676 |
obtain e2 where e2: "e2 > 0" "cball z e2 \<inter> affine hull (f ` S) \<subseteq> (f ` S)" |
|
677 |
using z rel_interior_cball[of "f ` S"] by auto |
|
678 |
obtain K where K: "K > 0" "\<And>x. norm (f x) \<le> norm x * K" |
|
679 |
using assms Real_Vector_Spaces.bounded_linear.pos_bounded[of f] by auto |
|
63040 | 680 |
define e1 where "e1 = 1 / K" |
53347 | 681 |
then have e1: "e1 > 0" "\<And>x. e1 * norm (f x) \<le> norm x" |
682 |
using K pos_le_divide_eq[of e1] by auto |
|
63040 | 683 |
define e where "e = e1 * e2" |
56544 | 684 |
then have "e > 0" using e1 e2 by auto |
53347 | 685 |
{ |
686 |
fix y |
|
687 |
assume y: "y \<in> cball x e \<inter> affine hull S" |
|
688 |
then have h1: "f y \<in> affine hull (f ` S)" |
|
689 |
using affine_hull_linear_image[of f S] assms by auto |
|
690 |
from y have "norm (x-y) \<le> e1 * e2" |
|
691 |
using cball_def[of x e] dist_norm[of x y] e_def by auto |
|
692 |
moreover have "f x - f y = f (x - y)" |
|
63469
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
693 |
using assms linear_diff[of f x y] linear_conv_bounded_linear[of f] by auto |
53347 | 694 |
moreover have "e1 * norm (f (x-y)) \<le> norm (x - y)" |
695 |
using e1 by auto |
|
696 |
ultimately have "e1 * norm ((f x)-(f y)) \<le> e1 * e2" |
|
697 |
by auto |
|
698 |
then have "f y \<in> cball z e2" |
|
699 |
using cball_def[of "f x" e2] dist_norm[of "f x" "f y"] e1 x by auto |
|
700 |
then have "f y \<in> f ` S" |
|
701 |
using y e2 h1 by auto |
|
702 |
then have "y \<in> S" |
|
703 |
using assms y hull_subset[of S] affine_hull_subset_span |
|
61520
8f85bb443d33
Cauchy's integral formula, required lemmas, and a bit of reorganisation
paulson <lp15@cam.ac.uk>
parents:
61518
diff
changeset
|
704 |
inj_on_image_mem_iff [OF \<open>inj_on f (span S)\<close>] |
68072
493b818e8e10
added Johannes' generalizations Modules.thy and Vector_Spaces.thy; adapted HOL and HOL-Analysis accordingly
immler
parents:
67982
diff
changeset
|
705 |
by (metis Int_iff span_superset subsetCE) |
53347 | 706 |
} |
707 |
then have "z \<in> f ` (rel_interior S)" |
|
60420 | 708 |
using mem_rel_interior_cball[of x S] \<open>e > 0\<close> x by auto |
49531 | 709 |
} |
53347 | 710 |
moreover |
711 |
{ |
|
712 |
fix x |
|
713 |
assume x: "x \<in> rel_interior S" |
|
54465 | 714 |
then obtain e2 where e2: "e2 > 0" "cball x e2 \<inter> affine hull S \<subseteq> S" |
53347 | 715 |
using rel_interior_cball[of S] by auto |
716 |
have "x \<in> S" using x rel_interior_subset by auto |
|
717 |
then have *: "f x \<in> f ` S" by auto |
|
718 |
have "\<forall>x\<in>span S. f x = 0 \<longrightarrow> x = 0" |
|
719 |
using assms subspace_span linear_conv_bounded_linear[of f] |
|
720 |
linear_injective_on_subspace_0[of f "span S"] |
|
721 |
by auto |
|
722 |
then obtain e1 where e1: "e1 > 0" "\<forall>x \<in> span S. e1 * norm x \<le> norm (f x)" |
|
723 |
using assms injective_imp_isometric[of "span S" f] |
|
724 |
subspace_span[of S] closed_subspace[of "span S"] |
|
725 |
by auto |
|
63040 | 726 |
define e where "e = e1 * e2" |
56544 | 727 |
hence "e > 0" using e1 e2 by auto |
53347 | 728 |
{ |
729 |
fix y |
|
730 |
assume y: "y \<in> cball (f x) e \<inter> affine hull (f ` S)" |
|
731 |
then have "y \<in> f ` (affine hull S)" |
|
732 |
using affine_hull_linear_image[of f S] assms by auto |
|
733 |
then obtain xy where xy: "xy \<in> affine hull S" "f xy = y" by auto |
|
734 |
with y have "norm (f x - f xy) \<le> e1 * e2" |
|
735 |
using cball_def[of "f x" e] dist_norm[of "f x" y] e_def by auto |
|
736 |
moreover have "f x - f xy = f (x - xy)" |
|
63469
b6900858dcb9
lots of new theorems about differentiable_on, retracts, ANRs, etc.
paulson <lp15@cam.ac.uk>
parents:
63332
diff
changeset
|
737 |
using assms linear_diff[of f x xy] linear_conv_bounded_linear[of f] by auto |
53347 | 738 |
moreover have *: "x - xy \<in> span S" |
63114
27afe7af7379
Lots of new material for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
63092
diff
changeset
|
739 |
using subspace_diff[of "span S" x xy] subspace_span \<open>x \<in> S\<close> xy |
68072
493b818e8e10
added Johannes' generalizations Modules.thy and Vector_Spaces.thy; adapted HOL and HOL-Analysis accordingly
immler
parents:
67982
diff
changeset
|
740 |
affine_hull_subset_span[of S] span_superset |
53347 | 741 |
by auto |
742 |
moreover from * have "e1 * norm (x - xy) \<le> norm (f (x - xy))" |
|
743 |
using e1 by auto |
|
744 |
ultimately have "e1 * norm (x - xy) \<le> e1 * e2" |
|
745 |
by auto |
|
746 |
then have "xy \<in> cball x e2" |
|
747 |
using cball_def[of x e2] dist_norm[of x xy] e1 by auto |
|
748 |
then have "y \<in> f ` S" |
|
749 |
using xy e2 by auto |
|
750 |
} |
|
751 |
then have "f x \<in> rel_interior (f ` S)" |
|
60420 | 752 |
using mem_rel_interior_cball[of "(f x)" "(f ` S)"] * \<open>e > 0\<close> by auto |
49531 | 753 |
} |
53347 | 754 |
ultimately show ?thesis by auto |
40377 | 755 |
qed |
756 |
||
757 |
lemma rel_interior_injective_linear_image: |
|
53347 | 758 |
fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space" |
759 |
assumes "bounded_linear f" |
|
760 |
and "inj f" |
|
761 |
shows "rel_interior (f ` S) = f ` (rel_interior S)" |
|
762 |
using assms rel_interior_injective_on_span_linear_image[of f S] |
|
763 |
subset_inj_on[of f "UNIV" "span S"] |
|
764 |
by auto |
|
765 |
||
40377 | 766 |
|
70136 | 767 |
subsection\<^marker>\<open>tag unimportant\<close> \<open>Openness and compactness are preserved by convex hull operation\<close> |
33175 | 768 |
|
34964 | 769 |
lemma open_convex_hull[intro]: |
68052 | 770 |
fixes S :: "'a::real_normed_vector set" |
771 |
assumes "open S" |
|
772 |
shows "open (convex hull S)" |
|
773 |
proof (clarsimp simp: open_contains_cball convex_hull_explicit) |
|
774 |
fix T and u :: "'a\<Rightarrow>real" |
|
775 |
assume obt: "finite T" "T\<subseteq>S" "\<forall>x\<in>T. 0 \<le> u x" "sum u T = 1" |
|
53347 | 776 |
|
777 |
from assms[unfolded open_contains_cball] obtain b |
|
68052 | 778 |
where b: "\<And>x. x\<in>S \<Longrightarrow> 0 < b x \<and> cball x (b x) \<subseteq> S" by metis |
779 |
have "b ` T \<noteq> {}" |
|
56889
48a745e1bde7
avoid the Complex constructor, use the more natural Re/Im view; moved csqrt to Complex.
hoelzl
parents:
56571
diff
changeset
|
780 |
using obt by auto |
68052 | 781 |
define i where "i = b ` T" |
782 |
let ?\<Phi> = "\<lambda>y. \<exists>F. finite F \<and> F \<subseteq> S \<and> (\<exists>u. (\<forall>x\<in>F. 0 \<le> u x) \<and> sum u F = 1 \<and> (\<Sum>v\<in>F. u v *\<^sub>R v) = y)" |
|
783 |
let ?a = "\<Sum>v\<in>T. u v *\<^sub>R v" |
|
784 |
show "\<exists>e > 0. cball ?a e \<subseteq> {y. ?\<Phi> y}" |
|
785 |
proof (intro exI subsetI conjI) |
|
53347 | 786 |
show "0 < Min i" |
68052 | 787 |
unfolding i_def and Min_gr_iff[OF finite_imageI[OF obt(1)] \<open>b ` T\<noteq>{}\<close>] |
788 |
using b \<open>T\<subseteq>S\<close> by auto |
|
53347 | 789 |
next |
790 |
fix y |
|
68052 | 791 |
assume "y \<in> cball ?a (Min i)" |
792 |
then have y: "norm (?a - y) \<le> Min i" |
|
53347 | 793 |
unfolding dist_norm[symmetric] by auto |
68052 | 794 |
{ fix x |
795 |
assume "x \<in> T" |
|
53347 | 796 |
then have "Min i \<le> b x" |
68052 | 797 |
by (simp add: i_def obt(1)) |
798 |
then have "x + (y - ?a) \<in> cball x (b x)" |
|
53347 | 799 |
using y unfolding mem_cball dist_norm by auto |
68052 | 800 |
moreover have "x \<in> S" |
801 |
using \<open>x\<in>T\<close> \<open>T\<subseteq>S\<close> by auto |
|
802 |
ultimately have "x + (y - ?a) \<in> S" |
|
803 |
using y b by blast |
|
53347 | 804 |
} |
33175 | 805 |
moreover |
68052 | 806 |
have *: "inj_on (\<lambda>v. v + (y - ?a)) T" |
53347 | 807 |
unfolding inj_on_def by auto |
68052 | 808 |
have "(\<Sum>v\<in>(\<lambda>v. v + (y - ?a)) ` T. u (v - (y - ?a)) *\<^sub>R v) = y" |
809 |
unfolding sum.reindex[OF *] o_def using obt(4) |
|
64267 | 810 |
by (simp add: sum.distrib sum_subtractf scaleR_left.sum[symmetric] scaleR_right_distrib) |
68052 | 811 |
ultimately show "y \<in> {y. ?\<Phi> y}" |
812 |
proof (intro CollectI exI conjI) |
|
813 |
show "finite ((\<lambda>v. v + (y - ?a)) ` T)" |
|
814 |
by (simp add: obt(1)) |
|
815 |
show "sum (\<lambda>v. u (v - (y - ?a))) ((\<lambda>v. v + (y - ?a)) ` T) = 1" |
|
816 |
unfolding sum.reindex[OF *] o_def using obt(4) by auto |
|
817 |
qed (use obt(1, 3) in auto) |
|
33175 | 818 |
qed |
819 |
qed |
|
820 |
||
821 |
lemma compact_convex_combinations: |
|
68052 | 822 |
fixes S T :: "'a::real_normed_vector set" |
823 |
assumes "compact S" "compact T" |
|
824 |
shows "compact { (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u. 0 \<le> u \<and> u \<le> 1 \<and> x \<in> S \<and> y \<in> T}" |
|
53347 | 825 |
proof - |
68052 | 826 |
let ?X = "{0..1} \<times> S \<times> T" |
33175 | 827 |
let ?h = "(\<lambda>z. (1 - fst z) *\<^sub>R fst (snd z) + fst z *\<^sub>R snd (snd z))" |
68052 | 828 |
have *: "{ (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u. 0 \<le> u \<and> u \<le> 1 \<and> x \<in> S \<and> y \<in> T} = ?h ` ?X" |
829 |
by force |
|
56188 | 830 |
have "continuous_on ?X (\<lambda>z. (1 - fst z) *\<^sub>R fst (snd z) + fst z *\<^sub>R snd (snd z))" |
33175 | 831 |
unfolding continuous_on by (rule ballI) (intro tendsto_intros) |
68052 | 832 |
with assms show ?thesis |
833 |
by (simp add: * compact_Times compact_continuous_image) |
|
33175 | 834 |
qed |
835 |
||
44525
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
836 |
lemma finite_imp_compact_convex_hull: |
68052 | 837 |
fixes S :: "'a::real_normed_vector set" |
838 |
assumes "finite S" |
|
839 |
shows "compact (convex hull S)" |
|
840 |
proof (cases "S = {}") |
|
53347 | 841 |
case True |
842 |
then show ?thesis by simp |
|
44525
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
843 |
next |
53347 | 844 |
case False |
845 |
with assms show ?thesis |
|
44525
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
846 |
proof (induct rule: finite_ne_induct) |
53347 | 847 |
case (singleton x) |
848 |
show ?case by simp |
|
44525
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
849 |
next |
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
850 |
case (insert x A) |
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
851 |
let ?f = "\<lambda>(u, y::'a). u *\<^sub>R x + (1 - u) *\<^sub>R y" |
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
852 |
let ?T = "{0..1::real} \<times> (convex hull A)" |
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
853 |
have "continuous_on ?T ?f" |
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
854 |
unfolding split_def continuous_on by (intro ballI tendsto_intros) |
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
855 |
moreover have "compact ?T" |
56188 | 856 |
by (intro compact_Times compact_Icc insert) |
44525
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
857 |
ultimately have "compact (?f ` ?T)" |
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
858 |
by (rule compact_continuous_image) |
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
859 |
also have "?f ` ?T = convex hull (insert x A)" |
60420 | 860 |
unfolding convex_hull_insert [OF \<open>A \<noteq> {}\<close>] |
44525
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
861 |
apply safe |
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
862 |
apply (rule_tac x=a in exI, simp) |
68031 | 863 |
apply (rule_tac x="1 - a" in exI, simp, fast) |
44525
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
864 |
apply (rule_tac x="(u, b)" in image_eqI, simp_all) |
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
865 |
done |
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
866 |
finally show "compact (convex hull (insert x A))" . |
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
867 |
qed |
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
868 |
qed |
fbb777aec0d4
generalize lemma finite_imp_compact_convex_hull and related lemmas
huffman
parents:
44524
diff
changeset
|
869 |
|
53347 | 870 |
lemma compact_convex_hull: |
68052 | 871 |
fixes S :: "'a::euclidean_space set" |
872 |
assumes "compact S" |
|
873 |
shows "compact (convex hull S)" |
|
874 |
proof (cases "S = {}") |
|
53347 | 875 |
case True |
876 |
then show ?thesis using compact_empty by simp |
|
33175 | 877 |
next |
53347 | 878 |
case False |
68052 | 879 |
then obtain w where "w \<in> S" by auto |
53347 | 880 |
show ?thesis |
68052 | 881 |
unfolding caratheodory[of S] |
53347 | 882 |
proof (induct ("DIM('a) + 1")) |
883 |
case 0 |
|
68052 | 884 |
have *: "{x.\<exists>sa. finite sa \<and> sa \<subseteq> S \<and> card sa \<le> 0 \<and> x \<in> convex hull sa} = {}" |
36362
06475a1547cb
fix lots of looping simp calls and other warnings
huffman
parents:
36341
diff
changeset
|
885 |
using compact_empty by auto |
53347 | 886 |
from 0 show ?case unfolding * by simp |
33175 | 887 |
next |
888 |
case (Suc n) |
|
53347 | 889 |
show ?case |
890 |
proof (cases "n = 0") |
|
891 |
case True |
|
68052 | 892 |
have "{x. \<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T} = S" |
53347 | 893 |
unfolding set_eq_iff and mem_Collect_eq |
894 |
proof (rule, rule) |
|
895 |
fix x |
|
68052 | 896 |
assume "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T" |
897 |
then obtain T where T: "finite T" "T \<subseteq> S" "card T \<le> Suc n" "x \<in> convex hull T" |
|
53347 | 898 |
by auto |
68052 | 899 |
show "x \<in> S" |
900 |
proof (cases "card T = 0") |
|
53347 | 901 |
case True |
902 |
then show ?thesis |
|
68052 | 903 |
using T(4) unfolding card_0_eq[OF T(1)] by simp |
33175 | 904 |
next |
53347 | 905 |
case False |
68052 | 906 |
then have "card T = Suc 0" using T(3) \<open>n=0\<close> by auto |
907 |
then obtain a where "T = {a}" unfolding card_Suc_eq by auto |
|
908 |
then show ?thesis using T(2,4) by simp |
|
33175 | 909 |
qed |
910 |
next |
|
68052 | 911 |
fix x assume "x\<in>S" |
912 |
then show "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T" |
|
53347 | 913 |
apply (rule_tac x="{x}" in exI) |
914 |
unfolding convex_hull_singleton |
|
915 |
apply auto |
|
916 |
done |
|
917 |
qed |
|
918 |
then show ?thesis using assms by simp |
|
33175 | 919 |
next |
53347 | 920 |
case False |
68052 | 921 |
have "{x. \<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T} = |
53347 | 922 |
{(1 - u) *\<^sub>R x + u *\<^sub>R y | x y u. |
68052 | 923 |
0 \<le> u \<and> u \<le> 1 \<and> x \<in> S \<and> y \<in> {x. \<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> n \<and> x \<in> convex hull T}}" |
53347 | 924 |
unfolding set_eq_iff and mem_Collect_eq |
925 |
proof (rule, rule) |
|
926 |
fix x |
|
927 |
assume "\<exists>u v c. x = (1 - c) *\<^sub>R u + c *\<^sub>R v \<and> |
|
68052 | 928 |
0 \<le> c \<and> c \<le> 1 \<and> u \<in> S \<and> (\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> n \<and> v \<in> convex hull T)" |
929 |
then obtain u v c T where obt: "x = (1 - c) *\<^sub>R u + c *\<^sub>R v" |
|
930 |
"0 \<le> c \<and> c \<le> 1" "u \<in> S" "finite T" "T \<subseteq> S" "card T \<le> n" "v \<in> convex hull T" |
|
53347 | 931 |
by auto |
68052 | 932 |
moreover have "(1 - c) *\<^sub>R u + c *\<^sub>R v \<in> convex hull insert u T" |
61426
d53db136e8fd
new material on path_component_sets, inside, outside, etc. And more default simprules
paulson <lp15@cam.ac.uk>
parents:
61222
diff
changeset
|
933 |
apply (rule convexD_alt) |
68052 | 934 |
using obt(2) and convex_convex_hull and hull_subset[of "insert u T" convex] |
935 |
using obt(7) and hull_mono[of T "insert u T"] |
|
53347 | 936 |
apply auto |
937 |
done |
|
68052 | 938 |
ultimately show "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T" |
939 |
apply (rule_tac x="insert u T" in exI) |
|
68031 | 940 |
apply (auto simp: card_insert_if) |
53347 | 941 |
done |
33175 | 942 |
next |
53347 | 943 |
fix x |
68052 | 944 |
assume "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T" |
945 |
then obtain T where T: "finite T" "T \<subseteq> S" "card T \<le> Suc n" "x \<in> convex hull T" |
|
53347 | 946 |
by auto |
947 |
show "\<exists>u v c. x = (1 - c) *\<^sub>R u + c *\<^sub>R v \<and> |
|
68052 | 948 |
0 \<le> c \<and> c \<le> 1 \<and> u \<in> S \<and> (\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> n \<and> v \<in> convex hull T)" |
949 |
proof (cases "card T = Suc n") |
|
53347 | 950 |
case False |
68052 | 951 |
then have "card T \<le> n" using T(3) by auto |
53347 | 952 |
then show ?thesis |
953 |
apply (rule_tac x=w in exI, rule_tac x=x in exI, rule_tac x=1 in exI) |
|
68052 | 954 |
using \<open>w\<in>S\<close> and T |
955 |
apply (auto intro!: exI[where x=T]) |
|
53347 | 956 |
done |
33175 | 957 |
next |
53347 | 958 |
case True |
68052 | 959 |
then obtain a u where au: "T = insert a u" "a\<notin>u" |
68031 | 960 |
apply (drule_tac card_eq_SucD, auto) |
53347 | 961 |
done |
962 |
show ?thesis |
|
963 |
proof (cases "u = {}") |
|
964 |
case True |
|
68052 | 965 |
then have "x = a" using T(4)[unfolded au] by auto |
60420 | 966 |
show ?thesis unfolding \<open>x = a\<close> |
53347 | 967 |
apply (rule_tac x=a in exI) |
968 |
apply (rule_tac x=a in exI) |
|
969 |
apply (rule_tac x=1 in exI) |
|
68052 | 970 |
using T and \<open>n \<noteq> 0\<close> |
53347 | 971 |
unfolding au |
972 |
apply (auto intro!: exI[where x="{a}"]) |
|
973 |
done |
|
33175 | 974 |
next |
53347 | 975 |
case False |
976 |
obtain ux vx b where obt: "ux\<ge>0" "vx\<ge>0" "ux + vx = 1" |
|
977 |
"b \<in> convex hull u" "x = ux *\<^sub>R a + vx *\<^sub>R b" |
|
68052 | 978 |
using T(4)[unfolded au convex_hull_insert[OF False]] |
53347 | 979 |
by auto |
980 |
have *: "1 - vx = ux" using obt(3) by auto |
|
981 |
show ?thesis |
|
982 |
apply (rule_tac x=a in exI) |
|
983 |
apply (rule_tac x=b in exI) |
|
984 |
apply (rule_tac x=vx in exI) |
|
68052 | 985 |
using obt and T(1-3) |
53347 | 986 |
unfolding au and * using card_insert_disjoint[OF _ au(2)] |
987 |
apply (auto intro!: exI[where x=u]) |
|
988 |
done |
|
33175 | 989 |
qed |
990 |
qed |
|
991 |
qed |
|
53347 | 992 |
then show ?thesis |
993 |
using compact_convex_combinations[OF assms Suc] by simp |
|
33175 | 994 |
qed |
36362
06475a1547cb
fix lots of looping simp calls and other warnings
huffman
parents:
36341
diff
changeset
|
995 |
qed |
33175 | 996 |
qed |
997 |
||
53347 | 998 |
|
70136 | 999 |
subsection\<^marker>\<open>tag unimportant\<close> \<open>Extremal points of a simplex are some vertices\<close> |
33175 | 1000 |
|
1001 |
lemma dist_increases_online: |
|
1002 |
fixes a b d :: "'a::real_inner" |
|
1003 |
assumes "d \<noteq> 0" |
|
1004 |
shows "dist a (b + d) > dist a b \<or> dist a (b - d) > dist a b" |
|
53347 | 1005 |
proof (cases "inner a d - inner b d > 0") |
1006 |
case True |
|
1007 |
then have "0 < inner d d + (inner a d * 2 - inner b d * 2)" |
|
1008 |
apply (rule_tac add_pos_pos) |
|
1009 |
using assms |
|
1010 |
apply auto |
|
1011 |
done |
|
1012 |
then show ?thesis |
|
1013 |
apply (rule_tac disjI2) |
|
1014 |
unfolding dist_norm and norm_eq_sqrt_inner and real_sqrt_less_iff |
|
1015 |
apply (simp add: algebra_simps inner_commute) |
|
1016 |
done |
|
33175 | 1017 |
next |
53347 | 1018 |
case False |
1019 |
then have "0 < inner d d + (inner b d * 2 - inner a d * 2)" |
|
1020 |
apply (rule_tac add_pos_nonneg) |
|
1021 |
using assms |
|
1022 |
apply auto |
|
1023 |
done |
|
1024 |
then show ?thesis |
|
1025 |
apply (rule_tac disjI1) |
|
1026 |
unfolding dist_norm and norm_eq_sqrt_inner and real_sqrt_less_iff |
|
1027 |
apply (simp add: algebra_simps inner_commute) |
|
1028 |
done |
|
33175 | 1029 |
qed |
1030 |
||
1031 |
lemma norm_increases_online: |
|
1032 |
fixes d :: "'a::real_inner" |
|
53347 | 1033 |
shows "d \<noteq> 0 \<Longrightarrow> norm (a + d) > norm a \<or> norm(a - d) > norm a" |
33175 | 1034 |
using dist_increases_online[of d a 0] unfolding dist_norm by auto |
1035 |
||
1036 |
lemma simplex_furthest_lt: |
|
68052 | 1037 |
fixes S :: "'a::real_inner set" |
1038 |
assumes "finite S" |
|
1039 |
shows "\<forall>x \<in> convex hull S. x \<notin> S \<longrightarrow> (\<exists>y \<in> convex hull S. norm (x - a) < norm(y - a))" |
|
53347 | 1040 |
using assms |
1041 |
proof induct |
|
68052 | 1042 |
fix x S |
1043 |
assume as: "finite S" "x\<notin>S" "\<forall>x\<in>convex hull S. x \<notin> S \<longrightarrow> (\<exists>y\<in>convex hull S. norm (x - a) < norm (y - a))" |
|
1044 |
show "\<forall>xa\<in>convex hull insert x S. xa \<notin> insert x S \<longrightarrow> |
|
1045 |
(\<exists>y\<in>convex hull insert x S. norm (xa - a) < norm (y - a))" |
|
1046 |
proof (intro impI ballI, cases "S = {}") |
|
53347 | 1047 |
case False |
1048 |
fix y |
|
68052 | 1049 |
assume y: "y \<in> convex hull insert x S" "y \<notin> insert x S" |
1050 |
obtain u v b where obt: "u\<ge>0" "v\<ge>0" "u + v = 1" "b \<in> convex hull S" "y = u *\<^sub>R x + v *\<^sub>R b" |
|
33175 | 1051 |
using y(1)[unfolded convex_hull_insert[OF False]] by auto |
68052 | 1052 |
show "\<exists>z\<in>convex hull insert x S. norm (y - a) < norm (z - a)" |
1053 |
proof (cases "y \<in> convex hull S") |
|
53347 | 1054 |
case True |
68052 | 1055 |
then obtain z where "z \<in> convex hull S" "norm (y - a) < norm (z - a)" |
33175 | 1056 |
using as(3)[THEN bspec[where x=y]] and y(2) by auto |
53347 | 1057 |
then show ?thesis |
1058 |
apply (rule_tac x=z in bexI) |
|
1059 |
unfolding convex_hull_insert[OF False] |
|
1060 |
apply auto |
|
1061 |
done |
|
33175 | 1062 |
next |
53347 | 1063 |
case False |
1064 |
show ?thesis |
|
1065 |
using obt(3) |
|
1066 |
proof (cases "u = 0", case_tac[!] "v = 0") |
|
1067 |
assume "u = 0" "v \<noteq> 0" |
|
1068 |
then have "y = b" using obt by auto |
|
1069 |
then show ?thesis using False and obt(4) by auto |
|
33175 | 1070 |
next |
53347 | 1071 |
assume "u \<noteq> 0" "v = 0" |
1072 |
then have "y = x" using obt by auto |
|
1073 |
then show ?thesis using y(2) by auto |
|
1074 |
next |
|
1075 |
assume "u \<noteq> 0" "v \<noteq> 0" |
|
1076 |
then obtain w where w: "w>0" "w<u" "w<v" |
|
68527
2f4e2aab190a
Generalising and renaming some basic results
paulson <lp15@cam.ac.uk>
parents:
68074
diff
changeset
|
1077 |
using field_lbound_gt_zero[of u v] and obt(1,2) by auto |
53347 | 1078 |
have "x \<noteq> b" |
1079 |
proof |
|
1080 |
assume "x = b" |
|
1081 |
then have "y = b" unfolding obt(5) |
|
68031 | 1082 |
using obt(3) by (auto simp: scaleR_left_distrib[symmetric]) |
53347 | 1083 |
then show False using obt(4) and False by simp |
1084 |
qed |
|
1085 |
then have *: "w *\<^sub>R (x - b) \<noteq> 0" using w(1) by auto |
|
1086 |
show ?thesis |
|
1087 |
using dist_increases_online[OF *, of a y] |
|
1088 |
proof (elim disjE) |
|
33175 | 1089 |
assume "dist a y < dist a (y + w *\<^sub>R (x - b))" |
53347 | 1090 |
then have "norm (y - a) < norm ((u + w) *\<^sub>R x + (v - w) *\<^sub>R b - a)" |
1091 |
unfolding dist_commute[of a] |
|
1092 |
unfolding dist_norm obt(5) |
|
1093 |
by (simp add: algebra_simps) |
|
68052 | 1094 |
moreover have "(u + w) *\<^sub>R x + (v - w) *\<^sub>R b \<in> convex hull insert x S" |
1095 |
unfolding convex_hull_insert[OF \<open>S\<noteq>{}\<close>] |
|
1096 |
proof (intro CollectI conjI exI) |
|
1097 |
show "u + w \<ge> 0" "v - w \<ge> 0" |
|
1098 |
using obt(1) w by auto |
|
1099 |
qed (use obt in auto) |
|
33175 | 1100 |
ultimately show ?thesis by auto |
1101 |
next |
|
1102 |
assume "dist a y < dist a (y - w *\<^sub>R (x - b))" |
|
53347 | 1103 |
then have "norm (y - a) < norm ((u - w) *\<^sub>R x + (v + w) *\<^sub>R b - a)" |
1104 |
unfolding dist_commute[of a] |
|
1105 |
unfolding dist_norm obt(5) |
|
1106 |
by (simp add: algebra_simps) |
|
68052 | 1107 |
moreover have "(u - w) *\<^sub>R x + (v + w) *\<^sub>R b \<in> convex hull insert x S" |
1108 |
unfolding convex_hull_insert[OF \<open>S\<noteq>{}\<close>] |
|
1109 |
proof (intro CollectI conjI exI) |
|
1110 |
show "u - w \<ge> 0" "v + w \<ge> 0" |
|
1111 |
using obt(1) w by auto |
|
1112 |
qed (use obt in auto) |
|
33175 | 1113 |
ultimately show ?thesis by auto |
1114 |
qed |
|
1115 |
qed auto |
|
1116 |
qed |
|
1117 |
qed auto |
|
68031 | 1118 |
qed (auto simp: assms) |
33175 | 1119 |
|
1120 |
lemma simplex_furthest_le: |
|
68052 | 1121 |
fixes S :: "'a::real_inner set" |
1122 |
assumes "finite S" |
|
1123 |
and "S \<noteq> {}" |
|
1124 |
shows "\<exists>y\<in>S. \<forall>x\<in> convex hull S. norm (x - a) \<le> norm (y - a)" |
|
53347 | 1125 |
proof - |
68052 | 1126 |
have "convex hull S \<noteq> {}" |
1127 |
using hull_subset[of S convex] and assms(2) by auto |
|
1128 |
then obtain x where x: "x \<in> convex hull S" "\<forall>y\<in>convex hull S. norm (y - a) \<le> norm (x - a)" |
|
1129 |
using distance_attains_sup[OF finite_imp_compact_convex_hull[OF \<open>finite S\<close>], of a] |
|
53347 | 1130 |
unfolding dist_commute[of a] |
1131 |
unfolding dist_norm |
|
1132 |
by auto |
|
1133 |
show ?thesis |
|
68052 | 1134 |
proof (cases "x \<in> S") |
53347 | 1135 |
case False |
68052 | 1136 |
then obtain y where "y \<in> convex hull S" "norm (x - a) < norm (y - a)" |
53347 | 1137 |
using simplex_furthest_lt[OF assms(1), THEN bspec[where x=x]] and x(1) |
1138 |
by auto |
|
1139 |
then show ?thesis |
|
1140 |
using x(2)[THEN bspec[where x=y]] by auto |
|
1141 |
next |
|
1142 |
case True |
|
1143 |
with x show ?thesis by auto |
|
1144 |
qed |
|
33175 | 1145 |
qed |
1146 |
||
1147 |
lemma simplex_furthest_le_exists: |
|
68052 | 1148 |
fixes S :: "('a::real_inner) set" |
1149 |
shows "finite S \<Longrightarrow> \<forall>x\<in>(convex hull S). \<exists>y\<in>S. norm (x - a) \<le> norm (y - a)" |
|
1150 |
using simplex_furthest_le[of S] by (cases "S = {}") auto |
|
33175 | 1151 |
|
1152 |
lemma simplex_extremal_le: |
|
68052 | 1153 |
fixes S :: "'a::real_inner set" |
1154 |
assumes "finite S" |
|
1155 |
and "S \<noteq> {}" |
|
1156 |
shows "\<exists>u\<in>S. \<exists>v\<in>S. \<forall>x\<in>convex hull S. \<forall>y \<in> convex hull S. norm (x - y) \<le> norm (u - v)" |
|
53347 | 1157 |
proof - |
68052 | 1158 |
have "convex hull S \<noteq> {}" |
1159 |
using hull_subset[of S convex] and assms(2) by auto |
|
1160 |
then obtain u v where obt: "u \<in> convex hull S" "v \<in> convex hull S" |
|
1161 |
"\<forall>x\<in>convex hull S. \<forall>y\<in>convex hull S. norm (x - y) \<le> norm (u - v)" |
|
53347 | 1162 |
using compact_sup_maxdistance[OF finite_imp_compact_convex_hull[OF assms(1)]] |
1163 |
by (auto simp: dist_norm) |
|
1164 |
then show ?thesis |
|
68052 | 1165 |
proof (cases "u\<notin>S \<or> v\<notin>S", elim disjE) |
1166 |
assume "u \<notin> S" |
|
1167 |
then obtain y where "y \<in> convex hull S" "norm (u - v) < norm (y - v)" |
|
53347 | 1168 |
using simplex_furthest_lt[OF assms(1), THEN bspec[where x=u]] and obt(1) |
1169 |
by auto |
|
1170 |
then show ?thesis |
|
1171 |
using obt(3)[THEN bspec[where x=y], THEN bspec[where x=v]] and obt(2) |
|
1172 |
by auto |
|
33175 | 1173 |
next |
68052 | 1174 |
assume "v \<notin> S" |
1175 |
then obtain y where "y \<in> convex hull S" "norm (v - u) < norm (y - u)" |
|
53347 | 1176 |
using simplex_furthest_lt[OF assms(1), THEN bspec[where x=v]] and obt(2) |
1177 |
by auto |
|
1178 |
then show ?thesis |
|
1179 |
using obt(3)[THEN bspec[where x=u], THEN bspec[where x=y]] and obt(1) |
|
68031 | 1180 |
by (auto simp: norm_minus_commute) |
33175 | 1181 |
qed auto |
49531 | 1182 |
qed |
33175 | 1183 |
|
1184 |
lemma simplex_extremal_le_exists: |
|
68052 | 1185 |
fixes S :: "'a::real_inner set" |
1186 |
shows "finite S \<Longrightarrow> x \<in> convex hull S \<Longrightarrow> y \<in> convex hull S \<Longrightarrow> |
|
1187 |
\<exists>u\<in>S. \<exists>v\<in>S. norm (x - y) \<le> norm (u - v)" |
|
1188 |
using convex_hull_empty simplex_extremal_le[of S] |
|
1189 |
by(cases "S = {}") auto |
|
53347 | 1190 |
|
33175 | 1191 |
|
67968 | 1192 |
subsection \<open>Closest point of a convex set is unique, with a continuous projection\<close> |
33175 | 1193 |
|
70136 | 1194 |
definition\<^marker>\<open>tag important\<close> closest_point :: "'a::{real_inner,heine_borel} set \<Rightarrow> 'a \<Rightarrow> 'a" |
68052 | 1195 |
where "closest_point S a = (SOME x. x \<in> S \<and> (\<forall>y\<in>S. dist a x \<le> dist a y))" |
33175 | 1196 |
|
1197 |
lemma closest_point_exists: |
|
68052 | 1198 |
assumes "closed S" |
1199 |
and "S \<noteq> {}" |
|
71244 | 1200 |
shows closest_point_in_set: "closest_point S a \<in> S" |
68052 | 1201 |
and "\<forall>y\<in>S. dist a (closest_point S a) \<le> dist a y" |
53347 | 1202 |
unfolding closest_point_def |
1203 |
apply(rule_tac[!] someI2_ex) |
|
62381
a6479cb85944
New and revised material for (multivariate) analysis
paulson <lp15@cam.ac.uk>
parents:
62131
diff
changeset
|
1204 |
apply (auto intro: distance_attains_inf[OF assms(1,2), of a]) |
53347 | 1205 |
done |
1206 |
||
68052 | 1207 |
lemma closest_point_le: "closed S \<Longrightarrow> x \<in> S \<Longrightarrow> dist a (closest_point S a) \<le> dist a x" |
1208 |
using closest_point_exists[of S] by auto |
|
33175 | 1209 |
|
1210 |
lemma closest_point_self: |
|
68052 | 1211 |
assumes "x \<in> S" |
1212 |
shows "closest_point S x = x" |
|
53347 | 1213 |
unfolding closest_point_def |
1214 |
apply (rule some1_equality, rule ex1I[of _ x]) |
|
1215 |
using assms |
|
1216 |
apply auto |
|
1217 |
done |
|
1218 |
||
68052 | 1219 |
lemma closest_point_refl: "closed S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> closest_point S x = x \<longleftrightarrow> x \<in> S" |
1220 |
using closest_point_in_set[of S x] closest_point_self[of x S] |
|
53347 | 1221 |
by auto |
33175 | 1222 |
|
36337 | 1223 |
lemma closer_points_lemma: |
33175 | 1224 |
assumes "inner y z > 0" |
1225 |
shows "\<exists>u>0. \<forall>v>0. v \<le> u \<longrightarrow> norm(v *\<^sub>R z - y) < norm y" |
|
53347 | 1226 |
proof - |
1227 |
have z: "inner z z > 0" |
|
1228 |
unfolding inner_gt_zero_iff using assms by auto |
|
68031 | 1229 |
have "norm (v *\<^sub>R z - y) < norm y" |
1230 |
if "0 < v" and "v \<le> inner y z / inner z z" for v |
|
1231 |
unfolding norm_lt using z assms that |
|
1232 |
by (simp add: field_simps inner_diff inner_commute mult_strict_left_mono[OF _ \<open>0<v\<close>]) |
|
53347 | 1233 |
then show ?thesis |
68031 | 1234 |
using assms z |
1235 |
by (rule_tac x = "inner y z / inner z z" in exI) auto |
|
53347 | 1236 |
qed |
33175 | 1237 |
|
1238 |
lemma closer_point_lemma: |
|
1239 |
assumes "inner (y - x) (z - x) > 0" |
|
1240 |
shows "\<exists>u>0. u \<le> 1 \<and> dist (x + u *\<^sub>R (z - x)) y < dist x y" |
|
53347 | 1241 |
proof - |
1242 |
obtain u where "u > 0" |
|
1243 |
and u: "\<forall>v>0. v \<le> u \<longrightarrow> norm (v *\<^sub>R (z - x) - (y - x)) < norm (y - x)" |
|
33175 | 1244 |
using closer_points_lemma[OF assms] by auto |
53347 | 1245 |
show ?thesis |
1246 |
apply (rule_tac x="min u 1" in exI) |
|
60420 | 1247 |
using u[THEN spec[where x="min u 1"]] and \<open>u > 0\<close> |
68031 | 1248 |
unfolding dist_norm by (auto simp: norm_minus_commute field_simps) |
53347 | 1249 |
qed |
33175 | 1250 |
|
1251 |
lemma any_closest_point_dot: |
|
68052 | 1252 |
assumes "convex S" "closed S" "x \<in> S" "y \<in> S" "\<forall>z\<in>S. dist a x \<le> dist a z" |
33175 | 1253 |
shows "inner (a - x) (y - x) \<le> 0" |
53347 | 1254 |
proof (rule ccontr) |
1255 |
assume "\<not> ?thesis" |
|
1256 |
then obtain u where u: "u>0" "u\<le>1" "dist (x + u *\<^sub>R (y - x)) a < dist x a" |
|
1257 |
using closer_point_lemma[of a x y] by auto |
|
1258 |
let ?z = "(1 - u) *\<^sub>R x + u *\<^sub>R y" |
|
68052 | 1259 |
have "?z \<in> S" |
61426
d53db136e8fd
new material on path_component_sets, inside, outside, etc. And more default simprules
paulson <lp15@cam.ac.uk>
parents:
61222
diff
changeset
|
1260 |
using convexD_alt[OF assms(1,3,4), of u] using u by auto |
53347 | 1261 |
then show False |
1262 |
using assms(5)[THEN bspec[where x="?z"]] and u(3) |
|
68031 | 1263 |
by (auto simp: dist_commute algebra_simps) |
53347 | 1264 |
qed |
33175 | 1265 |
|
1266 |
lemma any_closest_point_unique: |
|
36337 | 1267 |
fixes x :: "'a::real_inner" |
68052 | 1268 |
assumes "convex S" "closed S" "x \<in> S" "y \<in> S" |
1269 |
"\<forall>z\<in>S. dist a x \<le> dist a z" "\<forall>z\<in>S. dist a y \<le> dist a z" |
|
53347 | 1270 |
shows "x = y" |
1271 |
using any_closest_point_dot[OF assms(1-4,5)] and any_closest_point_dot[OF assms(1-2,4,3,6)] |
|
33175 | 1272 |
unfolding norm_pths(1) and norm_le_square |
68031 | 1273 |
by (auto simp: algebra_simps) |
33175 | 1274 |
|
1275 |
lemma closest_point_unique: |
|
68052 | 1276 |
assumes "convex S" "closed S" "x \<in> S" "\<forall>z\<in>S. dist a x \<le> dist a z" |
1277 |
shows "x = closest_point S a" |
|
1278 |
using any_closest_point_unique[OF assms(1-3) _ assms(4), of "closest_point S a"] |
|
33175 | 1279 |
using closest_point_exists[OF assms(2)] and assms(3) by auto |
1280 |
||
1281 |
lemma closest_point_dot: |
|
68052 | 1282 |
assumes "convex S" "closed S" "x \<in> S" |
1283 |
shows "inner (a - closest_point S a) (x - closest_point S a) \<le> 0" |
|
53347 | 1284 |
apply (rule any_closest_point_dot[OF assms(1,2) _ assms(3)]) |
1285 |
using closest_point_exists[OF assms(2)] and assms(3) |
|
1286 |
apply auto |
|
1287 |
done |
|
33175 | 1288 |
|
1289 |
lemma closest_point_lt: |
|
68052 | 1290 |
assumes "convex S" "closed S" "x \<in> S" "x \<noteq> closest_point S a" |
1291 |
shows "dist a (closest_point S a) < dist a x" |
|
53347 | 1292 |
apply (rule ccontr) |
1293 |
apply (rule_tac notE[OF assms(4)]) |
|
1294 |
apply (rule closest_point_unique[OF assms(1-3), of a]) |
|
1295 |
using closest_point_le[OF assms(2), of _ a] |
|
1296 |
apply fastforce |
|
1297 |
done |
|
33175 | 1298 |
|
69618 | 1299 |
lemma setdist_closest_point: |
1300 |
"\<lbrakk>closed S; S \<noteq> {}\<rbrakk> \<Longrightarrow> setdist {a} S = dist a (closest_point S a)" |
|
1301 |
apply (rule setdist_unique) |
|
1302 |
using closest_point_le |
|
1303 |
apply (auto simp: closest_point_in_set) |
|
1304 |
done |
|
1305 |
||
33175 | 1306 |
lemma closest_point_lipschitz: |
68052 | 1307 |
assumes "convex S" |
1308 |
and "closed S" "S \<noteq> {}" |
|
1309 |
shows "dist (closest_point S x) (closest_point S y) \<le> dist x y" |
|
53347 | 1310 |
proof - |
68052 | 1311 |
have "inner (x - closest_point S x) (closest_point S y - closest_point S x) \<le> 0" |
1312 |
and "inner (y - closest_point S y) (closest_point S x - closest_point S y) \<le> 0" |
|
53347 | 1313 |
apply (rule_tac[!] any_closest_point_dot[OF assms(1-2)]) |
1314 |
using closest_point_exists[OF assms(2-3)] |
|
1315 |
apply auto |
|
1316 |
done |
|
1317 |
then show ?thesis unfolding dist_norm and norm_le |
|
68052 | 1318 |
using inner_ge_zero[of "(x - closest_point S x) - (y - closest_point S y)"] |
53347 | 1319 |
by (simp add: inner_add inner_diff inner_commute) |
1320 |
qed |
|
33175 | 1321 |
|
1322 |
lemma continuous_at_closest_point: |
|
68052 | 1323 |
assumes "convex S" |
1324 |
and "closed S" |
|
1325 |
and "S \<noteq> {}" |
|
1326 |
shows "continuous (at x) (closest_point S)" |
|
49531 | 1327 |
unfolding continuous_at_eps_delta |
33175 | 1328 |
using le_less_trans[OF closest_point_lipschitz[OF assms]] by auto |
1329 |
||
1330 |
lemma continuous_on_closest_point: |
|
68052 | 1331 |
assumes "convex S" |
1332 |
and "closed S" |
|
1333 |
and "S \<noteq> {}" |
|
1334 |
shows "continuous_on t (closest_point S)" |
|
53347 | 1335 |
by (metis continuous_at_imp_continuous_on continuous_at_closest_point[OF assms]) |
1336 |
||
63881
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1337 |
proposition closest_point_in_rel_interior: |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1338 |
assumes "closed S" "S \<noteq> {}" and x: "x \<in> affine hull S" |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1339 |
shows "closest_point S x \<in> rel_interior S \<longleftrightarrow> x \<in> rel_interior S" |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1340 |
proof (cases "x \<in> S") |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1341 |
case True |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1342 |
then show ?thesis |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1343 |
by (simp add: closest_point_self) |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1344 |
next |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1345 |
case False |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1346 |
then have "False" if asm: "closest_point S x \<in> rel_interior S" |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1347 |
proof - |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1348 |
obtain e where "e > 0" and clox: "closest_point S x \<in> S" |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1349 |
and e: "cball (closest_point S x) e \<inter> affine hull S \<subseteq> S" |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1350 |
using asm mem_rel_interior_cball by blast |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1351 |
then have clo_notx: "closest_point S x \<noteq> x" |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1352 |
using \<open>x \<notin> S\<close> by auto |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1353 |
define y where "y \<equiv> closest_point S x - |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1354 |
(min 1 (e / norm(closest_point S x - x))) *\<^sub>R (closest_point S x - x)" |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1355 |
have "x - y = (1 - min 1 (e / norm (closest_point S x - x))) *\<^sub>R (x - closest_point S x)" |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1356 |
by (simp add: y_def algebra_simps) |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1357 |
then have "norm (x - y) = abs ((1 - min 1 (e / norm (closest_point S x - x)))) * norm(x - closest_point S x)" |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1358 |
by simp |
68031 | 1359 |
also have "\<dots> < norm(x - closest_point S x)" |
63881
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1360 |
using clo_notx \<open>e > 0\<close> |
70817
dd675800469d
dedicated fact collections for algebraic simplification rules potentially splitting goals
haftmann
parents:
70802
diff
changeset
|
1361 |
by (auto simp: mult_less_cancel_right2 field_split_simps) |
63881
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1362 |
finally have no_less: "norm (x - y) < norm (x - closest_point S x)" . |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1363 |
have "y \<in> affine hull S" |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1364 |
unfolding y_def |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1365 |
by (meson affine_affine_hull clox hull_subset mem_affine_3_minus2 subsetD x) |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1366 |
moreover have "dist (closest_point S x) y \<le> e" |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1367 |
using \<open>e > 0\<close> by (auto simp: y_def min_mult_distrib_right) |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1368 |
ultimately have "y \<in> S" |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1369 |
using subsetD [OF e] by simp |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1370 |
then have "dist x (closest_point S x) \<le> dist x y" |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1371 |
by (simp add: closest_point_le \<open>closed S\<close>) |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1372 |
with no_less show False |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1373 |
by (simp add: dist_norm) |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1374 |
qed |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1375 |
moreover have "x \<notin> rel_interior S" |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1376 |
using rel_interior_subset False by blast |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1377 |
ultimately show ?thesis by blast |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1378 |
qed |
b746b19197bd
lots of new results about topology, affine dimension etc
paulson <lp15@cam.ac.uk>
parents:
63627
diff
changeset
|
1379 |
|
33175 | 1380 |
|
70136 | 1381 |
subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Various point-to-set separating/supporting hyperplane theorems\<close> |
33175 | 1382 |
|
1383 |
lemma supporting_hyperplane_closed_point: |
|
36337 | 1384 |
fixes z :: "'a::{real_inner,heine_borel}" |
68052 | 1385 |
assumes "convex S" |
1386 |
and "closed S" |
|
1387 |
and "S \<noteq> {}" |
|
1388 |
and "z \<notin> S" |
|
1389 |
shows "\<exists>a b. \<exists>y\<in>S. inner a z < b \<and> inner a y = b \<and> (\<forall>x\<in>S. inner a x \<ge> b)" |
|
53347 | 1390 |
proof - |
68052 | 1391 |
obtain y where "y \<in> S" and y: "\<forall>x\<in>S. dist z y \<le> dist z x" |
63075
60a42a4166af
lemmas about dimension, hyperplanes, span, etc.
paulson <lp15@cam.ac.uk>
parents:
63072
diff
changeset
|
1392 |
by (metis distance_attains_inf[OF assms(2-3)]) |
53347 | 1393 |
show ?thesis |
68052 | 1394 |
proof (intro exI bexI conjI ballI) |
1395 |
show "(y - z) \<bullet> z < (y - z) \<bullet> y" |
|
1396 |
by (metis \<open>y \<in> S\<close> assms(4) diff_gt_0_iff_gt inner_commute inner_diff_left inner_gt_zero_iff right_minus_eq) |
|
1397 |
show "(y - z) \<bullet> y \<le> (y - z) \<bullet> x" if "x \<in> S" for x |
|
1398 |
proof (rule ccontr) |
|
1399 |
have *: "\<And>u. 0 \<le> u \<and> u \<le> 1 \<longrightarrow> dist z y \<le> dist z ((1 - u) *\<^sub>R y + u *\<^sub>R x)" |
|
1400 |
using assms(1)[unfolded convex_alt] and y and \<open>x\<in>S\<close> and \<open>y\<in>S\<close> by auto |
|
1401 |
assume "\<not> (y - z) \<bullet> y \<le> (y - z) \<bullet> x" |
|
1402 |
then obtain v where "v > 0" "v \<le> 1" "dist (y + v *\<^sub>R (x - y)) z < dist y z" |
|
1403 |
using closer_point_lemma[of z y x] by (auto simp: inner_diff) |
|
1404 |
then show False |
|
1405 |
using *[of v] by (auto simp: dist_commute algebra_simps) |
|
1406 |
qed |
|
1407 |
qed (use \<open>y \<in> S\<close> in auto) |
|
33175 | 1408 |
qed |
1409 |
||
1410 |
lemma separating_hyperplane_closed_point: |
|
36337 | 1411 |
fixes z :: "'a::{real_inner,heine_borel}" |
68052 | 1412 |
assumes "convex S" |
1413 |
and "closed S" |
|
1414 |
and "z \<notin> S" |
|
1415 |
shows "\<exists>a b. inner a z < b \<and> (\<forall>x\<in>S. inner a x > b)" |
|
1416 |
proof (cases "S = {}") |
|
53347 | 1417 |
case True |
1418 |
then show ?thesis |
|
68052 | 1419 |
by (simp add: gt_ex) |
33175 | 1420 |
next |
53347 | 1421 |
case False |
68052 | 1422 |
obtain y where "y \<in> S" and y: "\<And>x. x \<in> S \<Longrightarrow> dist z y \<le> dist z x" |
62381
a6479cb85944
New and revised material for (multivariate) analysis
paulson <lp15@cam.ac.uk>
parents:
62131
diff
changeset
|
1423 |
by (metis distance_attains_inf[OF assms(2) False]) |
53347 | 1424 |
show ?thesis |
68052 | 1425 |
proof (intro exI conjI ballI) |
1426 |
show "(y - z) \<bullet> z < inner (y - z) z + (norm (y - z))\<^sup>2 / 2" |
|
1427 |
using \<open>y\<in>S\<close> \<open>z\<notin>S\<close> by auto |
|
1428 |
next |
|
53347 | 1429 |
fix x |
68052 | 1430 |
assume "x \<in> S" |
1431 |
have "False" if *: "0 < inner (z - y) (x - y)" |
|
53347 | 1432 |
proof - |
68052 | 1433 |
obtain u where "u > 0" "u \<le> 1" "dist (y + u *\<^sub>R (x - y)) z < dist y z" |
1434 |
using * closer_point_lemma by blast |
|
1435 |
then show False using y[of "y + u *\<^sub>R (x - y)"] convexD_alt [OF \<open>convex S\<close>] |
|
1436 |
using \<open>x\<in>S\<close> \<open>y\<in>S\<close> by (auto simp: dist_commute algebra_simps) |
|
53347 | 1437 |
qed |
1438 |
moreover have "0 < (norm (y - z))\<^sup>2" |
|
68052 | 1439 |
using \<open>y\<in>S\<close> \<open>z\<notin>S\<close> by auto |
53347 | 1440 |
then have "0 < inner (y - z) (y - z)" |
1441 |
unfolding power2_norm_eq_inner by simp |
|
68052 | 1442 |
ultimately show "(y - z) \<bullet> z + (norm (y - z))\<^sup>2 / 2 < (y - z) \<bullet> x" |
1443 |
by (force simp: field_simps power2_norm_eq_inner inner_commute inner_diff) |
|
1444 |
qed |
|
33175 | 1445 |
qed |
1446 |
||
1447 |
lemma separating_hyperplane_closed_0: |
|
68052 | 1448 |
assumes "convex (S::('a::euclidean_space) set)" |
1449 |
and "closed S" |
|
1450 |
and "0 \<notin> S" |
|
1451 |
shows "\<exists>a b. a \<noteq> 0 \<and> 0 < b \<and> (\<forall>x\<in>S. inner a x > b)" |
|
1452 |
proof (cases "S = {}") |
|
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50104
diff
changeset
|
1453 |
case True |
68052 | 1454 |
have "(SOME i. i\<in>Basis) \<noteq> (0::'a)" |
1455 |
by (metis Basis_zero SOME_Basis) |
|
53347 | 1456 |
then show ?thesis |
68052 | 1457 |
using True zero_less_one by blast |
53347 | 1458 |
next |
1459 |
case False |
|
1460 |
then show ?thesis |
|
1461 |
using False using separating_hyperplane_closed_point[OF assms] |
|
68052 | 1462 |
by (metis all_not_in_conv inner_zero_left inner_zero_right less_eq_real_def not_le) |
53347 | 1463 |
qed |
1464 |
||
33175 | 1465 |
|
70136 | 1466 |
subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Now set-to-set for closed/compact sets\<close> |
33175 | 1467 |
|
1468 |
lemma separating_hyperplane_closed_compact: |
|
65038
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1469 |
fixes S :: "'a::euclidean_space set" |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1470 |
assumes "convex S" |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1471 |
and "closed S" |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1472 |
and "convex T" |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1473 |
and "compact T" |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1474 |
and "T \<noteq> {}" |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1475 |
and "S \<inter> T = {}" |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1476 |
shows "\<exists>a b. (\<forall>x\<in>S. inner a x < b) \<and> (\<forall>x\<in>T. inner a x > b)" |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1477 |
proof (cases "S = {}") |
33175 | 1478 |
case True |
65038
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1479 |
obtain b where b: "b > 0" "\<forall>x\<in>T. norm x \<le> b" |
53347 | 1480 |
using compact_imp_bounded[OF assms(4)] unfolding bounded_pos by auto |
1481 |
obtain z :: 'a where z: "norm z = b + 1" |
|
1482 |
using vector_choose_size[of "b + 1"] and b(1) by auto |
|
65038
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1483 |
then have "z \<notin> T" using b(2)[THEN bspec[where x=z]] by auto |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1484 |
then obtain a b where ab: "inner a z < b" "\<forall>x\<in>T. b < inner a x" |
53347 | 1485 |
using separating_hyperplane_closed_point[OF assms(3) compact_imp_closed[OF assms(4)], of z] |
1486 |
by auto |
|
1487 |
then show ?thesis |
|
1488 |
using True by auto |
|
33175 | 1489 |
next |
53347 | 1490 |
case False |
65038
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1491 |
then obtain y where "y \<in> S" by auto |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1492 |
obtain a b where "0 < b" "\<forall>x \<in> (\<Union>x\<in> S. \<Union>y \<in> T. {x - y}). b < inner a x" |
33175 | 1493 |
using separating_hyperplane_closed_point[OF convex_differences[OF assms(1,3)], of 0] |
53347 | 1494 |
using closed_compact_differences[OF assms(2,4)] |
65038
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1495 |
using assms(6) by auto |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1496 |
then have ab: "\<forall>x\<in>S. \<forall>y\<in>T. b + inner a y < inner a x" |
53347 | 1497 |
apply - |
1498 |
apply rule |
|
1499 |
apply rule |
|
1500 |
apply (erule_tac x="x - y" in ballE) |
|
68031 | 1501 |
apply (auto simp: inner_diff) |
53347 | 1502 |
done |
69260
0a9688695a1b
removed relics of ASCII syntax for indexed big operators
haftmann
parents:
69064
diff
changeset
|
1503 |
define k where "k = (SUP x\<in>T. a \<bullet> x)" |
53347 | 1504 |
show ?thesis |
1505 |
apply (rule_tac x="-a" in exI) |
|
1506 |
apply (rule_tac x="-(k + b / 2)" in exI) |
|
54263
c4159fe6fa46
move Lubs from HOL to HOL-Library (replaced by conditionally complete lattices)
hoelzl
parents:
54258
diff
changeset
|
1507 |
apply (intro conjI ballI) |
53347 | 1508 |
unfolding inner_minus_left and neg_less_iff_less |
1509 |
proof - |
|
65038
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1510 |
fix x assume "x \<in> T" |
54263
c4159fe6fa46
move Lubs from HOL to HOL-Library (replaced by conditionally complete lattices)
hoelzl
parents:
54258
diff
changeset
|
1511 |
then have "inner a x - b / 2 < k" |
53347 | 1512 |
unfolding k_def |
54263
c4159fe6fa46
move Lubs from HOL to HOL-Library (replaced by conditionally complete lattices)
hoelzl
parents:
54258
diff
changeset
|
1513 |
proof (subst less_cSUP_iff) |
65038
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1514 |
show "T \<noteq> {}" by fact |
67399 | 1515 |
show "bdd_above ((\<bullet>) a ` T)" |
65038
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1516 |
using ab[rule_format, of y] \<open>y \<in> S\<close> |
54263
c4159fe6fa46
move Lubs from HOL to HOL-Library (replaced by conditionally complete lattices)
hoelzl
parents:
54258
diff
changeset
|
1517 |
by (intro bdd_aboveI2[where M="inner a y - b"]) (auto simp: field_simps intro: less_imp_le) |
60420 | 1518 |
qed (auto intro!: bexI[of _ x] \<open>0<b\<close>) |
54263
c4159fe6fa46
move Lubs from HOL to HOL-Library (replaced by conditionally complete lattices)
hoelzl
parents:
54258
diff
changeset
|
1519 |
then show "inner a x < k + b / 2" |
c4159fe6fa46
move Lubs from HOL to HOL-Library (replaced by conditionally complete lattices)
hoelzl
parents:
54258
diff
changeset
|
1520 |
by auto |
33175 | 1521 |
next |
53347 | 1522 |
fix x |
65038
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1523 |
assume "x \<in> S" |
53347 | 1524 |
then have "k \<le> inner a x - b" |
1525 |
unfolding k_def |
|
54263
c4159fe6fa46
move Lubs from HOL to HOL-Library (replaced by conditionally complete lattices)
hoelzl
parents:
54258
diff
changeset
|
1526 |
apply (rule_tac cSUP_least) |
53347 | 1527 |
using assms(5) |
1528 |
using ab[THEN bspec[where x=x]] |
|
1529 |
apply auto |
|
1530 |
done |
|
1531 |
then show "k + b / 2 < inner a x" |
|
60420 | 1532 |
using \<open>0 < b\<close> by auto |
33175 | 1533 |
qed |
1534 |
qed |
|
1535 |
||
1536 |
lemma separating_hyperplane_compact_closed: |
|
65038
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1537 |
fixes S :: "'a::euclidean_space set" |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1538 |
assumes "convex S" |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1539 |
and "compact S" |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1540 |
and "S \<noteq> {}" |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1541 |
and "convex T" |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1542 |
and "closed T" |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1543 |
and "S \<inter> T = {}" |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1544 |
shows "\<exists>a b. (\<forall>x\<in>S. inner a x < b) \<and> (\<forall>x\<in>T. inner a x > b)" |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1545 |
proof - |
9391ea7daa17
new lemmas about segments, etc. Also recast some theorems to use Union rather than general set comprehensions
paulson <lp15@cam.ac.uk>
parents:
65036
diff
changeset
|
1546 |
obtain a b where "(\<forall>x\<in>T. inner a x < b) \<and> (\<forall>x\<in>S. b < inner a x)" |
53347 | 1547 |
using separating_hyperplane_closed_compact[OF assms(4-5,1-2,3)] and assms(6) |
1548 |
by auto |
|
1549 |
then show ?thesis |
|
1550 |
apply (rule_tac x="-a" in exI) |
|
68031 | 1551 |
apply (rule_tac x="-b" in exI, auto) |
53347 | 1552 |
done |
1553 |
qed |
|
1554 |
||
33175 | 1555 |
|
70136 | 1556 |
subsubsection\<^marker>\<open>tag unimportant\<close> \<open>General case without assuming closure and getting non-strict separation\<close> |
33175 | 1557 |
|
1558 |
lemma separating_hyperplane_set_0: |
|
68031 | 1559 |
assumes "convex S" "(0::'a::euclidean_space) \<notin> S" |
1560 |
shows "\<exists>a. a \<noteq> 0 \<and> (\<forall>x\<in>S. 0 \<le> inner a x)" |
|
53347 | 1561 |
proof - |
1562 |
let ?k = "\<lambda>c. {x::'a. 0 \<le> inner c x}" |
|
68031 | 1563 |
have *: "frontier (cball 0 1) \<inter> \<Inter>f \<noteq> {}" if as: "f \<subseteq> ?k ` S" "finite f" for f |
53347 | 1564 |
proof - |
68031 | 1565 |
obtain c where c: "f = ?k ` c" "c \<subseteq> S" "finite c" |
53347 | 1566 |
using finite_subset_image[OF as(2,1)] by auto |
1567 |
then obtain a b where ab: "a \<noteq> 0" "0 < b" "\<forall>x\<in>convex hull c. b < inner a x" |
|
33175 | 1568 |
using separating_hyperplane_closed_0[OF convex_convex_hull, of c] |
1569 |
using finite_imp_compact_convex_hull[OF c(3), THEN compact_imp_closed] and assms(2) |
|
53347 | 1570 |
using subset_hull[of convex, OF assms(1), symmetric, of c] |
61609
77b453bd616f
Coercion "real" now has type nat => real only and is no longer overloaded. Type class "real_of" is gone. Many duplicate theorems removed.
paulson <lp15@cam.ac.uk>
parents:
61531
diff
changeset
|
1571 |
by force |
53347 | 1572 |
then have "\<exists>x. norm x = 1 \<and> (\<forall>y\<in>c. 0 \<le> inner y x)" |
1573 |
apply (rule_tac x = "inverse(norm a) *\<^sub>R a" in exI) |
|
1574 |
using hull_subset[of c convex] |
|
1575 |
unfolding subset_eq and inner_scaleR |
|
68031 | 1576 |
by (auto simp: inner_commute del: ballE elim!: ballE) |
53347 | 1577 |
then show "frontier (cball 0 1) \<inter> \<Inter>f \<noteq> {}" |
62381
a6479cb85944
New and revised material for (multivariate) analysis
paulson <lp15@cam.ac.uk>
parents:
62131
diff
changeset
|
1578 |
unfolding c(1) frontier_cball sphere_def dist_norm by auto |
a6479cb85944
New and revised material for (multivariate) analysis
paulson <lp15@cam.ac.uk>
parents:
62131
diff
changeset
|
1579 |
qed |
68031 | 1580 |
have "frontier (cball 0 1) \<inter> (\<Inter>(?k ` S)) \<noteq> {}" |
62381
a6479cb85944
New and revised material for (multivariate) analysis
paulson <lp15@cam.ac.uk>
parents:
62131
diff
changeset
|
1581 |
apply (rule compact_imp_fip) |
a6479cb85944
New and revised material for (multivariate) analysis
paulson <lp15@cam.ac.uk>
parents:
62131
diff
changeset
|
1582 |
apply (rule compact_frontier[OF compact_cball]) |
a6479cb85944
New and revised material for (multivariate) analysis
paulson <lp15@cam.ac.uk>
parents:
62131
diff
changeset
|
1583 |
using * closed_halfspace_ge |
a6479cb85944
New and revised material for (multivariate) analysis
paulson <lp15@cam.ac.uk>
parents:
62131
diff
changeset
|
1584 |
by auto |
68031 | 1585 |
then obtain x where "norm x = 1" "\<forall>y\<in>S. x\<in>?k y" |
62381
a6479cb85944
New and revised material for (multivariate) analysis
paulson <lp15@cam.ac.uk>
parents:
62131
diff
changeset
|
1586 |
unfolding frontier_cball dist_norm sphere_def by auto |
53347 | 1587 |
then show ?thesis |
62381
a6479cb85944
New and revised material for (multivariate) analysis
paulson <lp15@cam.ac.uk>
parents:
62131
diff
changeset
|
1588 |
by (metis inner_commute mem_Collect_eq norm_eq_zero zero_neq_one) |
53347 | 1589 |
qed |
33175 | 1590 |
|
1591 |
lemma separating_hyperplane_sets: |
|
68031 | 1592 |
fixes S T :: "'a::euclidean_space set" |
1593 |
assumes "convex S" |
|
1594 |
and "convex T" |
|
1595 |
and "S \<noteq> {}" |
|
1596 |
and "T \<noteq> {}" |
|
1597 |
and "S \<inter> T = {}" |
|
1598 |
shows "\<exists>a b. a \<noteq> 0 \<and> (\<forall>x\<in>S. inner a x \<le> b) \<and> (\<forall>x\<in>T. inner a x \<ge> b)" |
|
53347 | 1599 |
proof - |
1600 |
from separating_hyperplane_set_0[OF convex_differences[OF assms(2,1)]] |
|
68031 | 1601 |
obtain a where "a \<noteq> 0" "\<forall>x\<in>{x - y |x y. x \<in> T \<and> y \<in> S}. 0 \<le> inner a x" |
1602 |
using assms(3-5) by force |
|
1603 |
then have *: "\<And>x y. x \<in> T \<Longrightarrow> y \<in> S \<Longrightarrow> inner a y \<le> inner a x" |
|
1604 |
by (force simp: inner_diff) |
|
1605 |
then have bdd: "bdd_above (((\<bullet>) a)`S)" |
|
1606 |
using \<open>T \<noteq> {}\<close> by (auto intro: bdd_aboveI2[OF *]) |
|
54263
c4159fe6fa46
move Lubs from HOL to HOL-Library (replaced by conditionally complete lattices)
hoelzl
parents:
54258
diff
changeset
|
1607 |
show ?thesis |
60420 | 1608 |
using \<open>a\<noteq>0\<close> |
69260
0a9688695a1b
removed relics of ASCII syntax for indexed big operators
haftmann
parents:
69064
diff
changeset
|
1609 |
by (intro exI[of _ a] exI[of _ "SUP x\<in>S. a \<bullet> x"]) |
68031 | 1610 |
(auto intro!: cSUP_upper bdd cSUP_least \<open>a \<noteq> 0\<close> \<open>S \<noteq> {}\<close> *) |
60420 | 1611 |
qed |
1612 |
||
1613 |
||
70136 | 1614 |
subsection\<^marker>\<open>tag unimportant\<close> \<open>More convexity generalities\<close> |
33175 | 1615 |
|
62948
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
1616 |
lemma convex_closure [intro,simp]: |
68031 | 1617 |
fixes S :: "'a::real_normed_vector set" |
1618 |
assumes "convex S" |
|
1619 |
shows "convex (closure S)" |
|
53676 | 1620 |
apply (rule convexI) |
1621 |
apply (unfold closure_sequential, elim exE) |
|
1622 |
apply (rule_tac x="\<lambda>n. u *\<^sub>R xa n + v *\<^sub>R xb n" in exI) |
|
53347 | 1623 |
apply (rule,rule) |
53676 | 1624 |
apply (rule convexD [OF assms]) |
53347 | 1625 |
apply (auto del: tendsto_const intro!: tendsto_intros) |
1626 |
done |
|
33175 | 1627 |
|
62948
7700f467892b
lots of new theorems for multivariate analysis
paulson <lp15@cam.ac.uk>
parents:
62843
diff
changeset
|
1628 |
lemma convex_interior [intro,simp]: |
68031 | 1629 |
fixes S :: "'a::real_normed_vector set" |
1630 |
assumes "convex S" |
|
1631 |
shows "convex (interior S)" |
|
53347 | 1632 |
unfolding convex_alt Ball_def mem_interior |
68052 | 1633 |
proof clarify |
53347 | 1634 |
fix x y u |
1635 |
assume u: "0 \<le> u" "u \<le> (1::real)" |
|
1636 |
fix e d |
|
68031 | 1637 |
assume ed: "ball x e \<subseteq> S" "ball y d \<subseteq> S" "0<d" "0<e" |
1638 |
show "\<exists>e>0. ball ((1 - u) *\<^sub>R x + u *\<^sub>R y) e \<subseteq> S" |
|
68052 | 1639 |
proof (intro exI conjI subsetI) |
53347 | 1640 |
fix z |
1641 |
assume "z \<in> ball ((1 - u) *\<^sub>R x + u *\<^sub>R y) (min d e)" |
|
68031 | 1642 |
then have "(1- u) *\<^sub>R (z - u *\<^sub>R (y - x)) + u *\<^sub>R (z + (1 - u) *\<^sub>R (y - x)) \<in> S" |
53347 | 1643 |
apply (rule_tac assms[unfolded convex_alt, rule_format]) |
1644 |
using ed(1,2) and u |
|
1645 |
unfolding subset_eq mem_ball Ball_def dist_norm |
|
68031 | 1646 |
apply (auto simp: algebra_simps) |
53347 | 1647 |
done |
68031 | 1648 |
then show "z \<in> S" |
1649 |
using u by (auto simp: algebra_simps) |
|
53347 | 1650 |
qed(insert u ed(3-4), auto) |
1651 |
qed |
|
33175 | 1652 |
|
68031 | 1653 |
lemma convex_hull_eq_empty[simp]: "convex hull S = {} \<longleftrightarrow> S = {}" |
1654 |
using hull_subset[of S convex] convex_hull_empty by auto |
|
33175 | 1655 |
|
53347 | 1656 |
|
70136 | 1657 |
subsection\<^marker>\<open>tag unimportant\<close> \<open>Convex set as intersection of halfspaces\<close> |
33175 | 1658 |
|
1659 |
lemma convex_halfspace_intersection: |
|
37489
44e42d392c6e
Introduce a type class for euclidean spaces, port most lemmas from real^'n to this type class.
hoelzl
parents:
36844
diff
changeset
|
1660 |
fixes s :: "('a::euclidean_space) set" |
33175 | 1661 |
assumes "closed s" "convex s" |
60585 | 1662 |
shows "s = \<Inter>{h. s \<subseteq> h \<and> (\<exists>a b. h = {x. inner a x \<le> b})}" |
68031 | 1663 |
apply (rule set_eqI, rule) |
53347 | 1664 |
unfolding Inter_iff Ball_def mem_Collect_eq |
1665 |
apply (rule,rule,erule conjE) |
|
1666 |
proof - |
|
54465 | 1667 |
fix x |
53347 | 1668 |
assume "\<forall>xa. s \<subseteq> xa \<and> (\<exists>a b. xa = {x. inner a x \<le> b}) \<longrightarrow> x \<in> xa" |
1669 |
then have "\<forall>a b. s \<subseteq> {x. inner a x \<le> b} \<longrightarrow> x \<in> {x. inner a x \<le> b}" |
|
1670 |
by blast |
|
1671 |
then show "x \<in> s" |
|
1672 |
apply (rule_tac ccontr) |
|
1673 |
apply (drule separating_hyperplane_closed_point[OF assms(2,1)]) |
|
1674 |
apply (erule exE)+ |
|
1675 |
apply (erule_tac x="-a" in allE) |
|
68031 | 1676 |
apply (erule_tac x="-b" in allE, auto) |
53347 | 1677 |
done |
33175 | 1678 |
qed auto |
1679 |
||
53347 | 1680 |
|
70136 | 1681 |
subsection\<^marker>\<open>tag unimportant\<close> \<open>Convexity of general and special intervals\<close> |
33175 | 1682 |
|
1683 |
lemma is_interval_convex: |
|
68052 | 1684 |
fixes S :: "'a::euclidean_space set" |
1685 |
assumes "is_interval S" |
|
1686 |
shows "convex S" |
|
37732
6432bf0d7191
generalize type of is_interval to class euclidean_space
huffman
parents:
37673
diff
changeset
|
1687 |
proof (rule convexI) |
53348 | 1688 |
fix x y and u v :: real |
68052 | 1689 |
assume as: "x \<in> S" "y \<in> S" "0 \<le> u" "0 \<le> v" "u + v = 1" |
53348 | 1690 |
then have *: "u = 1 - v" "1 - v \<ge> 0" and **: "v = 1 - u" "1 - u \<ge> 0" |
1691 |
by auto |
|
1692 |
{ |
|
1693 |
fix a b |
|
1694 |
assume "\<not> b \<le> u * a + v * b" |
|
1695 |
then have "u * a < (1 - v) * b" |
|
68031 | 1696 |
unfolding not_le using as(4) by (auto simp: field_simps) |
53348 | 1697 |
then have "a < b" |
1698 |
unfolding * using as(4) *(2) |
|
1699 |
apply (rule_tac mult_left_less_imp_less[of "1 - v"]) |
|
68031 | 1700 |
apply (auto simp: field_simps) |
53348 | 1701 |
done |
1702 |
then have "a \<le> u * a + v * b" |
|
1703 |
unfolding * using as(4) |
|
68031 | 1704 |
by (auto simp: field_simps intro!:mult_right_mono) |
53348 | 1705 |
} |
1706 |
moreover |
|
1707 |
{ |
|
1708 |
fix a b |
|
1709 |
assume "\<not> u * a + v * b \<le> a" |
|
1710 |
then have "v * b > (1 - u) * a" |
|
68031 | 1711 |
unfolding not_le using as(4) by (auto simp: field_simps) |
53348 | 1712 |
then have "a < b" |
1713 |
unfolding * using as(4) |
|
1714 |
apply (rule_tac mult_left_less_imp_less) |
|
68031 | 1715 |
apply (auto simp: field_simps) |
53348 | 1716 |
done |
1717 |
then have "u * a + v * b \<le> b" |
|
1718 |
unfolding ** |
|
1719 |
using **(2) as(3) |
|
68031 | 1720 |
by (auto simp: field_simps intro!:mult_right_mono) |
53348 | 1721 |
} |
68052 | 1722 |
ultimately show "u *\<^sub>R x + v *\<^sub>R y \<in> S" |
53348 | 1723 |
apply - |
1724 |
apply (rule assms[unfolded is_interval_def, rule_format, OF as(1,2)]) |
|
1725 |
using as(3-) DIM_positive[where 'a='a] |
|
1726 |
apply (auto simp: inner_simps) |
|
1727 |
done |
|
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50104
diff
changeset
|
1728 |
qed |
33175 | 1729 |
|
1730 |
lemma is_interval_connected: |
|
68052 | 1731 |
fixes S :: "'a::euclidean_space set" |
1732 |
shows "is_interval S \<Longrightarrow> connected S" |
|
33175 | 1733 |
using is_interval_convex convex_connected by auto |
1734 |
||
62618
f7f2467ab854
Refactoring (moving theorems into better locations), plus a bit of new material
paulson <lp15@cam.ac.uk>
parents:
62533
diff
changeset
|
1735 |
lemma convex_box [simp]: "convex (cbox a b)" "convex (box a (b::'a::euclidean_space))" |
56188 | 1736 |
apply (rule_tac[!] is_interval_convex)+ |
56189
c4daa97ac57a
removed dependencies on theory Ordered_Euclidean_Space
immler
parents:
56188
diff
changeset
|
1737 |
using is_interval_box is_interval_cbox |
53348 | 1738 |
apply auto |
1739 |
done |
|
33175 | 1740 |
|
63928
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1741 |
text\<open>A non-singleton connected set is perfect (i.e. has no isolated points). \<close> |
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1742 |
lemma connected_imp_perfect: |
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1743 |
fixes a :: "'a::metric_space" |
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1744 |
assumes "connected S" "a \<in> S" and S: "\<And>x. S \<noteq> {x}" |
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1745 |
shows "a islimpt S" |
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1746 |
proof - |
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1747 |
have False if "a \<in> T" "open T" "\<And>y. \<lbrakk>y \<in> S; y \<in> T\<rbrakk> \<Longrightarrow> y = a" for T |
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1748 |
proof - |
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1749 |
obtain e where "e > 0" and e: "cball a e \<subseteq> T" |
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1750 |
using \<open>open T\<close> \<open>a \<in> T\<close> by (auto simp: open_contains_cball) |
69922
4a9167f377b0
new material about topology, etc.; also fixes for yesterday's
paulson <lp15@cam.ac.uk>
parents:
69710
diff
changeset
|
1751 |
have "openin (top_of_set S) {a}" |
63928
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1752 |
unfolding openin_open using that \<open>a \<in> S\<close> by blast |
69922
4a9167f377b0
new material about topology, etc.; also fixes for yesterday's
paulson <lp15@cam.ac.uk>
parents:
69710
diff
changeset
|
1753 |
moreover have "closedin (top_of_set S) {a}" |
63928
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1754 |
by (simp add: assms) |
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1755 |
ultimately show "False" |
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1756 |
using \<open>connected S\<close> connected_clopen S by blast |
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1757 |
qed |
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1758 |
then show ?thesis |
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1759 |
unfolding islimpt_def by blast |
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1760 |
qed |
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1761 |
|
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1762 |
lemma connected_imp_perfect_aff_dim: |
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1763 |
"\<lbrakk>connected S; aff_dim S \<noteq> 0; a \<in> S\<rbrakk> \<Longrightarrow> a islimpt S" |
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1764 |
using aff_dim_sing connected_imp_perfect by blast |
d81fb5b46a5c
new material about topological concepts, etc
paulson <lp15@cam.ac.uk>
parents:
63918
diff
changeset
|
1765 |
|
70136 | 1766 |
subsection\<^marker>\<open>tag unimportant\<close> \<open>On \<open>real\<close>, \<open>is_interval\<close>, \<open>convex\<close> and \<open>connected\<close> are all equivalent\<close> |
33175 | 1767 |
|
67685
bdff8bf0a75b
moved theorems from AFP/Affine_Arithmetic and AFP/Ordinary_Differential_Equations
immler
parents:
67613
diff
changeset
|
1768 |
lemma mem_is_interval_1_I: |
bdff8bf0a75b
moved theorems from AFP/Affine_Arithmetic and AFP/Ordinary_Differential_Equations
immler
parents:
67613
diff
changeset
|
1769 |
fixes a b c::real |
bdff8bf0a75b
moved theorems from AFP/Affine_Arithmetic and AFP/Ordinary_Differential_Equations
immler
parents:
67613
diff
changeset
|
1770 |
assumes "is_interval S" |
bdff8bf0a75b
moved theorems from AFP/Affine_Arithmetic and AFP/Ordinary_Differential_Equations
immler
parents:
67613
diff
changeset
|
1771 |
assumes "a \<in> S" "c \<in> S" |
bdff8bf0a75b
moved theorems from AFP/Affine_Arithmetic and AFP/Ordinary_Differential_Equations
immler
parents:
67613
diff
changeset
|
1772 |
assumes "a \<le> b" "b \<le> c" |
bdff8bf0a75b
moved theorems from AFP/Affine_Arithmetic and AFP/Ordinary_Differential_Equations
immler
parents:
67613
diff
changeset
|
1773 |
shows "b \<in> S" |
bdff8bf0a75b
moved theorems from AFP/Affine_Arithmetic and AFP/Ordinary_Differential_Equations
immler
parents:
67613
diff
changeset
|
1774 |
using assms is_interval_1 by blast |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
1775 |
|
54465 | 1776 |
lemma is_interval_connected_1: |
1777 |
fixes s :: "real set" |
|
1778 |
shows "is_interval s \<longleftrightarrow> connected s" |
|
1779 |
apply rule |
|
1780 |
apply (rule is_interval_connected, assumption) |
|
1781 |
unfolding is_interval_1 |
|
1782 |
apply rule |
|
1783 |
apply rule |
|
1784 |
apply rule |
|
1785 |
apply rule |
|
1786 |
apply (erule conjE) |
|
64773
223b2ebdda79
Many new theorems, and more tidying
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1787 |
apply (rule ccontr) |
54465 | 1788 |
proof - |
1789 |
fix a b x |
|
1790 |
assume as: "connected s" "a \<in> s" "b \<in> s" "a \<le> x" "x \<le> b" "x \<notin> s" |
|
1791 |
then have *: "a < x" "x < b" |
|
1792 |
unfolding not_le [symmetric] by auto |
|
1793 |
let ?halfl = "{..<x} " |
|
1794 |
let ?halfr = "{x<..}" |
|
1795 |
{ |
|
1796 |
fix y |
|
1797 |
assume "y \<in> s" |
|
60420 | 1798 |
with \<open>x \<notin> s\<close> have "x \<noteq> y" by auto |
54465 | 1799 |
then have "y \<in> ?halfr \<union> ?halfl" by auto |
1800 |
} |
|
1801 |
moreover have "a \<in> ?halfl" "b \<in> ?halfr" using * by auto |
|
1802 |
then have "?halfl \<inter> s \<noteq> {}" "?halfr \<inter> s \<noteq> {}" |
|
1803 |
using as(2-3) by auto |
|
1804 |
ultimately show False |
|
1805 |
apply (rule_tac notE[OF as(1)[unfolded connected_def]]) |
|
1806 |
apply (rule_tac x = ?halfl in exI) |
|
68031 | 1807 |
apply (rule_tac x = ?halfr in exI, rule) |
1808 |
apply (rule open_lessThan, rule) |
|
1809 |
apply (rule open_greaterThan, auto) |
|
54465 | 1810 |
done |
1811 |
qed |
|
33175 | 1812 |
|
1813 |
lemma is_interval_convex_1: |
|
54465 | 1814 |
fixes s :: "real set" |
1815 |
shows "is_interval s \<longleftrightarrow> convex s" |
|
1816 |
by (metis is_interval_convex convex_connected is_interval_connected_1) |
|
33175 | 1817 |
|
64773
223b2ebdda79
Many new theorems, and more tidying
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1818 |
lemma connected_compact_interval_1: |
223b2ebdda79
Many new theorems, and more tidying
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1819 |
"connected S \<and> compact S \<longleftrightarrow> (\<exists>a b. S = {a..b::real})" |
223b2ebdda79
Many new theorems, and more tidying
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1820 |
by (auto simp: is_interval_connected_1 [symmetric] is_interval_compact) |
223b2ebdda79
Many new theorems, and more tidying
paulson <lp15@cam.ac.uk>
parents:
64394
diff
changeset
|
1821 |
|
61518
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1822 |
lemma connected_convex_1: |
54465 | 1823 |
fixes s :: "real set" |
1824 |
shows "connected s \<longleftrightarrow> convex s" |
|
1825 |
by (metis is_interval_convex convex_connected is_interval_connected_1) |
|
53348 | 1826 |
|
61518
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1827 |
lemma connected_convex_1_gen: |
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1828 |
fixes s :: "'a :: euclidean_space set" |
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1829 |
assumes "DIM('a) = 1" |
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1830 |
shows "connected s \<longleftrightarrow> convex s" |
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1831 |
proof - |
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1832 |
obtain f:: "'a \<Rightarrow> real" where linf: "linear f" and "inj f" |
68072
493b818e8e10
added Johannes' generalizations Modules.thy and Vector_Spaces.thy; adapted HOL and HOL-Analysis accordingly
immler
parents:
67982
diff
changeset
|
1833 |
using subspace_isomorphism[OF subspace_UNIV subspace_UNIV, |
493b818e8e10
added Johannes' generalizations Modules.thy and Vector_Spaces.thy; adapted HOL and HOL-Analysis accordingly
immler
parents:
67982
diff
changeset
|
1834 |
where 'a='a and 'b=real] |
493b818e8e10
added Johannes' generalizations Modules.thy and Vector_Spaces.thy; adapted HOL and HOL-Analysis accordingly
immler
parents:
67982
diff
changeset
|
1835 |
unfolding Euclidean_Space.dim_UNIV |
493b818e8e10
added Johannes' generalizations Modules.thy and Vector_Spaces.thy; adapted HOL and HOL-Analysis accordingly
immler
parents:
67982
diff
changeset
|
1836 |
by (auto simp: assms) |
61518
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1837 |
then have "f -` (f ` s) = s" |
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1838 |
by (simp add: inj_vimage_image_eq) |
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1839 |
then show ?thesis |
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1840 |
by (metis connected_convex_1 convex_linear_vimage linf convex_connected connected_linear_image) |
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1841 |
qed |
53348 | 1842 |
|
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:
69922
diff
changeset
|
1843 |
lemma [simp]: |
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:
69922
diff
changeset
|
1844 |
fixes r s::real |
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:
69922
diff
changeset
|
1845 |
shows is_interval_io: "is_interval {..<r}" |
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:
69922
diff
changeset
|
1846 |
and is_interval_oi: "is_interval {r<..}" |
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:
69922
diff
changeset
|
1847 |
and is_interval_oo: "is_interval {r<..<s}" |
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:
69922
diff
changeset
|
1848 |
and is_interval_oc: "is_interval {r<..s}" |
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:
69922
diff
changeset
|
1849 |
and is_interval_co: "is_interval {r..<s}" |
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:
69922
diff
changeset
|
1850 |
by (simp_all add: is_interval_convex_1) |
67685
bdff8bf0a75b
moved theorems from AFP/Affine_Arithmetic and AFP/Ordinary_Differential_Equations
immler
parents:
67613
diff
changeset
|
1851 |
|
70136 | 1852 |
subsection\<^marker>\<open>tag unimportant\<close> \<open>Another intermediate value theorem formulation\<close> |
33175 | 1853 |
|
53348 | 1854 |
lemma ivt_increasing_component_on_1: |
61609
77b453bd616f
Coercion "real" now has type nat => real only and is no longer overloaded. Type class "real_of" is gone. Many duplicate theorems removed.
paulson <lp15@cam.ac.uk>
parents:
61531
diff
changeset
|
1855 |
fixes f :: "real \<Rightarrow> 'a::euclidean_space" |
53348 | 1856 |
assumes "a \<le> b" |
61518
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1857 |
and "continuous_on {a..b} f" |
53348 | 1858 |
and "(f a)\<bullet>k \<le> y" "y \<le> (f b)\<bullet>k" |
61518
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1859 |
shows "\<exists>x\<in>{a..b}. (f x)\<bullet>k = y" |
56188 | 1860 |
proof - |
1861 |
have "f a \<in> f ` cbox a b" "f b \<in> f ` cbox a b" |
|
53348 | 1862 |
apply (rule_tac[!] imageI) |
1863 |
using assms(1) |
|
1864 |
apply auto |
|
1865 |
done |
|
1866 |
then show ?thesis |
|
56188 | 1867 |
using connected_ivt_component[of "f ` cbox a b" "f a" "f b" k y] |
66827
c94531b5007d
Divided Topology_Euclidean_Space in two, creating new theory Connected. Also deleted some duplicate / variant theorems
paulson <lp15@cam.ac.uk>
parents:
66793
diff
changeset
|
1868 |
by (simp add: connected_continuous_image assms) |
53348 | 1869 |
qed |
1870 |
||
1871 |
lemma ivt_increasing_component_1: |
|
1872 |
fixes f :: "real \<Rightarrow> 'a::euclidean_space" |
|
61518
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1873 |
shows "a \<le> b \<Longrightarrow> \<forall>x\<in>{a..b}. continuous (at x) f \<Longrightarrow> |
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1874 |
f a\<bullet>k \<le> y \<Longrightarrow> y \<le> f b\<bullet>k \<Longrightarrow> \<exists>x\<in>{a..b}. (f x)\<bullet>k = y" |
68031 | 1875 |
by (rule ivt_increasing_component_on_1) (auto simp: continuous_at_imp_continuous_on) |
53348 | 1876 |
|
1877 |
lemma ivt_decreasing_component_on_1: |
|
1878 |
fixes f :: "real \<Rightarrow> 'a::euclidean_space" |
|
1879 |
assumes "a \<le> b" |
|
61518
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1880 |
and "continuous_on {a..b} f" |
53348 | 1881 |
and "(f b)\<bullet>k \<le> y" |
1882 |
and "y \<le> (f a)\<bullet>k" |
|
61518
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1883 |
shows "\<exists>x\<in>{a..b}. (f x)\<bullet>k = y" |
53348 | 1884 |
apply (subst neg_equal_iff_equal[symmetric]) |
44531
1d477a2b1572
replace some continuous_on lemmas with more general versions
huffman
parents:
44525
diff
changeset
|
1885 |
using ivt_increasing_component_on_1[of a b "\<lambda>x. - f x" k "- y"] |
53348 | 1886 |
using assms using continuous_on_minus |
1887 |
apply auto |
|
1888 |
done |
|
1889 |
||
1890 |
lemma ivt_decreasing_component_1: |
|
1891 |
fixes f :: "real \<Rightarrow> 'a::euclidean_space" |
|
61518
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1892 |
shows "a \<le> b \<Longrightarrow> \<forall>x\<in>{a..b}. continuous (at x) f \<Longrightarrow> |
ff12606337e9
new lemmas about topology, etc., for Cauchy integral formula
paulson
parents:
61426
diff
changeset
|
1893 |
f b\<bullet>k \<le> y \<Longrightarrow> y \<le> f a\<bullet>k \<Longrightarrow> \<exists>x\<in>{a..b}. (f x)\<bullet>k = y" |
53348 | 1894 |
by (rule ivt_decreasing_component_on_1) (auto simp: continuous_at_imp_continuous_on) |
1895 |
||
33175 | 1896 |
|
70136 | 1897 |
subsection\<^marker>\<open>tag unimportant\<close> \<open>A bound within an interval\<close> |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
1898 |
|
56188 | 1899 |
lemma convex_hull_eq_real_cbox: |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
1900 |
fixes x y :: real assumes "x \<le> y" |
56188 | 1901 |
shows "convex hull {x, y} = cbox x y" |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
1902 |
proof (rule hull_unique) |
60420 | 1903 |
show "{x, y} \<subseteq> cbox x y" using \<open>x \<le> y\<close> by auto |
56188 | 1904 |
show "convex (cbox x y)" |
1905 |
by (rule convex_box) |
|
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
1906 |
next |
68058 | 1907 |
fix S assume "{x, y} \<subseteq> S" and "convex S" |
1908 |
then show "cbox x y \<subseteq> S" |
|
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
1909 |
unfolding is_interval_convex_1 [symmetric] is_interval_def Basis_real_def |
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
1910 |
by - (clarify, simp (no_asm_use), fast) |
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
1911 |
qed |
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50104
diff
changeset
|
1912 |
|
33175 | 1913 |
lemma unit_interval_convex_hull: |
57447
87429bdecad5
import more stuff from the CLT proof; base the lborel measure on interval_measure; remove lebesgue measure
hoelzl
parents:
57418
diff
changeset
|
1914 |
"cbox (0::'a::euclidean_space) One = convex hull {x. \<forall>i\<in>Basis. (x\<bullet>i = 0) \<or> (x\<bullet>i = 1)}" |
37489
44e42d392c6e
Introduce a type class for euclidean spaces, port most lemmas from real^'n to this type class.
hoelzl
parents:
36844
diff
changeset
|
1915 |
(is "?int = convex hull ?points") |
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50104
diff
changeset
|
1916 |
proof - |
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50104
diff
changeset
|
1917 |
have One[simp]: "\<And>i. i \<in> Basis \<Longrightarrow> One \<bullet> i = 1" |
64267 | 1918 |
by (simp add: inner_sum_left sum.If_cases inner_Basis) |
56188 | 1919 |
have "?int = {x. \<forall>i\<in>Basis. x \<bullet> i \<in> cbox 0 1}" |
1920 |
by (auto simp: cbox_def) |
|
1921 |
also have "\<dots> = (\<Sum>i\<in>Basis. (\<lambda>x. x *\<^sub>R i) ` cbox 0 1)" |
|
64267 | 1922 |
by (simp only: box_eq_set_sum_Basis) |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
1923 |
also have "\<dots> = (\<Sum>i\<in>Basis. (\<lambda>x. x *\<^sub>R i) ` (convex hull {0, 1}))" |
56188 | 1924 |
by (simp only: convex_hull_eq_real_cbox zero_le_one) |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
1925 |
also have "\<dots> = (\<Sum>i\<in>Basis. convex hull ((\<lambda>x. x *\<^sub>R i) ` {0, 1}))" |
68072
493b818e8e10
added Johannes' generalizations Modules.thy and Vector_Spaces.thy; adapted HOL and HOL-Analysis accordingly
immler
parents:
67982
diff
changeset
|
1926 |
by (simp add: convex_hull_linear_image) |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
1927 |
also have "\<dots> = convex hull (\<Sum>i\<in>Basis. (\<lambda>x. x *\<^sub>R i) ` {0, 1})" |
64267 | 1928 |
by (simp only: convex_hull_set_sum) |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
1929 |
also have "\<dots> = convex hull {x. \<forall>i\<in>Basis. x\<bullet>i \<in> {0, 1}}" |
64267 | 1930 |
by (simp only: box_eq_set_sum_Basis) |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
1931 |
also have "convex hull {x. \<forall>i\<in>Basis. x\<bullet>i \<in> {0, 1}} = convex hull ?points" |
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
1932 |
by simp |
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
1933 |
finally show ?thesis . |
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50104
diff
changeset
|
1934 |
qed |
33175 | 1935 |
|
60420 | 1936 |
text \<open>And this is a finite set of vertices.\<close> |
33175 | 1937 |
|
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50104
diff
changeset
|
1938 |
lemma unit_cube_convex_hull: |
68058 | 1939 |
obtains S :: "'a::euclidean_space set" |
1940 |
where "finite S" and "cbox 0 (\<Sum>Basis) = convex hull S" |
|
1941 |
proof |
|
1942 |
show "finite {x::'a. \<forall>i\<in>Basis. x \<bullet> i = 0 \<or> x \<bullet> i = 1}" |
|
1943 |
proof (rule finite_subset, clarify) |
|
1944 |
show "finite ((\<lambda>S. \<Sum>i\<in>Basis. (if i \<in> S then 1 else 0) *\<^sub>R i) ` Pow Basis)" |
|
1945 |
using finite_Basis by blast |
|
1946 |
fix x :: 'a |
|
1947 |
assume as: "\<forall>i\<in>Basis. x \<bullet> i = 0 \<or> x \<bullet> i = 1" |
|
1948 |
show "x \<in> (\<lambda>S. \<Sum>i\<in>Basis. (if i\<in>S then 1 else 0) *\<^sub>R i) ` Pow Basis" |
|
1949 |
apply (rule image_eqI[where x="{i. i\<in>Basis \<and> x\<bullet>i = 1}"]) |
|
1950 |
using as |
|
1951 |
apply (subst euclidean_eq_iff, auto) |
|
1952 |
done |
|
1953 |
qed |
|
1954 |
show "cbox 0 One = convex hull {x. \<forall>i\<in>Basis. x \<bullet> i = 0 \<or> x \<bullet> i = 1}" |
|
1955 |
using unit_interval_convex_hull by blast |
|
1956 |
qed |
|
33175 | 1957 |
|
60420 | 1958 |
text \<open>Hence any cube (could do any nonempty interval).\<close> |
33175 | 1959 |
|
1960 |
lemma cube_convex_hull: |
|
53348 | 1961 |
assumes "d > 0" |
68058 | 1962 |
obtains S :: "'a::euclidean_space set" where |
1963 |
"finite S" and "cbox (x - (\<Sum>i\<in>Basis. d*\<^sub>Ri)) (x + (\<Sum>i\<in>Basis. d*\<^sub>Ri)) = convex hull S" |
|
53348 | 1964 |
proof - |
68058 | 1965 |
let ?d = "(\<Sum>i\<in>Basis. d *\<^sub>R i)::'a" |
56188 | 1966 |
have *: "cbox (x - ?d) (x + ?d) = (\<lambda>y. x - ?d + (2 * d) *\<^sub>R y) ` cbox 0 (\<Sum>Basis)" |
68058 | 1967 |
proof (intro set_eqI iffI) |
53348 | 1968 |
fix y |
68058 | 1969 |
assume "y \<in> cbox (x - ?d) (x + ?d)" |
56188 | 1970 |
then have "inverse (2 * d) *\<^sub>R (y - (x - ?d)) \<in> cbox 0 (\<Sum>Basis)" |
70802
160eaf566bcb
formally augmented corresponding rules for field_simps
haftmann
parents:
70136
diff
changeset
|
1971 |
using assms by (simp add: mem_box inner_simps) (simp add: field_simps) |
69064
5840724b1d71
Prefix form of infix with * on either side no longer needs special treatment
nipkow
parents:
68607
diff
changeset
|
1972 |
with \<open>0 < d\<close> show "y \<in> (\<lambda>y. x - sum ((*\<^sub>R) d) Basis + (2 * d) *\<^sub>R y) ` cbox 0 One" |
68058 | 1973 |
by (auto intro: image_eqI[where x= "inverse (2 * d) *\<^sub>R (y - (x - ?d))"]) |
33175 | 1974 |
next |
68058 | 1975 |
fix y |
1976 |
assume "y \<in> (\<lambda>y. x - ?d + (2 * d) *\<^sub>R y) ` cbox 0 One" |
|
1977 |
then obtain z where z: "z \<in> cbox 0 One" "y = x - ?d + (2*d) *\<^sub>R z" |
|
68031 | 1978 |
by auto |
56188 | 1979 |
then show "y \<in> cbox (x - ?d) (x + ?d)" |
68058 | 1980 |
using z assms by (auto simp: mem_box inner_simps) |
53348 | 1981 |
qed |
68058 | 1982 |
obtain S where "finite S" "cbox 0 (\<Sum>Basis::'a) = convex hull S" |
53348 | 1983 |
using unit_cube_convex_hull by auto |
1984 |
then show ?thesis |
|
68058 | 1985 |
by (rule_tac that[of "(\<lambda>y. x - ?d + (2 * d) *\<^sub>R y)` S"]) (auto simp: convex_hull_affinity *) |
53348 | 1986 |
qed |
1987 |
||
70136 | 1988 |
subsection\<^marker>\<open>tag unimportant\<close>\<open>Representation of any interval as a finite convex hull\<close> |
63007
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
1989 |
|
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
1990 |
lemma image_stretch_interval: |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
1991 |
"(\<lambda>x. \<Sum>k\<in>Basis. (m k * (x\<bullet>k)) *\<^sub>R k) ` cbox a (b::'a::euclidean_space) = |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
1992 |
(if (cbox a b) = {} then {} else |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
1993 |
cbox (\<Sum>k\<in>Basis. (min (m k * (a\<bullet>k)) (m k * (b\<bullet>k))) *\<^sub>R k::'a) |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
1994 |
(\<Sum>k\<in>Basis. (max (m k * (a\<bullet>k)) (m k * (b\<bullet>k))) *\<^sub>R k))" |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
1995 |
proof cases |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
1996 |
assume *: "cbox a b \<noteq> {}" |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
1997 |
show ?thesis |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
1998 |
unfolding box_ne_empty if_not_P[OF *] |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
1999 |
apply (simp add: cbox_def image_Collect set_eq_iff euclidean_eq_iff[where 'a='a] ball_conj_distrib[symmetric]) |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2000 |
apply (subst choice_Basis_iff[symmetric]) |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2001 |
proof (intro allI ball_cong refl) |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2002 |
fix x i :: 'a assume "i \<in> Basis" |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2003 |
with * have a_le_b: "a \<bullet> i \<le> b \<bullet> i" |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2004 |
unfolding box_ne_empty by auto |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2005 |
show "(\<exists>xa. x \<bullet> i = m i * xa \<and> a \<bullet> i \<le> xa \<and> xa \<le> b \<bullet> i) \<longleftrightarrow> |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2006 |
min (m i * (a \<bullet> i)) (m i * (b \<bullet> i)) \<le> x \<bullet> i \<and> x \<bullet> i \<le> max (m i * (a \<bullet> i)) (m i * (b \<bullet> i))" |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2007 |
proof (cases "m i = 0") |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2008 |
case True |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2009 |
with a_le_b show ?thesis by auto |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2010 |
next |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2011 |
case False |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2012 |
then have *: "\<And>a b. a = m i * b \<longleftrightarrow> b = a / m i" |
68031 | 2013 |
by (auto simp: field_simps) |
63007
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2014 |
from False have |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2015 |
"min (m i * (a \<bullet> i)) (m i * (b \<bullet> i)) = (if 0 < m i then m i * (a \<bullet> i) else m i * (b \<bullet> i))" |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2016 |
"max (m i * (a \<bullet> i)) (m i * (b \<bullet> i)) = (if 0 < m i then m i * (b \<bullet> i) else m i * (a \<bullet> i))" |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2017 |
using a_le_b by (auto simp: min_def max_def mult_le_cancel_left) |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2018 |
with False show ?thesis using a_le_b |
68031 | 2019 |
unfolding * by (auto simp: le_divide_eq divide_le_eq ac_simps) |
63007
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2020 |
qed |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2021 |
qed |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2022 |
qed simp |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2023 |
|
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2024 |
lemma interval_image_stretch_interval: |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2025 |
"\<exists>u v. (\<lambda>x. \<Sum>k\<in>Basis. (m k * (x\<bullet>k))*\<^sub>R k) ` cbox a (b::'a::euclidean_space) = cbox u (v::'a::euclidean_space)" |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2026 |
unfolding image_stretch_interval by auto |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2027 |
|
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2028 |
lemma cbox_translation: "cbox (c + a) (c + b) = image (\<lambda>x. c + x) (cbox a b)" |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2029 |
using image_affinity_cbox [of 1 c a b] |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2030 |
using box_ne_empty [of "a+c" "b+c"] box_ne_empty [of a b] |
68031 | 2031 |
by (auto simp: inner_left_distrib add.commute) |
63007
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2032 |
|
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2033 |
lemma cbox_image_unit_interval: |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2034 |
fixes a :: "'a::euclidean_space" |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2035 |
assumes "cbox a b \<noteq> {}" |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2036 |
shows "cbox a b = |
67399 | 2037 |
(+) a ` (\<lambda>x. \<Sum>k\<in>Basis. ((b \<bullet> k - a \<bullet> k) * (x \<bullet> k)) *\<^sub>R k) ` cbox 0 One" |
63007
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2038 |
using assms |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2039 |
apply (simp add: box_ne_empty image_stretch_interval cbox_translation [symmetric]) |
64267 | 2040 |
apply (simp add: min_def max_def algebra_simps sum_subtractf euclidean_representation) |
63007
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2041 |
done |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2042 |
|
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2043 |
lemma closed_interval_as_convex_hull: |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2044 |
fixes a :: "'a::euclidean_space" |
68058 | 2045 |
obtains S where "finite S" "cbox a b = convex hull S" |
63007
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2046 |
proof (cases "cbox a b = {}") |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2047 |
case True with convex_hull_empty that show ?thesis |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2048 |
by blast |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2049 |
next |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2050 |
case False |
68058 | 2051 |
obtain S::"'a set" where "finite S" and eq: "cbox 0 One = convex hull S" |
63007
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2052 |
by (blast intro: unit_cube_convex_hull) |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2053 |
have lin: "linear (\<lambda>x. \<Sum>k\<in>Basis. ((b \<bullet> k - a \<bullet> k) * (x \<bullet> k)) *\<^sub>R k)" |
64267 | 2054 |
by (rule linear_compose_sum) (auto simp: algebra_simps linearI) |
68058 | 2055 |
have "finite ((+) a ` (\<lambda>x. \<Sum>k\<in>Basis. ((b \<bullet> k - a \<bullet> k) * (x \<bullet> k)) *\<^sub>R k) ` S)" |
2056 |
by (rule finite_imageI \<open>finite S\<close>)+ |
|
63007
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2057 |
then show ?thesis |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2058 |
apply (rule that) |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2059 |
apply (simp add: convex_hull_translation convex_hull_linear_image [OF lin, symmetric]) |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2060 |
apply (simp add: eq [symmetric] cbox_image_unit_interval [OF False]) |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2061 |
done |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2062 |
qed |
aa894a49f77d
new theorems about convex hulls, etc.; also, renamed some theorems
paulson <lp15@cam.ac.uk>
parents:
62950
diff
changeset
|
2063 |
|
33175 | 2064 |
|
70136 | 2065 |
subsection\<^marker>\<open>tag unimportant\<close> \<open>Bounded convex function on open set is continuous\<close> |
33175 | 2066 |
|
2067 |
lemma convex_on_bounded_continuous: |
|
68058 | 2068 |
fixes S :: "('a::real_normed_vector) set" |
2069 |
assumes "open S" |
|
2070 |
and "convex_on S f" |
|
2071 |
and "\<forall>x\<in>S. \<bar>f x\<bar> \<le> b" |
|
2072 |
shows "continuous_on S f" |
|
53348 | 2073 |
apply (rule continuous_at_imp_continuous_on) |
2074 |
unfolding continuous_at_real_range |
|
2075 |
proof (rule,rule,rule) |
|
2076 |
fix x and e :: real |
|
68058 | 2077 |
assume "x \<in> S" "e > 0" |
63040 | 2078 |
define B where "B = \<bar>b\<bar> + 1" |
68058 | 2079 |
then have B: "0 < B""\<And>x. x\<in>S \<Longrightarrow> \<bar>f x\<bar> \<le> B" |
2080 |
using assms(3) by auto |
|
2081 |
obtain k where "k > 0" and k: "cball x k \<subseteq> S" |
|
2082 |
using \<open>x \<in> S\<close> assms(1) open_contains_cball_eq by blast |
|
33175 | 2083 |
show "\<exists>d>0. \<forall>x'. norm (x' - x) < d \<longrightarrow> \<bar>f x' - f x\<bar> < e" |
68058 | 2084 |
proof (intro exI conjI allI impI) |
53348 | 2085 |
fix y |
2086 |
assume as: "norm (y - x) < min (k / 2) (e / (2 * B) * k)" |
|
2087 |
show "\<bar>f y - f x\<bar> < e" |
|
2088 |
proof (cases "y = x") |
|
2089 |
case False |
|
63040 | 2090 |
define t where "t = k / norm (y - x)" |
53348 | 2091 |
have "2 < t" "0<t" |
60420 | 2092 |
unfolding t_def using as False and \<open>k>0\<close> |
68031 | 2093 |
by (auto simp:field_simps) |
68058 | 2094 |
have "y \<in> S" |
2095 |
apply (rule k[THEN subsetD]) |
|
53348 | 2096 |
unfolding mem_cball dist_norm |
2097 |
apply (rule order_trans[of _ "2 * norm (x - y)"]) |
|
2098 |
using as |
|
68031 | 2099 |
by (auto simp: field_simps norm_minus_commute) |
53348 | 2100 |
{ |
63040 | 2101 |
define w where "w = x + t *\<^sub>R (y - x)" |
68058 | 2102 |
have "w \<in> S" |
2103 |
using \<open>k>0\<close> by (auto simp: dist_norm t_def w_def k[THEN subsetD]) |
|
53348 | 2104 |
have "(1 / t) *\<^sub>R x + - x + ((t - 1) / t) *\<^sub>R x = (1 / t - 1 + (t - 1) / t) *\<^sub>R x" |
68031 | 2105 |
by (auto simp: algebra_simps) |
53348 | 2106 |
also have "\<dots> = 0" |
68031 | 2107 |
using \<open>t > 0\<close> by (auto simp:field_simps) |
53348 | 2108 |
finally have w: "(1 / t) *\<^sub>R w + ((t - 1) / t) *\<^sub>R x = y" |
60420 | 2109 |
unfolding w_def using False and \<open>t > 0\<close> |
68031 | 2110 |
by (auto simp: algebra_simps) |
68052 | 2111 |
have 2: "2 * B < e * t" |
60420 | 2112 |
unfolding t_def using \<open>0 < e\<close> \<open>0 < k\<close> \<open>B > 0\<close> and as and False |
68031 | 2113 |
by (auto simp:field_simps) |
68052 | 2114 |
have "f y - f x \<le> (f w - f x) / t" |
33175 | 2115 |
using assms(2)[unfolded convex_on_def,rule_format,of w x "1/t" "(t - 1)/t", unfolded w] |
68058 | 2116 |
using \<open>0 < t\<close> \<open>2 < t\<close> and \<open>x \<in> S\<close> \<open>w \<in> S\<close> |
68031 | 2117 |
by (auto simp:field_simps) |
68052 | 2118 |
also have "... < e" |
68058 | 2119 |
using B(2)[OF \<open>w\<in>S\<close>] and B(2)[OF \<open>x\<in>S\<close>] 2 \<open>t > 0\<close> by (auto simp: field_simps) |
68052 | 2120 |
finally have th1: "f y - f x < e" . |
53348 | 2121 |
} |
49531 | 2122 |
moreover |
53348 | 2123 |
{ |
63040 | 2124 |
define w where "w = x - t *\<^sub>R (y - x)" |
68058 | 2125 |
have "w \<in> S" |
2126 |
using \<open>k > 0\<close> by (auto simp: dist_norm t_def w_def k[THEN subsetD]) |
|
53348 | 2127 |
have "(1 / (1 + t)) *\<^sub>R x + (t / (1 + t)) *\<^sub>R x = (1 / (1 + t) + t / (1 + t)) *\<^sub>R x" |
68031 | 2128 |
by (auto simp: algebra_simps) |
53348 | 2129 |
also have "\<dots> = x" |
68031 | 2130 |
using \<open>t > 0\<close> by (auto simp:field_simps) |
53348 | 2131 |
finally have w: "(1 / (1+t)) *\<^sub>R w + (t / (1 + t)) *\<^sub>R y = x" |
60420 | 2132 |
unfolding w_def using False and \<open>t > 0\<close> |
68031 | 2133 |
by (auto simp: algebra_simps) |
53348 | 2134 |
have "2 * B < e * t" |
2135 |
unfolding t_def |
|
60420 | 2136 |
using \<open>0 < e\<close> \<open>0 < k\<close> \<open>B > 0\<close> and as and False |
68031 | 2137 |
by (auto simp:field_simps) |
53348 | 2138 |
then have *: "(f w - f y) / t < e" |
68058 | 2139 |
using B(2)[OF \<open>w\<in>S\<close>] and B(2)[OF \<open>y\<in>S\<close>] |
60420 | 2140 |
using \<open>t > 0\<close> |
68031 | 2141 |
by (auto simp:field_simps) |
49531 | 2142 |
have "f x \<le> 1 / (1 + t) * f w + (t / (1 + t)) * f y" |
33175 | 2143 |
using assms(2)[unfolded convex_on_def,rule_format,of w y "1/(1+t)" "t / (1+t)",unfolded w] |
68058 | 2144 |
using \<open>0 < t\<close> \<open>2 < t\<close> and \<open>y \<in> S\<close> \<open>w \<in> S\<close> |
68031 | 2145 |
by (auto simp:field_simps) |
53348 | 2146 |
also have "\<dots> = (f w + t * f y) / (1 + t)" |
70817
dd675800469d
dedicated fact collections for algebraic simplification rules potentially splitting goals
haftmann
parents:
70802
diff
changeset
|
2147 |
using \<open>t > 0\<close> by (simp add: add_divide_distrib) |
53348 | 2148 |
also have "\<dots> < e + f y" |
68031 | 2149 |
using \<open>t > 0\<close> * \<open>e > 0\<close> by (auto simp: field_simps) |
53348 | 2150 |
finally have "f x - f y < e" by auto |
2151 |
} |
|
49531 | 2152 |
ultimately show ?thesis by auto |
60420 | 2153 |
qed (insert \<open>0<e\<close>, auto) |
2154 |
qed (insert \<open>0<e\<close> \<open>0<k\<close> \<open>0<B\<close>, auto simp: field_simps) |
|
2155 |
qed |
|
2156 |
||
2157 |
||
70136 | 2158 |
subsection\<^marker>\<open>tag unimportant\<close> \<open>Upper bound on a ball implies upper and lower bounds\<close> |
33175 | 2159 |
|
2160 |
lemma convex_bounds_lemma: |
|
36338 | 2161 |
fixes x :: "'a::real_normed_vector" |
53348 | 2162 |
assumes "convex_on (cball x e) f" |
2163 |
and "\<forall>y \<in> cball x e. f y \<le> b" |
|
61945 | 2164 |
shows "\<forall>y \<in> cball x e. \<bar>f y\<bar> \<le> b + 2 * \<bar>f x\<bar>" |
53348 | 2165 |
apply rule |
2166 |
proof (cases "0 \<le> e") |
|
2167 |
case True |
|
2168 |
fix y |
|
2169 |
assume y: "y \<in> cball x e" |
|
63040 | 2170 |
define z where "z = 2 *\<^sub>R x - y" |
53348 | 2171 |
have *: "x - (2 *\<^sub>R x - y) = y - x" |
2172 |
by (simp add: scaleR_2) |
|
2173 |
have z: "z \<in> cball x e" |
|
68031 | 2174 |
using y unfolding z_def mem_cball dist_norm * by (auto simp: norm_minus_commute) |
53348 | 2175 |
have "(1 / 2) *\<^sub>R y + (1 / 2) *\<^sub>R z = x" |
68031 | 2176 |
unfolding z_def by (auto simp: algebra_simps) |
53348 | 2177 |
then show "\<bar>f y\<bar> \<le> b + 2 * \<bar>f x\<bar>" |
2178 |
using assms(1)[unfolded convex_on_def,rule_format, OF y z, of "1/2" "1/2"] |
|
2179 |
using assms(2)[rule_format,OF y] assms(2)[rule_format,OF z] |
|
68031 | 2180 |
by (auto simp:field_simps) |
53348 | 2181 |
next |
2182 |
case False |
|
2183 |
fix y |
|
2184 |
assume "y \<in> cball x e" |
|
2185 |
then have "dist x y < 0" |
|
2186 |
using False unfolding mem_cball not_le by (auto simp del: dist_not_less_zero) |
|
2187 |
then show "\<bar>f y\<bar> \<le> b + 2 * \<bar>f x\<bar>" |
|
2188 |
using zero_le_dist[of x y] by auto |
|
2189 |
qed |
|
2190 |
||
33175 | 2191 |
|
70136 | 2192 |
subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Hence a convex function on an open set is continuous\<close> |
33175 | 2193 |
|
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50104
diff
changeset
|
2194 |
lemma real_of_nat_ge_one_iff: "1 \<le> real (n::nat) \<longleftrightarrow> 1 \<le> n" |
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50104
diff
changeset
|
2195 |
by auto |
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50104
diff
changeset
|
2196 |
|
33175 | 2197 |
lemma convex_on_continuous: |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2198 |
assumes "open (s::('a::euclidean_space) set)" "convex_on s f" |
33175 | 2199 |
shows "continuous_on s f" |
53348 | 2200 |
unfolding continuous_on_eq_continuous_at[OF assms(1)] |
2201 |
proof |
|
37489
44e42d392c6e
Introduce a type class for euclidean spaces, port most lemmas from real^'n to this type class.
hoelzl
parents:
36844
diff
changeset
|
2202 |
note dimge1 = DIM_positive[where 'a='a] |
53348 | 2203 |
fix x |
2204 |
assume "x \<in> s" |
|
2205 |
then obtain e where e: "cball x e \<subseteq> s" "e > 0" |
|
2206 |
using assms(1) unfolding open_contains_cball by auto |
|
63040 | 2207 |
define d where "d = e / real DIM('a)" |
53348 | 2208 |
have "0 < d" |
60420 | 2209 |
unfolding d_def using \<open>e > 0\<close> dimge1 by auto |
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50104
diff
changeset
|
2210 |
let ?d = "(\<Sum>i\<in>Basis. d *\<^sub>R i)::'a" |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2211 |
obtain c |
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2212 |
where c: "finite c" |
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2213 |
and c1: "convex hull c \<subseteq> cball x e" |
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2214 |
and c2: "cball x d \<subseteq> convex hull c" |
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2215 |
proof |
63040 | 2216 |
define c where "c = (\<Sum>i\<in>Basis. (\<lambda>a. a *\<^sub>R i) ` {x\<bullet>i - d, x\<bullet>i + d})" |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2217 |
show "finite c" |
64267 | 2218 |
unfolding c_def by (simp add: finite_set_sum) |
56188 | 2219 |
have 1: "convex hull c = {a. \<forall>i\<in>Basis. a \<bullet> i \<in> cbox (x \<bullet> i - d) (x \<bullet> i + d)}" |
64267 | 2220 |
unfolding box_eq_set_sum_Basis |
2221 |
unfolding c_def convex_hull_set_sum |
|
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2222 |
apply (subst convex_hull_linear_image [symmetric]) |
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2223 |
apply (simp add: linear_iff scaleR_add_left) |
64267 | 2224 |
apply (rule sum.cong [OF refl]) |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2225 |
apply (rule image_cong [OF _ refl]) |
56188 | 2226 |
apply (rule convex_hull_eq_real_cbox) |
60420 | 2227 |
apply (cut_tac \<open>0 < d\<close>, simp) |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2228 |
done |
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2229 |
then have 2: "convex hull c = {a. \<forall>i\<in>Basis. a \<bullet> i \<in> cball (x \<bullet> i) d}" |
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2230 |
by (simp add: dist_norm abs_le_iff algebra_simps) |
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2231 |
show "cball x d \<subseteq> convex hull c" |
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2232 |
unfolding 2 |
68058 | 2233 |
by (clarsimp simp: dist_norm) (metis inner_commute inner_diff_right norm_bound_Basis_le) |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2234 |
have e': "e = (\<Sum>(i::'a)\<in>Basis. d)" |
71172 | 2235 |
by (simp add: d_def) |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2236 |
show "convex hull c \<subseteq> cball x e" |
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2237 |
unfolding 2 |
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2238 |
apply clarsimp |
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2239 |
apply (subst euclidean_dist_l2) |
67155 | 2240 |
apply (rule order_trans [OF L2_set_le_sum]) |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2241 |
apply (rule zero_le_dist) |
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2242 |
unfolding e' |
68031 | 2243 |
apply (rule sum_mono, simp) |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2244 |
done |
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2245 |
qed |
63040 | 2246 |
define k where "k = Max (f ` c)" |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2247 |
have "convex_on (convex hull c) f" |
50526
899c9c4e4a4c
Remove the indexed basis from the definition of euclidean spaces and only use the set of Basis vectors
hoelzl
parents:
50104
diff
changeset
|
2248 |
apply(rule convex_on_subset[OF assms(2)]) |
68069
36209dfb981e
tidying up and using real induction methods
paulson <lp15@cam.ac.uk>
parents:
68058
diff
changeset
|
2249 |
apply(rule subset_trans[OF c1 e(1)]) |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2250 |
done |
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2251 |
then have k: "\<forall>y\<in>convex hull c. f y \<le> k" |
68031 | 2252 |
apply (rule_tac convex_on_convex_hull_bound, assumption) |
68048 | 2253 |
by (simp add: k_def c) |
2254 |
have "e \<le> e * real DIM('a)" |
|
2255 |
using e(2) real_of_nat_ge_one_iff by auto |
|
2256 |
then have "d \<le> e" |
|
70817
dd675800469d
dedicated fact collections for algebraic simplification rules potentially splitting goals
haftmann
parents:
70802
diff
changeset
|
2257 |
by (simp add: d_def field_split_simps) |
53348 | 2258 |
then have dsube: "cball x d \<subseteq> cball x e" |
53620
3c7f5e7926dc
generalized and simplified proofs of several theorems about convex sets
huffman
parents:
53600
diff
changeset
|
2259 |
by (rule subset_cball) |
53348 | 2260 |
have conv: "convex_on (cball x d) f" |
68031 | 2261 |
using \<open>convex_on (convex hull c) f\<close> c2 convex_on_subset by blast |
61945 | 2262 |
then have "\<forall>y\<in>cball x d. \<bar>f y\<bar> \<le> k + 2 * \<bar>f x\<bar>" |
68048 | 2263 |
by (rule convex_bounds_lemma) (use c2 k in blast) |
53348 | 2264 |
then have "continuous_on (ball x d) f" |
2265 |
apply (rule_tac convex_on_bounded_continuous) |
|
2266 |
apply (rule open_ball, rule convex_on_subset[OF conv]) |
|
68031 | 2267 |
apply (rule ball_subset_cball, force) |
33270 | 2268 |
done |
53348 | 2269 |
then show "continuous (at x) f" |
2270 |
unfolding continuous_on_eq_continuous_at[OF open_ball] |
|
60420 | 2271 |
using \<open>d > 0\<close> by auto |
2272 |
qed |
|
2273 |
||
33175 | 2274 |
end |