# HG changeset patch # User paulson # Date 1460990455 -3600 # Node ID 3590590699b1f3a42c5fd17f56a90b011cb6cff4 # Parent aa894a49f77d978651b00369fb2c81dbe2fb0755 numerous theorems about affine hulls, hyperplanes, etc. diff -r aa894a49f77d -r 3590590699b1 src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy --- a/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy Mon Apr 18 14:30:32 2016 +0100 +++ b/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy Mon Apr 18 15:40:55 2016 +0100 @@ -4,6 +4,9 @@ imports Finite_Cartesian_Product Integration begin +lemma subspace_special_hyperplane: "subspace {x. x $ k = 0}" + by (simp add: subspace_def) + lemma delta_mult_idempotent: "(if k=a then 1 else (0::'a::semiring_1)) * (if k=a then 1 else 0) = (if k=a then 1 else 0)" by (cases "k=a") auto diff -r aa894a49f77d -r 3590590699b1 src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy --- a/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy Mon Apr 18 14:30:32 2016 +0100 +++ b/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy Mon Apr 18 15:40:55 2016 +0100 @@ -1514,6 +1514,10 @@ using convex_Inter[of "{t. convex t \ s \ t}"] by auto +lemma convex_hull_subset: + "s \ convex hull t \ convex hull s \ convex hull t" + by (simp add: convex_convex_hull subset_hull) + lemma convex_hull_eq: "convex hull s = s \ convex s" by (metis convex_convex_hull hull_same) @@ -2452,8 +2456,7 @@ shows "affine hull S = span S" using affine_hull_span_gen[of "0" S] assms by auto - -lemma extend_to_affine_basis: +lemma extend_to_affine_basis_nonempty: fixes S V :: "'n::euclidean_space set" assumes "\ affine_dependent S" "S \ V" "S \ {}" shows "\T. \ affine_dependent T \ S \ T \ T \ V \ affine hull T = affine hull V" @@ -2500,8 +2503,20 @@ case False then obtain x where "x \ V" by auto then show ?thesis - using affine_dependent_def[of "{x}"] extend_to_affine_basis[of "{x}" V] - by auto + using affine_dependent_def[of "{x}"] extend_to_affine_basis_nonempty[of "{x}" V] + by auto +qed + +proposition extend_to_affine_basis: + fixes S V :: "'n::euclidean_space set" + assumes "\ affine_dependent S" "S \ V" + obtains T where "\ affine_dependent T" "S \ T" "T \ V" "affine hull T = affine hull V" +proof (cases "S = {}") + case True then show ?thesis + using affine_basis_exists by (metis empty_subsetI that) +next + case False + then show ?thesis by (metis assms extend_to_affine_basis_nonempty that) qed @@ -2649,6 +2664,11 @@ using assms \span B = S\ by auto qed +corollary dim_eq_span: + fixes S :: "'a::euclidean_space set" + shows "\S \ T; dim T \ dim S\ \ span S = span T" +by (simp add: span_mono subspace_dim_equal subspace_span) + lemma span_substd_basis: assumes d: "d \ Basis" shows "span d = {x. \i\Basis. i \ d \ x\i = 0}" @@ -2910,6 +2930,18 @@ by auto qed +lemma aff_dim_eq_dim: + fixes S :: "'n::euclidean_space set" + assumes "a \ affine hull S" + shows "aff_dim S = int (dim ((\x. -a+x) ` S))" +proof - + have "0 \ affine hull ((\x. -a+x) ` S)" + unfolding Convex_Euclidean_Space.affine_hull_translation + using assms by (simp add: ab_group_add_class.ab_left_minus image_iff) + with aff_dim_zero show ?thesis + by (metis aff_dim_translation_eq) +qed + lemma aff_dim_univ: "aff_dim (UNIV :: 'n::euclidean_space set) = int(DIM('n))" using aff_dim_subspace[of "(UNIV :: 'n::euclidean_space set)"] dim_UNIV[where 'a="'n::euclidean_space"] @@ -2931,15 +2963,9 @@ assumes "B \ V" assumes "\ affine_dependent B" shows "int (card B) \ aff_dim V + 1" -proof (cases "B = {}") - case True - then have "-1 \ aff_dim V" - using aff_dim_geq by auto - with True show ?thesis by auto -next - case False - then obtain T where T: "\ affine_dependent T \ B \ T \ T \ V \ affine hull T = affine hull V" - using assms extend_to_affine_basis[of B V] by auto +proof - + obtain T where T: "\ affine_dependent T \ B \ T \ T \ V \ affine hull T = affine hull V" + by (metis assms extend_to_affine_basis[of B V]) then have "of_nat (card T) = aff_dim V + 1" using aff_dim_unique by auto then show ?thesis @@ -3110,6 +3136,11 @@ shows "dim S < DIM ('n) \ interior S = {}" by (metis low_dim_interior affine_hull_UNIV dim_affine_hull less_not_refl dim_UNIV) +corollary aff_dim_nonempty_interior: + fixes S :: "'a::euclidean_space set" + shows "interior S \ {} \ aff_dim S = DIM('a)" +by (metis low_dim_interior) + subsection \Caratheodory's theorem.\ lemma convex_hull_caratheodory_aff_dim: @@ -10662,4 +10693,847 @@ lemma setdist_le_sing: "x \ s ==> setdist s t \ setdist {x} t" using setdist_subset_left by auto + +subsection\Basic lemmas about hyperplanes and halfspaces\ + +lemma hyperplane_eq_Ex: + assumes "a \ 0" obtains x where "a \ x = b" + by (rule_tac x = "(b / (a \ a)) *\<^sub>R a" in that) (simp add: assms) + +lemma hyperplane_eq_empty: + "{x. a \ x = b} = {} \ a = 0 \ b \ 0" + using hyperplane_eq_Ex apply auto[1] + using inner_zero_right by blast + +lemma hyperplane_eq_UNIV: + "{x. a \ x = b} = UNIV \ a = 0 \ b = 0" +proof - + have "UNIV \ {x. a \ x = b} \ a = 0 \ b = 0" + apply (drule_tac c = "((b+1) / (a \ a)) *\<^sub>R a" in subsetD) + apply simp_all + by (metis add_cancel_right_right divide_1 zero_neq_one) + then show ?thesis by force +qed + +lemma halfspace_eq_empty_lt: + "{x. a \ x < b} = {} \ a = 0 \ b \ 0" +proof - + have "{x. a \ x < b} \ {} \ a = 0 \ b \ 0" + apply (rule ccontr) + apply (drule_tac c = "((b-1) / (a \ a)) *\<^sub>R a" in subsetD) + apply force+ + done + then show ?thesis by force +qed + +lemma halfspace_eq_empty_gt: + "{x. a \ x > b} = {} \ a = 0 \ b \ 0" +using halfspace_eq_empty_lt [of "-a" "-b"] +by simp + +lemma halfspace_eq_empty_le: + "{x. a \ x \ b} = {} \ a = 0 \ b < 0" +proof - + have "{x. a \ x \ b} \ {} \ a = 0 \ b < 0" + apply (rule ccontr) + apply (drule_tac c = "((b-1) / (a \ a)) *\<^sub>R a" in subsetD) + apply force+ + done + then show ?thesis by force +qed + +lemma halfspace_eq_empty_ge: + "{x. a \ x \ b} = {} \ a = 0 \ b > 0" +using halfspace_eq_empty_le [of "-a" "-b"] +by simp + +subsubsection\Representing affine hull as a finite intersection of hyperplanes\ + +proposition affine_hull_convex_Int_nonempty_interior: + fixes S :: "'a::real_normed_vector set" + assumes "convex S" "S \ interior T \ {}" + shows "affine hull (S \ T) = affine hull S" +proof + show "affine hull (S \ T) \ affine hull S" + by (simp add: hull_mono) +next + obtain a where "a \ S" "a \ T" and at: "a \ interior T" + using assms interior_subset by blast + then obtain e where "e > 0" and e: "cball a e \ T" + using mem_interior_cball by blast + have *: "x \ op + a ` span ((\x. x - a) ` (S \ T))" if "x \ S" for x + proof (cases "x = a") + case True with that span_0 eq_add_iff image_def mem_Collect_eq show ?thesis + by blast + next + case False + def k \ "min (1/2) (e / norm (x-a))" + have k: "0 < k" "k < 1" + using \e > 0\ False by (auto simp: k_def) + then have xa: "(x-a) = inverse k *\<^sub>R k *\<^sub>R (x-a)" + by simp + have "e / norm (x - a) \ k" + using k_def by linarith + then have "a + k *\<^sub>R (x - a) \ cball a e" + using \0 < k\ False by (simp add: dist_norm field_simps) + then have T: "a + k *\<^sub>R (x - a) \ T" + using e by blast + have S: "a + k *\<^sub>R (x - a) \ S" + using k \a \ S\ convexD [OF \convex S\ \a \ S\ \x \ S\, of "1-k" k] + by (simp add: algebra_simps) + have "inverse k *\<^sub>R k *\<^sub>R (x-a) \ span ((\x. x - a) ` (S \ T))" + apply (rule span_mul) + apply (rule span_superset) + apply (rule image_eqI [where x = "a + k *\<^sub>R (x - a)"]) + apply (auto simp: S T) + done + with xa image_iff show ?thesis by fastforce + qed + show "affine hull S \ affine hull (S \ T)" + apply (simp add: subset_hull) + apply (simp add: \a \ S\ \a \ T\ hull_inc affine_hull_span_gen [of a]) + apply (force simp: *) + done +qed + +corollary affine_hull_convex_Int_open: + fixes S :: "'a::real_normed_vector set" + assumes "convex S" "open T" "S \ T \ {}" + shows "affine hull (S \ T) = affine hull S" +using affine_hull_convex_Int_nonempty_interior assms interior_eq by blast + +corollary affine_hull_affine_Int_nonempty_interior: + fixes S :: "'a::real_normed_vector set" + assumes "affine S" "S \ interior T \ {}" + shows "affine hull (S \ T) = affine hull S" +by (simp add: affine_hull_convex_Int_nonempty_interior affine_imp_convex assms) + +corollary affine_hull_affine_inter_open: + fixes S :: "'a::real_normed_vector set" + assumes "affine S" "open T" "S \ T \ {}" + shows "affine hull (S \ T) = affine hull S" +by (simp add: affine_hull_convex_Int_open affine_imp_convex assms) + +corollary affine_hull_convex_Int_openin: + fixes S :: "'a::real_normed_vector set" + assumes "convex S" "openin (subtopology euclidean (affine hull S)) T" "S \ T \ {}" + shows "affine hull (S \ T) = affine hull S" +using assms unfolding openin_open +by (metis affine_hull_convex_Int_open hull_subset inf.orderE inf_assoc) + +corollary affine_hull_open_in: + fixes S :: "'a::real_normed_vector set" + assumes "openin (subtopology euclidean (affine hull T)) S" "S \ {}" + shows "affine hull S = affine hull T" +using assms unfolding openin_open +by (metis affine_affine_hull affine_hull_affine_inter_open hull_hull) + +corollary affine_hull_open: + fixes S :: "'a::real_normed_vector set" + assumes "open S" "S \ {}" + shows "affine hull S = UNIV" +by (metis affine_hull_convex_Int_nonempty_interior assms convex_UNIV hull_UNIV inf_top.left_neutral interior_open) + +lemma aff_dim_convex_Int_nonempty_interior: + fixes S :: "'a::euclidean_space set" + shows "\convex S; S \ interior T \ {}\ \ aff_dim(S \ T) = aff_dim S" +using aff_dim_affine_hull2 affine_hull_convex_Int_nonempty_interior by blast + +lemma aff_dim_convex_Int_open: + fixes S :: "'a::euclidean_space set" + shows "\convex S; open T; S \ T \ {}\ \ aff_dim(S \ T) = aff_dim S" +using aff_dim_convex_Int_nonempty_interior interior_eq by blast + +lemma affine_hull_halfspace_lt: + fixes a :: "'a::euclidean_space" + shows "affine hull {x. a \ x < r} = (if a = 0 \ r \ 0 then {} else UNIV)" +using halfspace_eq_empty_lt [of a r] +by (simp add: open_halfspace_lt affine_hull_open) + +lemma affine_hull_halfspace_le: + fixes a :: "'a::euclidean_space" + shows "affine hull {x. a \ x \ r} = (if a = 0 \ r < 0 then {} else UNIV)" +proof (cases "a = 0") + case True then show ?thesis by simp +next + case False + then have "affine hull closure {x. a \ x < r} = UNIV" + using affine_hull_halfspace_lt closure_same_affine_hull by fastforce + moreover have "{x. a \ x < r} \ {x. a \ x \ r}" + by (simp add: Collect_mono) + ultimately show ?thesis using False antisym_conv hull_mono top_greatest + by (metis affine_hull_halfspace_lt) +qed + +lemma affine_hull_halfspace_gt: + fixes a :: "'a::euclidean_space" + shows "affine hull {x. a \ x > r} = (if a = 0 \ r \ 0 then {} else UNIV)" +using halfspace_eq_empty_gt [of r a] +by (simp add: open_halfspace_gt affine_hull_open) + +lemma affine_hull_halfspace_ge: + fixes a :: "'a::euclidean_space" + shows "affine hull {x. a \ x \ r} = (if a = 0 \ r > 0 then {} else UNIV)" +using affine_hull_halfspace_le [of "-a" "-r"] by simp + +lemma aff_dim_halfspace_lt: + fixes a :: "'a::euclidean_space" + shows "aff_dim {x. a \ x < r} = + (if a = 0 \ r \ 0 then -1 else DIM('a))" +by simp (metis aff_dim_open halfspace_eq_empty_lt open_halfspace_lt) + +lemma aff_dim_halfspace_le: + fixes a :: "'a::euclidean_space" + shows "aff_dim {x. a \ x \ r} = + (if a = 0 \ r < 0 then -1 else DIM('a))" +proof - + have "int (DIM('a)) = aff_dim (UNIV::'a set)" + by (simp add: aff_dim_univ) + then have "aff_dim (affine hull {x. a \ x \ r}) = DIM('a)" if "(a = 0 \ r \ 0)" + using that by (simp add: affine_hull_halfspace_le not_less) + then show ?thesis + by (force simp: aff_dim_affine_hull) +qed + +lemma aff_dim_halfspace_gt: + fixes a :: "'a::euclidean_space" + shows "aff_dim {x. a \ x > r} = + (if a = 0 \ r \ 0 then -1 else DIM('a))" +by simp (metis aff_dim_open halfspace_eq_empty_gt open_halfspace_gt) + +lemma aff_dim_halfspace_ge: + fixes a :: "'a::euclidean_space" + shows "aff_dim {x. a \ x \ r} = + (if a = 0 \ r > 0 then -1 else DIM('a))" +using aff_dim_halfspace_le [of "-a" "-r"] by simp + +subsection\Properties of special hyperplanes\ + +lemma subspace_hyperplane: "subspace {x. a \ x = 0}" + by (simp add: subspace_def inner_right_distrib) + +lemma special_hyperplane_span: + fixes S :: "'n::euclidean_space set" + assumes "k \ Basis" + shows "{x. k \ x = 0} = span (Basis - {k})" +proof - + have *: "x \ span (Basis - {k})" if "k \ x = 0" for x + proof - + have "x = (\b\Basis. (x \ b) *\<^sub>R b)" + by (simp add: euclidean_representation) + also have "... = (\b \ Basis - {k}. (x \ b) *\<^sub>R b)" + by (auto simp: setsum.remove [of _ k] inner_commute assms that) + finally have "x = (\b\Basis - {k}. (x \ b) *\<^sub>R b)" . + then show ?thesis + by (simp add: Linear_Algebra.span_finite) metis + qed + show ?thesis + apply (rule span_subspace [symmetric]) + using assms + apply (auto simp: inner_not_same_Basis intro: * subspace_hyperplane) + done +qed + +lemma dim_special_hyperplane: + fixes k :: "'n::euclidean_space" + shows "k \ Basis \ dim {x. k \ x = 0} = DIM('n) - 1" +apply (simp add: special_hyperplane_span) +apply (rule Linear_Algebra.dim_unique [OF subset_refl]) +apply (auto simp: Diff_subset independent_substdbasis) +apply (metis member_remove remove_def span_clauses(1)) +done + +proposition dim_hyperplane: + fixes a :: "'a::euclidean_space" + assumes "a \ 0" + shows "dim {x. a \ x = 0} = DIM('a) - 1" +proof - + have span0: "span {x. a \ x = 0} = {x. a \ x = 0}" + by (rule span_unique) (auto simp: subspace_hyperplane) + then obtain B where "independent B" + and Bsub: "B \ {x. a \ x = 0}" + and subspB: "{x. a \ x = 0} \ span B" + and card0: "(card B = dim {x. a \ x = 0})" + and ortho: "pairwise orthogonal B" + using orthogonal_basis_exists by metis + with assms have "a \ span B" + by (metis (mono_tags, lifting) span_eq inner_eq_zero_iff mem_Collect_eq span0 span_subspace) + then have ind: "independent (insert a B)" + by (simp add: \independent B\ independent_insert) + have "finite B" + using \independent B\ independent_bound by blast + have "UNIV \ span (insert a B)" + proof fix y::'a + obtain r z where z: "y = r *\<^sub>R a + z" "a \ z = 0" + apply (rule_tac r="(a \ y) / (a \ a)" and z = "y - ((a \ y) / (a \ a)) *\<^sub>R a" in that) + using assms + by (auto simp: algebra_simps) + show "y \ span (insert a B)" + by (metis (mono_tags, lifting) z Bsub Convex_Euclidean_Space.span_eq + add_diff_cancel_left' mem_Collect_eq span0 span_breakdown_eq span_subspace subspB) + qed + then have dima: "DIM('a) = dim(insert a B)" + by (metis antisym dim_UNIV dim_subset_UNIV subset_le_dim) + then show ?thesis + by (metis (mono_tags, lifting) Bsub Diff_insert_absorb \a \ span B\ ind card0 card_Diff_singleton dim_span indep_card_eq_dim_span insertI1 subsetCE subspB) +qed + +lemma lowdim_eq_hyperplane: + fixes S :: "'a::euclidean_space set" + assumes "dim S = DIM('a) - 1" + obtains a where "a \ 0" and "span S = {x. a \ x = 0}" +proof - + have [simp]: "dim S < DIM('a)" + by (simp add: DIM_positive assms) + then obtain b where b: "b \ 0" "span S \ {a. b \ a = 0}" + using lowdim_subset_hyperplane [of S] by fastforce + show ?thesis + using b that real_vector_class.subspace_span [of S] + by (simp add: assms dim_hyperplane subspace_dim_equal subspace_hyperplane) +qed + +lemma dim_eq_hyperplane: + fixes S :: "'n::euclidean_space set" + shows "dim S = DIM('n) - 1 \ (\a. a \ 0 \ span S = {x. a \ x = 0})" +by (metis One_nat_def dim_hyperplane dim_span lowdim_eq_hyperplane) + +proposition aff_dim_eq_hyperplane: + fixes S :: "'a::euclidean_space set" + shows "aff_dim S = DIM('a) - 1 \ (\a b. a \ 0 \ affine hull S = {x. a \ x = b})" +proof (cases "S = {}") + case True then show ?thesis + by (auto simp: dest: hyperplane_eq_Ex) +next + case False + then obtain c where "c \ S" by blast + show ?thesis + proof (cases "c = 0") + case True show ?thesis + apply (simp add: aff_dim_eq_dim [of c] affine_hull_span_gen [of c] \c \ S\ hull_inc dim_eq_hyperplane + del: One_nat_def) + apply (rule ex_cong) + using span_0 + apply (force simp: \c = 0\) + done + next + case False + have xc_im: "x \ op + c ` {y. a \ y = 0}" if "a \ x = a \ c" for a x + proof - + have "\y. a \ y = 0 \ c + y = x" + by (metis that add.commute diff_add_cancel inner_commute inner_diff_left right_minus_eq) + then show "x \ op + c ` {y. a \ y = 0}" + by blast + qed + have 2: "span ((\x. x - c) ` S) = {x. a \ x = 0}" + if "op + c ` span ((\x. x - c) ` S) = {x. a \ x = b}" for a b + proof - + have "b = a \ c" + using span_0 that by fastforce + with that have "op + c ` span ((\x. x - c) ` S) = {x. a \ x = a \ c}" + by simp + then have "span ((\x. x - c) ` S) = (\x. x - c) ` {x. a \ x = a \ c}" + by (metis (no_types) image_cong translation_galois uminus_add_conv_diff) + also have "... = {x. a \ x = 0}" + by (force simp: inner_distrib inner_diff_right + intro: image_eqI [where x="x+c" for x]) + finally show ?thesis . + qed + show ?thesis + apply (simp add: aff_dim_eq_dim [of c] affine_hull_span_gen [of c] \c \ S\ hull_inc dim_eq_hyperplane + del: One_nat_def, safe) + apply (fastforce simp add: inner_distrib intro: xc_im) + apply (force simp: intro!: 2) + done + qed +qed + +corollary aff_dim_hyperplane: + fixes a :: "'a::euclidean_space" + shows "a \ 0 \ aff_dim {x. a \ x = r} = DIM('a) - 1" +by (metis aff_dim_eq_hyperplane affine_hull_eq affine_hyperplane) + +subsection\Some stepping theorems\ + +lemma dim_empty [simp]: "dim ({} :: 'a::euclidean_space set) = 0" + by (force intro!: dim_unique) + +lemma dim_insert: + fixes x :: "'a::euclidean_space" + shows "dim (insert x S) = (if x \ span S then dim S else dim S + 1)" +proof - + show ?thesis + proof (cases "x \ span S") + case True then show ?thesis + by (metis dim_span span_redundant) + next + case False + obtain B where B: "B \ span S" "independent B" "span S \ span B" "card B = dim (span S)" + using basis_exists [of "span S"] by blast + have 1: "insert x B \ span (insert x S)" + by (meson \B \ span S\ dual_order.trans insertI1 insert_subsetI span_mono span_superset subset_insertI) + have 2: "span (insert x S) \ span (insert x B)" + by (metis \B \ span S\ \span S \ span B\ span_breakdown_eq span_subspace subsetI subspace_span) + have 3: "independent (insert x B)" + by (metis B independent_insert span_subspace subspace_span False) + have "dim (span (insert x S)) = Suc (dim S)" + apply (rule dim_unique [OF 1 2 3]) + by (metis B False card_insert_disjoint dim_span independent_imp_finite subsetCE) + then show ?thesis + by (simp add: False) + qed +qed + +lemma dim_singleton [simp]: + fixes x :: "'a::euclidean_space" + shows "dim{x} = (if x = 0 then 0 else 1)" +by (simp add: dim_insert) + +lemma dim_eq_0 [simp]: + fixes S :: "'a::euclidean_space set" + shows "dim S = 0 \ S \ {0}" +apply safe +apply (metis DIM_positive DIM_real card_ge_dim_independent contra_subsetD dim_empty dim_insert dim_singleton empty_subsetI independent_empty less_not_refl zero_le) +by (metis dim_singleton dim_subset le_0_eq) + +lemma aff_dim_insert: + fixes a :: "'a::euclidean_space" + shows "aff_dim (insert a S) = (if a \ affine hull S then aff_dim S else aff_dim S + 1)" +proof (cases "S = {}") + case True then show ?thesis + by simp +next + case False + then obtain x s' where S: "S = insert x s'" "x \ s'" + by (meson Set.set_insert all_not_in_conv) + show ?thesis using S + apply (simp add: hull_redundant cong: aff_dim_affine_hull2) + apply (simp add: affine_hull_insert_span_gen hull_inc) + apply (simp add: insert_commute [of a] hull_inc aff_dim_eq_dim [of x] dim_insert span_0) + apply (metis (no_types, lifting) add_minus_cancel image_iff uminus_add_conv_diff) + done +qed + +lemma subspace_bounded_eq_trivial: + fixes S :: "'a::real_normed_vector set" + assumes "subspace S" + shows "bounded S \ S = {0}" +proof - + have "False" if "bounded S" "x \ S" "x \ 0" for x + proof - + obtain B where B: "\y. y \ S \ norm y < B" "B > 0" + using \bounded S\ by (force simp: bounded_pos_less) + have "(B / norm x) *\<^sub>R x \ S" + using assms subspace_mul \x \ S\ by auto + moreover have "norm ((B / norm x) *\<^sub>R x) = B" + using that B by (simp add: algebra_simps) + ultimately show False using B by force + qed + then have "bounded S \ S = {0}" + using assms subspace_0 by fastforce + then show ?thesis + by blast +qed + +lemma affine_bounded_eq_trivial: + fixes S :: "'a::real_normed_vector set" + assumes "affine S" + shows "bounded S \ S = {} \ (\a. S = {a})" +proof (cases "S = {}") + case True then show ?thesis + by simp +next + case False + then obtain b where "b \ S" by blast + with False assms show ?thesis + apply safe + using affine_diffs_subspace [OF assms \b \ S\] + apply (metis (no_types, lifting) subspace_bounded_eq_trivial ab_left_minus bounded_translation + image_empty image_insert translation_invert) + apply force + done +qed + +lemma affine_bounded_eq_lowdim: + fixes S :: "'a::euclidean_space set" + assumes "affine S" + shows "bounded S \ aff_dim S \ 0" +apply safe +using affine_bounded_eq_trivial assms apply fastforce +by (metis aff_dim_sing aff_dim_subset affine_dim_equal affine_sing all_not_in_conv assms bounded_empty bounded_insert dual_order.antisym empty_subsetI insert_subset) + + +lemma bounded_hyperplane_eq_trivial_0: + fixes a :: "'a::euclidean_space" + assumes "a \ 0" + shows "bounded {x. a \ x = 0} \ DIM('a) = 1" +proof + assume "bounded {x. a \ x = 0}" + then have "aff_dim {x. a \ x = 0} \ 0" + by (simp add: affine_bounded_eq_lowdim affine_hyperplane) + with assms show "DIM('a) = 1" + by (simp add: le_Suc_eq aff_dim_hyperplane) +next + assume "DIM('a) = 1" + then show "bounded {x. a \ x = 0}" + by (simp add: aff_dim_hyperplane affine_bounded_eq_lowdim affine_hyperplane assms) +qed + +lemma bounded_hyperplane_eq_trivial: + fixes a :: "'a::euclidean_space" + shows "bounded {x. a \ x = r} \ (if a = 0 then r \ 0 else DIM('a) = 1)" +proof (simp add: bounded_hyperplane_eq_trivial_0, clarify) + assume "r \ 0" "a \ 0" + have "aff_dim {x. y \ x = 0} = aff_dim {x. a \ x = r}" if "y \ 0" for y::'a + by (metis that \a \ 0\ aff_dim_hyperplane) + then show "bounded {x. a \ x = r} = (DIM('a) = Suc 0)" + by (metis One_nat_def \a \ 0\ affine_bounded_eq_lowdim affine_hyperplane bounded_hyperplane_eq_trivial_0) +qed + +subsection\General case without assuming closure and getting non-strict separation\ + +proposition separating_hyperplane_closed_point_inset: + fixes S :: "'a::euclidean_space set" + assumes "convex S" "closed S" "S \ {}" "z \ S" + obtains a b where "a \ S" "(a - z) \ z < b" "\x. x \ S \ b < (a - z) \ x" +proof - + obtain y where "y \ S" and y: "\u. u \ S \ dist z y \ dist z u" + using distance_attains_inf [of S z] assms by auto + then have *: "(y - z) \ z < (y - z) \ z + (norm (y - z))\<^sup>2 / 2" + using \y \ S\ \z \ S\ by auto + show ?thesis + proof (rule that [OF \y \ S\ *]) + fix x + assume "x \ S" + have yz: "0 < (y - z) \ (y - z)" + using \y \ S\ \z \ S\ by auto + { assume 0: "0 < ((z - y) \ (x - y))" + with any_closest_point_dot [OF \convex S\ \closed S\] + have False + using y \x \ S\ \y \ S\ not_less by blast + } + then have "0 \ ((y - z) \ (x - y))" + by (force simp: not_less inner_diff_left) + with yz have "0 < 2 * ((y - z) \ (x - y)) + (y - z) \ (y - z)" + by (simp add: algebra_simps) + then show "(y - z) \ z + (norm (y - z))\<^sup>2 / 2 < (y - z) \ x" + by (simp add: field_simps inner_diff_left inner_diff_right dot_square_norm [symmetric]) + qed +qed + +lemma separating_hyperplane_closed_0_inset: + fixes S :: "'a::euclidean_space set" + assumes "convex S" "closed S" "S \ {}" "0 \ S" + obtains a b where "a \ S" "a \ 0" "0 < b" "\x. x \ S \ a \ x > b" +using separating_hyperplane_closed_point_inset [OF assms] +by simp (metis \0 \ S\) + + +proposition separating_hyperplane_set_0_inspan: + fixes S :: "'a::euclidean_space set" + assumes "convex S" "S \ {}" "0 \ S" + obtains a where "a \ span S" "a \ 0" "\x. x \ S \ 0 \ a \ x" +proof - + def k \ "\c::'a. {x. 0 \ c \ x}" + have *: "span S \ frontier (cball 0 1) \ \f' \ {}" + if f': "finite f'" "f' \ k ` S" for f' + proof - + obtain C where "C \ S" "finite C" and C: "f' = k ` C" + using finite_subset_image [OF f'] by blast + obtain a where "a \ S" "a \ 0" + using \S \ {}\ \0 \ S\ ex_in_conv by blast + then have "norm (a /\<^sub>R (norm a)) = 1" + by simp + moreover have "a /\<^sub>R (norm a) \ span S" + by (simp add: \a \ S\ span_mul span_superset) + ultimately have ass: "a /\<^sub>R (norm a) \ span S \ sphere 0 1" + by simp + show ?thesis + proof (cases "C = {}") + case True with C ass show ?thesis + by auto + next + case False + have "closed (convex hull C)" + using \finite C\ compact_eq_bounded_closed finite_imp_compact_convex_hull by auto + moreover have "convex hull C \ {}" + by (simp add: False) + moreover have "0 \ convex hull C" + by (metis \C \ S\ \convex S\ \0 \ S\ convex_hull_subset hull_same insert_absorb insert_subset) + ultimately obtain a b + where "a \ convex hull C" "a \ 0" "0 < b" + and ab: "\x. x \ convex hull C \ a \ x > b" + using separating_hyperplane_closed_0_inset by blast + then have "a \ S" + by (metis \C \ S\ assms(1) subsetCE subset_hull) + moreover have "norm (a /\<^sub>R (norm a)) = 1" + using \a \ 0\ by simp + moreover have "a /\<^sub>R (norm a) \ span S" + by (simp add: \a \ S\ span_mul span_superset) + ultimately have ass: "a /\<^sub>R (norm a) \ span S \ sphere 0 1" + by simp + have aa: "a /\<^sub>R (norm a) \ (\c\C. {x. 0 \ c \ x})" + apply (clarsimp simp add: divide_simps) + using ab \0 < b\ + by (metis hull_inc inner_commute less_eq_real_def less_trans) + show ?thesis + apply (simp add: C k_def) + using ass aa Int_iff empty_iff by blast + qed + qed + have "(span S \ frontier(cball 0 1)) \ (\ (k ` S)) \ {}" + apply (rule compact_imp_fip) + apply (blast intro: compact_cball) + using closed_halfspace_ge k_def apply blast + apply (metis *) + done + then show ?thesis + unfolding set_eq_iff k_def + by simp (metis inner_commute norm_eq_zero that zero_neq_one) +qed + + +lemma separating_hyperplane_set_point_inaff: + fixes S :: "'a::euclidean_space set" + assumes "convex S" "S \ {}" and zno: "z \ S" + obtains a b where "(z + a) \ affine hull (insert z S)" + and "a \ 0" and "a \ z \ b" + and "\x. x \ S \ a \ x \ b" +proof - +from separating_hyperplane_set_0_inspan [of "image (\x. -z + x) S"] + have "convex (op + (- z) ` S)" + by (simp add: \convex S\) + moreover have "op + (- z) ` S \ {}" + by (simp add: \S \ {}\) + moreover have "0 \ op + (- z) ` S" + using zno by auto + ultimately obtain a where "a \ span (op + (- z) ` S)" "a \ 0" + and a: "\x. x \ (op + (- z) ` S) \ 0 \ a \ x" + using separating_hyperplane_set_0_inspan [of "image (\x. -z + x) S"] + by blast + then have szx: "\x. x \ S \ a \ z \ a \ x" + by (metis (no_types, lifting) imageI inner_minus_right inner_right_distrib minus_add neg_le_0_iff_le neg_le_iff_le real_add_le_0_iff) + show ?thesis + apply (rule_tac a=a and b = "a \ z" in that, simp_all) + using \a \ span (op + (- z) ` S)\ affine_hull_insert_span_gen apply blast + apply (simp_all add: \a \ 0\ szx) + done +qed + +proposition supporting_hyperplane_relative_boundary: + fixes S :: "'a::euclidean_space set" + assumes "convex S" "x \ S" and xno: "x \ rel_interior S" + obtains a where "a \ 0" + and "\y. y \ S \ a \ x \ a \ y" + and "\y. y \ rel_interior S \ a \ x < a \ y" +proof - + obtain a b where aff: "(x + a) \ affine hull (insert x (rel_interior S))" + and "a \ 0" and "a \ x \ b" + and ageb: "\u. u \ (rel_interior S) \ a \ u \ b" + using separating_hyperplane_set_point_inaff [of "rel_interior S" x] assms + by (auto simp: rel_interior_eq_empty convex_rel_interior) + have le_ay: "a \ x \ a \ y" if "y \ S" for y + proof - + have con: "continuous_on (closure (rel_interior S)) (op \ a)" + by (rule continuous_intros continuous_on_subset | blast)+ + have y: "y \ closure (rel_interior S)" + using \convex S\ closure_def convex_closure_rel_interior \y \ S\ + by fastforce + show ?thesis + using continuous_ge_on_closure [OF con y] ageb \a \ x \ b\ + by fastforce + qed + have 3: "a \ x < a \ y" if "y \ rel_interior S" for y + proof - + obtain e where "0 < e" "y \ S" and e: "cball y e \ affine hull S \ S" + using \y \ rel_interior S\ by (force simp: rel_interior_cball) + def y' \ "y - (e / norm a) *\<^sub>R ((x + a) - x)" + have "y' \ cball y e" + unfolding y'_def using \0 < e\ by force + moreover have "y' \ affine hull S" + unfolding y'_def + by (metis \x \ S\ \y \ S\ \convex S\ aff affine_affine_hull hull_redundant + rel_interior_same_affine_hull hull_inc mem_affine_3_minus2) + ultimately have "y' \ S" + using e by auto + have "a \ x \ a \ y" + using le_ay \a \ 0\ \y \ S\ by blast + moreover have "a \ x \ a \ y" + using le_ay [OF \y' \ S\] \a \ 0\ + apply (simp add: y'_def inner_diff dot_square_norm power2_eq_square) + by (metis \0 < e\ add_le_same_cancel1 inner_commute inner_real_def inner_zero_left le_diff_eq norm_le_zero_iff real_mult_le_cancel_iff2) + ultimately show ?thesis by force + qed + show ?thesis + by (rule that [OF \a \ 0\ le_ay 3]) +qed + +lemma supporting_hyperplane_relative_frontier: + fixes S :: "'a::euclidean_space set" + assumes "convex S" "x \ closure S" "x \ rel_interior S" + obtains a where "a \ 0" + and "\y. y \ closure S \ a \ x \ a \ y" + and "\y. y \ rel_interior S \ a \ x < a \ y" +using supporting_hyperplane_relative_boundary [of "closure S" x] +by (metis assms convex_closure convex_rel_interior_closure) + +subsection\ Some results on decomposing convex hulls, e.g. simplicial subdivision\ + +lemma + fixes s :: "'a::euclidean_space set" + assumes "~ (affine_dependent(s \ t))" + shows convex_hull_Int_subset: "convex hull s \ convex hull t \ convex hull (s \ t)" (is ?C) + and affine_hull_Int_subset: "affine hull s \ affine hull t \ affine hull (s \ t)" (is ?A) +proof - + have [simp]: "finite s" "finite t" + using aff_independent_finite assms by blast+ + have "setsum u (s \ t) = 1 \ + (\v\s \ t. u v *\<^sub>R v) = (\v\s. u v *\<^sub>R v)" + if [simp]: "setsum u s = 1" + "setsum v t = 1" + and eq: "(\x\t. v x *\<^sub>R x) = (\x\s. u x *\<^sub>R x)" for u v + proof - + def f \ "\x. (if x \ s then u x else 0) - (if x \ t then v x else 0)" + have "setsum f (s \ t) = 0" + apply (simp add: f_def setsum_Un setsum_subtractf) + apply (simp add: setsum.inter_restrict [symmetric] Int_commute) + done + moreover have "(\x\(s \ t). f x *\<^sub>R x) = 0" + apply (simp add: f_def setsum_Un scaleR_left_diff_distrib setsum_subtractf) + apply (simp add: if_smult setsum.inter_restrict [symmetric] Int_commute eq cong del: if_cong) + done + ultimately have "\v. v \ s \ t \ f v = 0" + using aff_independent_finite assms unfolding affine_dependent_explicit + by blast + then have u [simp]: "\x. x \ s \ u x = (if x \ t then v x else 0)" + by (simp add: f_def) presburger + have "setsum u (s \ t) = setsum u s" + by (simp add: setsum.inter_restrict) + then have "setsum u (s \ t) = 1" + using that by linarith + moreover have "(\v\s \ t. u v *\<^sub>R v) = (\v\s. u v *\<^sub>R v)" + by (auto simp: if_smult setsum.inter_restrict intro: setsum.cong) + ultimately show ?thesis + by force + qed + then show ?A ?C + by (auto simp: convex_hull_finite affine_hull_finite) +qed + + +proposition affine_hull_Int: + fixes s :: "'a::euclidean_space set" + assumes "~ (affine_dependent(s \ t))" + shows "affine hull (s \ t) = affine hull s \ affine hull t" +apply (rule subset_antisym) +apply (simp add: hull_mono) +by (simp add: affine_hull_Int_subset assms) + +proposition convex_hull_Int: + fixes s :: "'a::euclidean_space set" + assumes "~ (affine_dependent(s \ t))" + shows "convex hull (s \ t) = convex hull s \ convex hull t" +apply (rule subset_antisym) +apply (simp add: hull_mono) +by (simp add: convex_hull_Int_subset assms) + +proposition + fixes s :: "'a::euclidean_space set set" + assumes "~ (affine_dependent (\s))" + shows affine_hull_Inter: "affine hull (\s) = (\t\s. affine hull t)" (is "?A") + and convex_hull_Inter: "convex hull (\s) = (\t\s. convex hull t)" (is "?C") +proof - + have "finite s" + using aff_independent_finite assms finite_UnionD by blast + then have "?A \ ?C" using assms + proof (induction s rule: finite_induct) + case empty then show ?case by auto + next + case (insert t F) + then show ?case + proof (cases "F={}") + case True then show ?thesis by simp + next + case False + with "insert.prems" have [simp]: "\ affine_dependent (t \ \F)" + by (auto intro: affine_dependent_subset) + have [simp]: "\ affine_dependent (\F)" + using affine_independent_subset insert.prems by fastforce + show ?thesis + by (simp add: affine_hull_Int convex_hull_Int insert.IH) + qed + qed + then show "?A" "?C" + by auto +qed + +lemma affine_hull_finite_intersection_hyperplanes: + fixes s :: "'a::euclidean_space set" + obtains f where + "finite f" + "of_nat (card f) + aff_dim s = DIM('a)" + "affine hull s = \f" + "\h. h \ f \ \a b. a \ 0 \ h = {x. a \ x = b}" +proof - + obtain b where "b \ s" + and indb: "\ affine_dependent b" + and eq: "affine hull s = affine hull b" + using affine_basis_exists by blast + obtain c where indc: "\ affine_dependent c" and "b \ c" + and affc: "affine hull c = UNIV" + by (metis extend_to_affine_basis affine_UNIV hull_same indb subset_UNIV) + then have "finite c" + by (simp add: aff_independent_finite) + then have fbc: "finite b" "card b \ card c" + using \b \ c\ infinite_super by (auto simp: card_mono) + have imeq: "(\x. affine hull x) ` ((\a. c - {a}) ` (c - b)) = ((\a. affine hull (c - {a})) ` (c - b))" + by blast + have card1: "card ((\a. affine hull (c - {a})) ` (c - b)) = card (c - b)" + apply (rule card_image [OF inj_onI]) + by (metis Diff_eq_empty_iff Diff_iff indc affine_dependent_def hull_subset insert_iff) + have card2: "(card (c - b)) + aff_dim s = DIM('a)" + proof - + have aff: "aff_dim (UNIV::'a set) = aff_dim c" + by (metis aff_dim_affine_hull affc) + have "aff_dim b = aff_dim s" + by (metis (no_types) aff_dim_affine_hull eq) + then have "int (card b) = 1 + aff_dim s" + by (simp add: aff_dim_affine_independent indb) + then show ?thesis + using fbc aff + by (simp add: \\ affine_dependent c\ \b \ c\ aff_dim_affine_independent aff_dim_univ card_Diff_subset of_nat_diff) + qed + show ?thesis + proof (cases "c = b") + case True show ?thesis + apply (rule_tac f="{}" in that) + using True affc + apply (simp_all add: eq [symmetric]) + by (metis aff_dim_univ aff_dim_affine_hull) + next + case False + have ind: "\ affine_dependent (\a\c - b. c - {a})" + by (rule affine_independent_subset [OF indc]) auto + have affeq: "affine hull s = (\x\(\a. c - {a}) ` (c - b). affine hull x)" + using \b \ c\ False + apply (subst affine_hull_Inter [OF ind, symmetric]) + apply (simp add: eq double_diff) + done + have *: "1 + aff_dim (c - {t}) = int (DIM('a))" + if t: "t \ c" for t + proof - + have "insert t c = c" + using t by blast + then show ?thesis + by (metis (full_types) add.commute aff_dim_affine_hull aff_dim_insert aff_dim_univ affc affine_dependent_def indc insert_Diff_single t) + qed + show ?thesis + apply (rule_tac f = "(\x. affine hull x) ` ((\a. c - {a}) ` (c - b))" in that) + using \finite c\ apply blast + apply (simp add: imeq card1 card2) + apply (simp add: affeq, clarify) + apply (metis DIM_positive One_nat_def Suc_leI add_diff_cancel_left' of_nat_1 aff_dim_eq_hyperplane of_nat_diff *) + done + qed +qed + end diff -r aa894a49f77d -r 3590590699b1 src/HOL/Multivariate_Analysis/Path_Connected.thy --- a/src/HOL/Multivariate_Analysis/Path_Connected.thy Mon Apr 18 14:30:32 2016 +0100 +++ b/src/HOL/Multivariate_Analysis/Path_Connected.thy Mon Apr 18 15:40:55 2016 +0100 @@ -1239,10 +1239,6 @@ by (simp add: midpoint_def algebra_simps) qed -lemma convex_hull_subset: - "s \ convex hull t \ convex hull s \ convex hull t" - by (simp add: convex_convex_hull subset_hull) - lemma not_in_interior_convex_hull_3: fixes a :: "complex" shows "a \ interior(convex hull {a,b,c})"