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