src/HOL/Analysis/Starlike.thy
changeset 70136 f03a01a18c6e
parent 69922 4a9167f377b0
child 70138 bd42cc1e10d0
equal deleted inserted replaced
70135:ad6d4a14adb5 70136:f03a01a18c6e
    13 
    13 
    14 section \<open>Line Segments\<close>
    14 section \<open>Line Segments\<close>
    15 
    15 
    16 subsection \<open>Midpoint\<close>
    16 subsection \<open>Midpoint\<close>
    17 
    17 
    18 definition%important midpoint :: "'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a"
    18 definition\<^marker>\<open>tag important\<close> midpoint :: "'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a"
    19   where "midpoint a b = (inverse (2::real)) *\<^sub>R (a + b)"
    19   where "midpoint a b = (inverse (2::real)) *\<^sub>R (a + b)"
    20 
    20 
    21 lemma midpoint_idem [simp]: "midpoint x x = x"
    21 lemma midpoint_idem [simp]: "midpoint x x = x"
    22   unfolding midpoint_def  by simp
    22   unfolding midpoint_def  by simp
    23 
    23 
    89 by (simp add: linear_iff midpoint_def)
    89 by (simp add: linear_iff midpoint_def)
    90 
    90 
    91 
    91 
    92 subsection \<open>Line segments\<close>
    92 subsection \<open>Line segments\<close>
    93 
    93 
    94 definition%important closed_segment :: "'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a set"
    94 definition\<^marker>\<open>tag important\<close> closed_segment :: "'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a set"
    95   where "closed_segment a b = {(1 - u) *\<^sub>R a + u *\<^sub>R b | u::real. 0 \<le> u \<and> u \<le> 1}"
    95   where "closed_segment a b = {(1 - u) *\<^sub>R a + u *\<^sub>R b | u::real. 0 \<le> u \<and> u \<le> 1}"
    96 
    96 
    97 definition%important open_segment :: "'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a set" where
    97 definition\<^marker>\<open>tag important\<close> open_segment :: "'a::real_vector \<Rightarrow> 'a \<Rightarrow> 'a set" where
    98   "open_segment a b \<equiv> closed_segment a b - {a,b}"
    98   "open_segment a b \<equiv> closed_segment a b - {a,b}"
    99 
    99 
   100 lemmas segment = open_segment_def closed_segment_def
   100 lemmas segment = open_segment_def closed_segment_def
   101 
   101 
   102 lemma in_segment:
   102 lemma in_segment:
   616   by (cases "a \<le> b"; cases "f b \<ge> f a") (auto simp: closed_segment_eq_real_ivl continuous_on_minus)
   616   by (cases "a \<le> b"; cases "f b \<ge> f a") (auto simp: closed_segment_eq_real_ivl continuous_on_minus)
   617 
   617 
   618 
   618 
   619 subsection\<open>Starlike sets\<close>
   619 subsection\<open>Starlike sets\<close>
   620 
   620 
   621 definition%important "starlike S \<longleftrightarrow> (\<exists>a\<in>S. \<forall>x\<in>S. closed_segment a x \<subseteq> S)"
   621 definition\<^marker>\<open>tag important\<close> "starlike S \<longleftrightarrow> (\<exists>a\<in>S. \<forall>x\<in>S. closed_segment a x \<subseteq> S)"
   622 
   622 
   623 lemma starlike_UNIV [simp]: "starlike UNIV"
   623 lemma starlike_UNIV [simp]: "starlike UNIV"
   624   by (simp add: starlike_def)
   624   by (simp add: starlike_def)
   625 
   625 
   626 lemma convex_imp_starlike:
   626 lemma convex_imp_starlike:
   679   qed
   679   qed
   680   show "?rhs \<subseteq> ?lhs"
   680   show "?rhs \<subseteq> ?lhs"
   681     by (meson hull_mono inf_mono subset_insertI subset_refl)
   681     by (meson hull_mono inf_mono subset_insertI subset_refl)
   682 qed
   682 qed
   683 
   683 
   684 subsection%unimportant\<open>More results about segments\<close>
   684 subsection\<^marker>\<open>tag unimportant\<close>\<open>More results about segments\<close>
   685 
   685 
   686 lemma dist_half_times2:
   686 lemma dist_half_times2:
   687   fixes a :: "'a :: real_normed_vector"
   687   fixes a :: "'a :: real_normed_vector"
   688   shows "dist ((1 / 2) *\<^sub>R (a + b)) x * 2 = dist (a+b) (2 *\<^sub>R x)"
   688   shows "dist ((1 / 2) *\<^sub>R (a + b)) x * 2 = dist (a+b) (2 *\<^sub>R x)"
   689 proof -
   689 proof -
   901 lemmas subset_segment = subset_closed_segment subset_co_segment subset_oc_segment subset_open_segment
   901 lemmas subset_segment = subset_closed_segment subset_co_segment subset_oc_segment subset_open_segment
   902 
   902 
   903 
   903 
   904 subsection\<open>Betweenness\<close>
   904 subsection\<open>Betweenness\<close>
   905 
   905 
   906 definition%important "between = (\<lambda>(a,b) x. x \<in> closed_segment a b)"
   906 definition\<^marker>\<open>tag important\<close> "between = (\<lambda>(a,b) x. x \<in> closed_segment a b)"
   907 
   907 
   908 lemma betweenI:
   908 lemma betweenI:
   909   assumes "0 \<le> u" "u \<le> 1" "x = (1 - u) *\<^sub>R a + u *\<^sub>R b"
   909   assumes "0 \<le> u" "u \<le> 1" "x = (1 - u) *\<^sub>R a + u *\<^sub>R b"
   910   shows "between (a, b) x"
   910   shows "between (a, b) x"
   911 using assms unfolding between_def closed_segment_def by auto
   911 using assms unfolding between_def closed_segment_def by auto
  1057   fixes x::real
  1057   fixes x::real
  1058   shows "between (a,b) x \<longleftrightarrow> (a \<le> x \<and> x \<le> b) \<or> (b \<le> x \<and> x \<le> a)"
  1058   shows "between (a,b) x \<longleftrightarrow> (a \<le> x \<and> x \<le> b) \<or> (b \<le> x \<and> x \<le> a)"
  1059   by (auto simp: between_mem_segment closed_segment_eq_real_ivl)
  1059   by (auto simp: between_mem_segment closed_segment_eq_real_ivl)
  1060 
  1060 
  1061 
  1061 
  1062 subsection%unimportant \<open>Shrinking towards the interior of a convex set\<close>
  1062 subsection\<^marker>\<open>tag unimportant\<close> \<open>Shrinking towards the interior of a convex set\<close>
  1063 
  1063 
  1064 lemma mem_interior_convex_shrink:
  1064 lemma mem_interior_convex_shrink:
  1065   fixes S :: "'a::euclidean_space set"
  1065   fixes S :: "'a::euclidean_space set"
  1066   assumes "convex S"
  1066   assumes "convex S"
  1067     and "c \<in> interior S"
  1067     and "c \<in> interior S"
  1245   finally show ?thesis
  1245   finally show ?thesis
  1246     by (simp add: closure_mono dual_order.antisym)
  1246     by (simp add: closure_mono dual_order.antisym)
  1247 qed
  1247 qed
  1248 
  1248 
  1249 
  1249 
  1250 subsection%unimportant \<open>Some obvious but surprisingly hard simplex lemmas\<close>
  1250 subsection\<^marker>\<open>tag unimportant\<close> \<open>Some obvious but surprisingly hard simplex lemmas\<close>
  1251 
  1251 
  1252 lemma simplex:
  1252 lemma simplex:
  1253   assumes "finite S"
  1253   assumes "finite S"
  1254     and "0 \<notin> S"
  1254     and "0 \<notin> S"
  1255   shows "convex hull (insert 0 S) = {y. \<exists>u. (\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S \<le> 1 \<and> sum (\<lambda>x. u x *\<^sub>R x) S = y}"
  1255   shows "convex hull (insert 0 S) = {y. \<exists>u. (\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S \<le> 1 \<and> sum (\<lambda>x. u x *\<^sub>R x) S = y}"
  1629       using \<open>i \<notin> D\<close> unfolding span_substd_basis[OF assms(2)] using \<open>i \<in> Basis\<close> by auto
  1629       using \<open>i \<notin> D\<close> unfolding span_substd_basis[OF assms(2)] using \<open>i \<in> Basis\<close> by auto
  1630   qed
  1630   qed
  1631 qed
  1631 qed
  1632 
  1632 
  1633 
  1633 
  1634 subsection%unimportant \<open>Relative interior of convex set\<close>
  1634 subsection\<^marker>\<open>tag unimportant\<close> \<open>Relative interior of convex set\<close>
  1635 
  1635 
  1636 lemma rel_interior_convex_nonempty_aux:
  1636 lemma rel_interior_convex_nonempty_aux:
  1637   fixes S :: "'n::euclidean_space set"
  1637   fixes S :: "'n::euclidean_space set"
  1638   assumes "convex S"
  1638   assumes "convex S"
  1639     and "0 \<in> S"
  1639     and "0 \<in> S"
  2017     done
  2017     done
  2018 qed
  2018 qed
  2019 
  2019 
  2020 subsection\<open>The relative frontier of a set\<close>
  2020 subsection\<open>The relative frontier of a set\<close>
  2021 
  2021 
  2022 definition%important "rel_frontier S = closure S - rel_interior S"
  2022 definition\<^marker>\<open>tag important\<close> "rel_frontier S = closure S - rel_interior S"
  2023 
  2023 
  2024 lemma rel_frontier_empty [simp]: "rel_frontier {} = {}"
  2024 lemma rel_frontier_empty [simp]: "rel_frontier {} = {}"
  2025   by (simp add: rel_frontier_def)
  2025   by (simp add: rel_frontier_def)
  2026 
  2026 
  2027 lemma rel_frontier_eq_empty:
  2027 lemma rel_frontier_eq_empty:
  2391   }
  2391   }
  2392   ultimately show ?thesis by auto
  2392   ultimately show ?thesis by auto
  2393 qed
  2393 qed
  2394 
  2394 
  2395 
  2395 
  2396 subsubsection%unimportant \<open>Relative interior and closure under common operations\<close>
  2396 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Relative interior and closure under common operations\<close>
  2397 
  2397 
  2398 lemma rel_interior_inter_aux: "\<Inter>{rel_interior S |S. S \<in> I} \<subseteq> \<Inter>I"
  2398 lemma rel_interior_inter_aux: "\<Inter>{rel_interior S |S. S \<in> I} \<subseteq> \<Inter>I"
  2399 proof -
  2399 proof -
  2400   {
  2400   {
  2401     fix y
  2401     fix y
  3083     and "convex T"
  3083     and "convex T"
  3084   shows "rel_frontier S \<times> rel_frontier T \<subseteq> rel_frontier (S \<times> T)"
  3084   shows "rel_frontier S \<times> rel_frontier T \<subseteq> rel_frontier (S \<times> T)"
  3085     by (force simp: rel_frontier_def rel_interior_Times assms closure_Times)
  3085     by (force simp: rel_frontier_def rel_interior_Times assms closure_Times)
  3086 
  3086 
  3087 
  3087 
  3088 subsubsection%unimportant \<open>Relative interior of convex cone\<close>
  3088 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Relative interior of convex cone\<close>
  3089 
  3089 
  3090 lemma cone_rel_interior:
  3090 lemma cone_rel_interior:
  3091   fixes S :: "'m::euclidean_space set"
  3091   fixes S :: "'m::euclidean_space set"
  3092   assumes "cone S"
  3092   assumes "cone S"
  3093   shows "cone ({0} \<union> rel_interior S)"
  3093   shows "cone ({0} \<union> rel_interior S)"
  3356   }
  3356   }
  3357   then show "?lhs \<supseteq> ?rhs" by blast
  3357   then show "?lhs \<supseteq> ?rhs" by blast
  3358 qed
  3358 qed
  3359 
  3359 
  3360 
  3360 
  3361 subsection%unimportant \<open>Convexity on direct sums\<close>
  3361 subsection\<^marker>\<open>tag unimportant\<close> \<open>Convexity on direct sums\<close>
  3362 
  3362 
  3363 lemma closure_sum:
  3363 lemma closure_sum:
  3364   fixes S T :: "'a::real_normed_vector set"
  3364   fixes S T :: "'a::real_normed_vector set"
  3365   shows "closure S + closure T \<subseteq> closure (S + T)"
  3365   shows "closure S + closure T \<subseteq> closure (S + T)"
  3366   unfolding set_plus_image closure_Times [symmetric] split_def
  3366   unfolding set_plus_image closure_Times [symmetric] split_def
  3721   qed
  3721   qed
  3722   then show ?thesis
  3722   then show ?thesis
  3723     using \<open>y < x\<close> by (simp add: field_simps)
  3723     using \<open>y < x\<close> by (simp add: field_simps)
  3724 qed simp
  3724 qed simp
  3725 
  3725 
  3726 subsection%unimportant\<open>Explicit formulas for interior and relative interior of convex hull\<close>
  3726 subsection\<^marker>\<open>tag unimportant\<close>\<open>Explicit formulas for interior and relative interior of convex hull\<close>
  3727 
  3727 
  3728 lemma at_within_cbox_finite:
  3728 lemma at_within_cbox_finite:
  3729   assumes "x \<in> box a b" "x \<notin> S" "finite S"
  3729   assumes "x \<in> box a b" "x \<notin> S" "finite S"
  3730   shows "(at x within cbox a b - S) = at x"
  3730   shows "(at x within cbox a b - S) = at x"
  3731 proof -
  3731 proof -
  4082   assume ?rhs
  4082   assume ?rhs
  4083   then show ?lhs
  4083   then show ?lhs
  4084     by (metis Diff_cancel convex_hull_singleton insert_absorb2 open_segment_def segment_convex_hull)
  4084     by (metis Diff_cancel convex_hull_singleton insert_absorb2 open_segment_def segment_convex_hull)
  4085 qed
  4085 qed
  4086 
  4086 
  4087 subsection%unimportant\<open>Similar results for closure and (relative or absolute) frontier\<close>
  4087 subsection\<^marker>\<open>tag unimportant\<close>\<open>Similar results for closure and (relative or absolute) frontier\<close>
  4088 
  4088 
  4089 lemma closure_convex_hull [simp]:
  4089 lemma closure_convex_hull [simp]:
  4090   fixes s :: "'a::euclidean_space set"
  4090   fixes s :: "'a::euclidean_space set"
  4091   shows "compact s ==> closure(convex hull s) = convex hull s"
  4091   shows "compact s ==> closure(convex hull s) = convex hull s"
  4092   by (simp add: compact_imp_closed compact_convex_hull)
  4092   by (simp add: compact_imp_closed compact_convex_hull)
  4240 qed
  4240 qed
  4241 
  4241 
  4242 
  4242 
  4243 subsection \<open>Coplanarity, and collinearity in terms of affine hull\<close>
  4243 subsection \<open>Coplanarity, and collinearity in terms of affine hull\<close>
  4244 
  4244 
  4245 definition%important coplanar  where
  4245 definition\<^marker>\<open>tag important\<close> coplanar  where
  4246    "coplanar s \<equiv> \<exists>u v w. s \<subseteq> affine hull {u,v,w}"
  4246    "coplanar s \<equiv> \<exists>u v w. s \<subseteq> affine hull {u,v,w}"
  4247 
  4247 
  4248 lemma collinear_affine_hull:
  4248 lemma collinear_affine_hull:
  4249   "collinear s \<longleftrightarrow> (\<exists>u v. s \<subseteq> affine hull {u,v})"
  4249   "collinear s \<longleftrightarrow> (\<exists>u v. s \<subseteq> affine hull {u,v})"
  4250 proof (cases "s={}")
  4250 proof (cases "s={}")
  4691 apply (rule_tac x="\<lambda>r. (if r=a then x else if r=b then y else if r=c then z else 0)" in exI)
  4691 apply (rule_tac x="\<lambda>r. (if r=a then x else if r=b then y else if r=c then z else 0)" in exI)
  4692 apply simp
  4692 apply simp
  4693 done
  4693 done
  4694 
  4694 
  4695 
  4695 
  4696 subsection%unimportant\<open>Basic lemmas about hyperplanes and halfspaces\<close>
  4696 subsection\<^marker>\<open>tag unimportant\<close>\<open>Basic lemmas about hyperplanes and halfspaces\<close>
  4697 
  4697 
  4698 lemma halfspace_Int_eq:
  4698 lemma halfspace_Int_eq:
  4699      "{x. a \<bullet> x \<le> b} \<inter> {x. b \<le> a \<bullet> x} = {x. a \<bullet> x = b}"
  4699      "{x. a \<bullet> x \<le> b} \<inter> {x. b \<le> a \<bullet> x} = {x. a \<bullet> x = b}"
  4700      "{x. b \<le> a \<bullet> x} \<inter> {x. a \<bullet> x \<le> b} = {x. a \<bullet> x = b}"
  4700      "{x. b \<le> a \<bullet> x} \<inter> {x. a \<bullet> x \<le> b} = {x. a \<bullet> x = b}"
  4701   by auto
  4701   by auto
  4749 lemma halfspace_eq_empty_ge:
  4749 lemma halfspace_eq_empty_ge:
  4750    "{x. a \<bullet> x \<ge> b} = {} \<longleftrightarrow> a = 0 \<and> b > 0"
  4750    "{x. a \<bullet> x \<ge> b} = {} \<longleftrightarrow> a = 0 \<and> b > 0"
  4751 using halfspace_eq_empty_le [of "-a" "-b"]
  4751 using halfspace_eq_empty_le [of "-a" "-b"]
  4752 by simp
  4752 by simp
  4753 
  4753 
  4754 subsection%unimportant\<open>Use set distance for an easy proof of separation properties\<close>
  4754 subsection\<^marker>\<open>tag unimportant\<close>\<open>Use set distance for an easy proof of separation properties\<close>
  4755 
  4755 
  4756 proposition%unimportant separation_closures:
  4756 proposition\<^marker>\<open>tag unimportant\<close> separation_closures:
  4757   fixes S :: "'a::euclidean_space set"
  4757   fixes S :: "'a::euclidean_space set"
  4758   assumes "S \<inter> closure T = {}" "T \<inter> closure S = {}"
  4758   assumes "S \<inter> closure T = {}" "T \<inter> closure S = {}"
  4759   obtains U V where "U \<inter> V = {}" "open U" "open V" "S \<subseteq> U" "T \<subseteq> V"
  4759   obtains U V where "U \<inter> V = {}" "open U" "open V" "S \<subseteq> U" "T \<subseteq> V"
  4760 proof (cases "S = {} \<or> T = {}")
  4760 proof (cases "S = {} \<or> T = {}")
  4761   case True with that show ?thesis by auto
  4761   case True with that show ?thesis by auto
  5077   show ?lhs
  5077   show ?lhs
  5078     using proper_map [OF _ _ gfim] **
  5078     using proper_map [OF _ _ gfim] **
  5079     by (simp add: continuous_on_closed * closedin_imp_subset)
  5079     by (simp add: continuous_on_closed * closedin_imp_subset)
  5080 qed
  5080 qed
  5081 
  5081 
  5082 subsection%unimportant\<open>Trivial fact: convexity equals connectedness for collinear sets\<close>
  5082 subsection\<^marker>\<open>tag unimportant\<close>\<open>Trivial fact: convexity equals connectedness for collinear sets\<close>
  5083 
  5083 
  5084 lemma convex_connected_collinear:
  5084 lemma convex_connected_collinear:
  5085   fixes S :: "'a::euclidean_space set"
  5085   fixes S :: "'a::euclidean_space set"
  5086   assumes "collinear S"
  5086   assumes "collinear S"
  5087     shows "convex S \<longleftrightarrow> connected S"
  5087     shows "convex S \<longleftrightarrow> connected S"
  5295     apply (rule closedin_closed_trans [OF _ closed_UNIV])
  5295     apply (rule closedin_closed_trans [OF _ closed_UNIV])
  5296     apply (rule closedin_compact_projection [OF \<open>compact S\<close>])
  5296     apply (rule closedin_compact_projection [OF \<open>compact S\<close>])
  5297     by (simp add: clo closedin_closed_Int)
  5297     by (simp add: clo closedin_closed_Int)
  5298 qed
  5298 qed
  5299 
  5299 
  5300 subsubsection%unimportant\<open>Representing affine hull as a finite intersection of hyperplanes\<close>
  5300 subsubsection\<^marker>\<open>tag unimportant\<close>\<open>Representing affine hull as a finite intersection of hyperplanes\<close>
  5301 
  5301 
  5302 proposition%unimportant affine_hull_convex_Int_nonempty_interior:
  5302 proposition\<^marker>\<open>tag unimportant\<close> affine_hull_convex_Int_nonempty_interior:
  5303   fixes S :: "'a::real_normed_vector set"
  5303   fixes S :: "'a::real_normed_vector set"
  5304   assumes "convex S" "S \<inter> interior T \<noteq> {}"
  5304   assumes "convex S" "S \<inter> interior T \<noteq> {}"
  5305     shows "affine hull (S \<inter> T) = affine hull S"
  5305     shows "affine hull (S \<inter> T) = affine hull S"
  5306 proof
  5306 proof
  5307   show "affine hull (S \<inter> T) \<subseteq> affine hull S"
  5307   show "affine hull (S \<inter> T) \<subseteq> affine hull S"
  5522 corollary aff_dim_hyperplane [simp]:
  5522 corollary aff_dim_hyperplane [simp]:
  5523   fixes a :: "'a::euclidean_space"
  5523   fixes a :: "'a::euclidean_space"
  5524   shows "a \<noteq> 0 \<Longrightarrow> aff_dim {x. a \<bullet> x = r} = DIM('a) - 1"
  5524   shows "a \<noteq> 0 \<Longrightarrow> aff_dim {x. a \<bullet> x = r} = DIM('a) - 1"
  5525 by (metis aff_dim_eq_hyperplane affine_hull_eq affine_hyperplane)
  5525 by (metis aff_dim_eq_hyperplane affine_hull_eq affine_hyperplane)
  5526 
  5526 
  5527 subsection%unimportant\<open>Some stepping theorems\<close>
  5527 subsection\<^marker>\<open>tag unimportant\<close>\<open>Some stepping theorems\<close>
  5528 
  5528 
  5529 lemma aff_dim_insert:
  5529 lemma aff_dim_insert:
  5530   fixes a :: "'a::euclidean_space"
  5530   fixes a :: "'a::euclidean_space"
  5531   shows "aff_dim (insert a S) = (if a \<in> affine hull S then aff_dim S else aff_dim S + 1)"
  5531   shows "aff_dim (insert a S) = (if a \<in> affine hull S then aff_dim S else aff_dim S + 1)"
  5532 proof (cases "S = {}")
  5532 proof (cases "S = {}")
  5647     by (metis that \<open>a \<noteq> 0\<close> aff_dim_hyperplane)
  5647     by (metis that \<open>a \<noteq> 0\<close> aff_dim_hyperplane)
  5648   then show "bounded {x. a \<bullet> x = r} = (DIM('a) = Suc 0)"
  5648   then show "bounded {x. a \<bullet> x = r} = (DIM('a) = Suc 0)"
  5649     by (metis One_nat_def \<open>a \<noteq> 0\<close> affine_bounded_eq_lowdim affine_hyperplane bounded_hyperplane_eq_trivial_0)
  5649     by (metis One_nat_def \<open>a \<noteq> 0\<close> affine_bounded_eq_lowdim affine_hyperplane bounded_hyperplane_eq_trivial_0)
  5650 qed
  5650 qed
  5651 
  5651 
  5652 subsection%unimportant\<open>General case without assuming closure and getting non-strict separation\<close>
  5652 subsection\<^marker>\<open>tag unimportant\<close>\<open>General case without assuming closure and getting non-strict separation\<close>
  5653 
  5653 
  5654 proposition%unimportant separating_hyperplane_closed_point_inset:
  5654 proposition\<^marker>\<open>tag unimportant\<close> separating_hyperplane_closed_point_inset:
  5655   fixes S :: "'a::euclidean_space set"
  5655   fixes S :: "'a::euclidean_space set"
  5656   assumes "convex S" "closed S" "S \<noteq> {}" "z \<notin> S"
  5656   assumes "convex S" "closed S" "S \<noteq> {}" "z \<notin> S"
  5657   obtains a b where "a \<in> S" "(a - z) \<bullet> z < b" "\<And>x. x \<in> S \<Longrightarrow> b < (a - z) \<bullet> x"
  5657   obtains a b where "a \<in> S" "(a - z) \<bullet> z < b" "\<And>x. x \<in> S \<Longrightarrow> b < (a - z) \<bullet> x"
  5658 proof -
  5658 proof -
  5659   obtain y where "y \<in> S" and y: "\<And>u. u \<in> S \<Longrightarrow> dist z y \<le> dist z u"
  5659   obtain y where "y \<in> S" and y: "\<And>u. u \<in> S \<Longrightarrow> dist z y \<le> dist z u"
  5686   obtains a b where "a \<in> S" "a \<noteq> 0" "0 < b" "\<And>x. x \<in> S \<Longrightarrow> a \<bullet> x > b"
  5686   obtains a b where "a \<in> S" "a \<noteq> 0" "0 < b" "\<And>x. x \<in> S \<Longrightarrow> a \<bullet> x > b"
  5687 using separating_hyperplane_closed_point_inset [OF assms]
  5687 using separating_hyperplane_closed_point_inset [OF assms]
  5688 by simp (metis \<open>0 \<notin> S\<close>)
  5688 by simp (metis \<open>0 \<notin> S\<close>)
  5689 
  5689 
  5690 
  5690 
  5691 proposition%unimportant separating_hyperplane_set_0_inspan:
  5691 proposition\<^marker>\<open>tag unimportant\<close> separating_hyperplane_set_0_inspan:
  5692   fixes S :: "'a::euclidean_space set"
  5692   fixes S :: "'a::euclidean_space set"
  5693   assumes "convex S" "S \<noteq> {}" "0 \<notin> S"
  5693   assumes "convex S" "S \<noteq> {}" "0 \<notin> S"
  5694   obtains a where "a \<in> span S" "a \<noteq> 0" "\<And>x. x \<in> S \<Longrightarrow> 0 \<le> a \<bullet> x"
  5694   obtains a where "a \<in> span S" "a \<noteq> 0" "\<And>x. x \<in> S \<Longrightarrow> 0 \<le> a \<bullet> x"
  5695 proof -
  5695 proof -
  5696   define k where [abs_def]: "k c = {x. 0 \<le> c \<bullet> x}" for c :: 'a
  5696   define k where [abs_def]: "k c = {x. 0 \<le> c \<bullet> x}" for c :: 'a
  5777     using \<open>a \<in> span ((+) (- z) ` S)\<close> affine_hull_insert_span_gen apply blast
  5777     using \<open>a \<in> span ((+) (- z) ` S)\<close> affine_hull_insert_span_gen apply blast
  5778     apply (simp_all add: \<open>a \<noteq> 0\<close> szx)
  5778     apply (simp_all add: \<open>a \<noteq> 0\<close> szx)
  5779     done
  5779     done
  5780 qed
  5780 qed
  5781 
  5781 
  5782 proposition%unimportant supporting_hyperplane_rel_boundary:
  5782 proposition\<^marker>\<open>tag unimportant\<close> supporting_hyperplane_rel_boundary:
  5783   fixes S :: "'a::euclidean_space set"
  5783   fixes S :: "'a::euclidean_space set"
  5784   assumes "convex S" "x \<in> S" and xno: "x \<notin> rel_interior S"
  5784   assumes "convex S" "x \<in> S" and xno: "x \<notin> rel_interior S"
  5785   obtains a where "a \<noteq> 0"
  5785   obtains a where "a \<noteq> 0"
  5786               and "\<And>y. y \<in> S \<Longrightarrow> a \<bullet> x \<le> a \<bullet> y"
  5786               and "\<And>y. y \<in> S \<Longrightarrow> a \<bullet> x \<le> a \<bullet> y"
  5787               and "\<And>y. y \<in> rel_interior S \<Longrightarrow> a \<bullet> x < a \<bullet> y"
  5787               and "\<And>y. y \<in> rel_interior S \<Longrightarrow> a \<bullet> x < a \<bullet> y"
  5835               and "\<And>y. y \<in> rel_interior S \<Longrightarrow> a \<bullet> x < a \<bullet> y"
  5835               and "\<And>y. y \<in> rel_interior S \<Longrightarrow> a \<bullet> x < a \<bullet> y"
  5836 using supporting_hyperplane_rel_boundary [of "closure S" x]
  5836 using supporting_hyperplane_rel_boundary [of "closure S" x]
  5837 by (metis assms convex_closure convex_rel_interior_closure)
  5837 by (metis assms convex_closure convex_rel_interior_closure)
  5838 
  5838 
  5839 
  5839 
  5840 subsection%unimportant\<open> Some results on decomposing convex hulls: intersections, simplicial subdivision\<close>
  5840 subsection\<^marker>\<open>tag unimportant\<close>\<open> Some results on decomposing convex hulls: intersections, simplicial subdivision\<close>
  5841 
  5841 
  5842 lemma
  5842 lemma
  5843   fixes s :: "'a::euclidean_space set"
  5843   fixes s :: "'a::euclidean_space set"
  5844   assumes "\<not> affine_dependent(s \<union> t)"
  5844   assumes "\<not> affine_dependent(s \<union> t)"
  5845     shows convex_hull_Int_subset: "convex hull s \<inter> convex hull t \<subseteq> convex hull (s \<inter> t)" (is ?C)
  5845     shows convex_hull_Int_subset: "convex hull s \<inter> convex hull t \<subseteq> convex hull (s \<inter> t)" (is ?C)
  5880     then show ?A ?C
  5880     then show ?A ?C
  5881       by (auto simp: convex_hull_finite affine_hull_finite)
  5881       by (auto simp: convex_hull_finite affine_hull_finite)
  5882 qed
  5882 qed
  5883 
  5883 
  5884 
  5884 
  5885 proposition%unimportant affine_hull_Int:
  5885 proposition\<^marker>\<open>tag unimportant\<close> affine_hull_Int:
  5886   fixes s :: "'a::euclidean_space set"
  5886   fixes s :: "'a::euclidean_space set"
  5887   assumes "\<not> affine_dependent(s \<union> t)"
  5887   assumes "\<not> affine_dependent(s \<union> t)"
  5888     shows "affine hull (s \<inter> t) = affine hull s \<inter> affine hull t"
  5888     shows "affine hull (s \<inter> t) = affine hull s \<inter> affine hull t"
  5889 apply (rule subset_antisym)
  5889 apply (rule subset_antisym)
  5890 apply (simp add: hull_mono)
  5890 apply (simp add: hull_mono)
  5891 by (simp add: affine_hull_Int_subset assms)
  5891 by (simp add: affine_hull_Int_subset assms)
  5892 
  5892 
  5893 proposition%unimportant convex_hull_Int:
  5893 proposition\<^marker>\<open>tag unimportant\<close> convex_hull_Int:
  5894   fixes s :: "'a::euclidean_space set"
  5894   fixes s :: "'a::euclidean_space set"
  5895   assumes "\<not> affine_dependent(s \<union> t)"
  5895   assumes "\<not> affine_dependent(s \<union> t)"
  5896     shows "convex hull (s \<inter> t) = convex hull s \<inter> convex hull t"
  5896     shows "convex hull (s \<inter> t) = convex hull s \<inter> convex hull t"
  5897 apply (rule subset_antisym)
  5897 apply (rule subset_antisym)
  5898 apply (simp add: hull_mono)
  5898 apply (simp add: hull_mono)
  5899 by (simp add: convex_hull_Int_subset assms)
  5899 by (simp add: convex_hull_Int_subset assms)
  5900 
  5900 
  5901 proposition%unimportant
  5901 proposition\<^marker>\<open>tag unimportant\<close>
  5902   fixes s :: "'a::euclidean_space set set"
  5902   fixes s :: "'a::euclidean_space set set"
  5903   assumes "\<not> affine_dependent (\<Union>s)"
  5903   assumes "\<not> affine_dependent (\<Union>s)"
  5904     shows affine_hull_Inter: "affine hull (\<Inter>s) = (\<Inter>t\<in>s. affine hull t)" (is "?A")
  5904     shows affine_hull_Inter: "affine hull (\<Inter>s) = (\<Inter>t\<in>s. affine hull t)" (is "?A")
  5905       and convex_hull_Inter: "convex hull (\<Inter>s) = (\<Inter>t\<in>s. convex hull t)" (is "?C")
  5905       and convex_hull_Inter: "convex hull (\<Inter>s) = (\<Inter>t\<in>s. convex hull t)" (is "?C")
  5906 proof -
  5906 proof -
  5926   qed
  5926   qed
  5927   then show "?A" "?C"
  5927   then show "?A" "?C"
  5928     by auto
  5928     by auto
  5929 qed
  5929 qed
  5930 
  5930 
  5931 proposition%unimportant in_convex_hull_exchange_unique:
  5931 proposition\<^marker>\<open>tag unimportant\<close> in_convex_hull_exchange_unique:
  5932   fixes S :: "'a::euclidean_space set"
  5932   fixes S :: "'a::euclidean_space set"
  5933   assumes naff: "\<not> affine_dependent S" and a: "a \<in> convex hull S"
  5933   assumes naff: "\<not> affine_dependent S" and a: "a \<in> convex hull S"
  5934       and S: "T \<subseteq> S" "T' \<subseteq> S"
  5934       and S: "T \<subseteq> S" "T' \<subseteq> S"
  5935       and x:  "x \<in> convex hull (insert a T)"
  5935       and x:  "x \<in> convex hull (insert a T)"
  5936       and x': "x \<in> convex hull (insert a T')"
  5936       and x': "x \<in> convex hull (insert a T')"
  6074         by simp
  6074         by simp
  6075     qed
  6075     qed
  6076   qed
  6076   qed
  6077 qed
  6077 qed
  6078 
  6078 
  6079 corollary%unimportant convex_hull_exchange_Int:
  6079 corollary\<^marker>\<open>tag unimportant\<close> convex_hull_exchange_Int:
  6080   fixes a  :: "'a::euclidean_space"
  6080   fixes a  :: "'a::euclidean_space"
  6081   assumes "\<not> affine_dependent S" "a \<in> convex hull S" "T \<subseteq> S" "T' \<subseteq> S"
  6081   assumes "\<not> affine_dependent S" "a \<in> convex hull S" "T \<subseteq> S" "T' \<subseteq> S"
  6082   shows "(convex hull (insert a T)) \<inter> (convex hull (insert a T')) =
  6082   shows "(convex hull (insert a T)) \<inter> (convex hull (insert a T')) =
  6083          convex hull (insert a (T \<inter> T'))"
  6083          convex hull (insert a (T \<inter> T'))"
  6084 apply (rule subset_antisym)
  6084 apply (rule subset_antisym)
  6227     done
  6227     done
  6228   ultimately show ?thesis
  6228   ultimately show ?thesis
  6229     by (simp add: subs) (metis (lifting) span_eq_iff subs)
  6229     by (simp add: subs) (metis (lifting) span_eq_iff subs)
  6230 qed
  6230 qed
  6231 
  6231 
  6232 proposition%unimportant affine_hyperplane_sums_eq_UNIV:
  6232 proposition\<^marker>\<open>tag unimportant\<close> affine_hyperplane_sums_eq_UNIV:
  6233   fixes S :: "'a :: euclidean_space set"
  6233   fixes S :: "'a :: euclidean_space set"
  6234   assumes "affine S"
  6234   assumes "affine S"
  6235       and "S \<inter> {v. a \<bullet> v = b} \<noteq> {}"
  6235       and "S \<inter> {v. a \<bullet> v = b} \<noteq> {}"
  6236       and "S - {v. a \<bullet> v = b} \<noteq> {}"
  6236       and "S - {v. a \<bullet> v = b} \<noteq> {}"
  6237     shows "{x + y| x y. x \<in> S \<and> a \<bullet> y = b} = UNIV"
  6237     shows "{x + y| x y. x \<in> S \<and> a \<bullet> y = b} = UNIV"
  6464     by (metis dim_less dim_subset inf.cobounded2 inf.orderE inf.strict_boundedE not_le)
  6464     by (metis dim_less dim_subset inf.cobounded2 inf.orderE inf.strict_boundedE not_le)
  6465   ultimately show ?thesis
  6465   ultimately show ?thesis
  6466     by force
  6466     by force
  6467 qed
  6467 qed
  6468 
  6468 
  6469 corollary%unimportant dense_complement_affine:
  6469 corollary\<^marker>\<open>tag unimportant\<close> dense_complement_affine:
  6470   fixes S :: "'a :: euclidean_space set"
  6470   fixes S :: "'a :: euclidean_space set"
  6471   assumes less: "aff_dim T < aff_dim S" and "affine S" shows "closure(S - T) = S"
  6471   assumes less: "aff_dim T < aff_dim S" and "affine S" shows "closure(S - T) = S"
  6472 proof (cases "S \<inter> T = {}")
  6472 proof (cases "S \<inter> T = {}")
  6473   case True
  6473   case True
  6474   then show ?thesis
  6474   then show ?thesis
  6485     by (simp add: dense_complement_subspace)
  6485     by (simp add: dense_complement_subspace)
  6486   then show ?thesis
  6486   then show ?thesis
  6487     by (metis closure_translation translation_diff translation_invert)
  6487     by (metis closure_translation translation_diff translation_invert)
  6488 qed
  6488 qed
  6489 
  6489 
  6490 corollary%unimportant dense_complement_openin_affine_hull:
  6490 corollary\<^marker>\<open>tag unimportant\<close> dense_complement_openin_affine_hull:
  6491   fixes S :: "'a :: euclidean_space set"
  6491   fixes S :: "'a :: euclidean_space set"
  6492   assumes less: "aff_dim T < aff_dim S"
  6492   assumes less: "aff_dim T < aff_dim S"
  6493       and ope: "openin (top_of_set (affine hull S)) S"
  6493       and ope: "openin (top_of_set (affine hull S)) S"
  6494     shows "closure(S - T) = closure S"
  6494     shows "closure(S - T) = closure S"
  6495 proof -
  6495 proof -
  6499     by (rule closure_openin_Int_closure [OF ope])
  6499     by (rule closure_openin_Int_closure [OF ope])
  6500   then show ?thesis
  6500   then show ?thesis
  6501     by (metis Int_Diff aff_dim_affine_hull affine_affine_hull dense_complement_affine hull_subset inf.orderE less)
  6501     by (metis Int_Diff aff_dim_affine_hull affine_affine_hull dense_complement_affine hull_subset inf.orderE less)
  6502 qed
  6502 qed
  6503 
  6503 
  6504 corollary%unimportant dense_complement_convex:
  6504 corollary\<^marker>\<open>tag unimportant\<close> dense_complement_convex:
  6505   fixes S :: "'a :: euclidean_space set"
  6505   fixes S :: "'a :: euclidean_space set"
  6506   assumes "aff_dim T < aff_dim S" "convex S"
  6506   assumes "aff_dim T < aff_dim S" "convex S"
  6507     shows "closure(S - T) = closure S"
  6507     shows "closure(S - T) = closure S"
  6508 proof
  6508 proof
  6509   show "closure (S - T) \<subseteq> closure S"
  6509   show "closure (S - T) \<subseteq> closure S"
  6514     using \<open>convex S\<close> rel_interior_rel_open rel_open by blast
  6514     using \<open>convex S\<close> rel_interior_rel_open rel_open by blast
  6515   then show "closure S \<subseteq> closure (S - T)"
  6515   then show "closure S \<subseteq> closure (S - T)"
  6516     by (metis Diff_mono \<open>convex S\<close> closure_mono convex_closure_rel_interior order_refl rel_interior_subset)
  6516     by (metis Diff_mono \<open>convex S\<close> closure_mono convex_closure_rel_interior order_refl rel_interior_subset)
  6517 qed
  6517 qed
  6518 
  6518 
  6519 corollary%unimportant dense_complement_convex_closed:
  6519 corollary\<^marker>\<open>tag unimportant\<close> dense_complement_convex_closed:
  6520   fixes S :: "'a :: euclidean_space set"
  6520   fixes S :: "'a :: euclidean_space set"
  6521   assumes "aff_dim T < aff_dim S" "convex S" "closed S"
  6521   assumes "aff_dim T < aff_dim S" "convex S" "closed S"
  6522     shows "closure(S - T) = S"
  6522     shows "closure(S - T) = S"
  6523   by (simp add: assms dense_complement_convex)
  6523   by (simp add: assms dense_complement_convex)
  6524 
  6524 
  6525 
  6525 
  6526 subsection%unimportant\<open>Parallel slices, etc\<close>
  6526 subsection\<^marker>\<open>tag unimportant\<close>\<open>Parallel slices, etc\<close>
  6527 
  6527 
  6528 text\<open> If we take a slice out of a set, we can do it perpendicularly,
  6528 text\<open> If we take a slice out of a set, we can do it perpendicularly,
  6529   with the normal vector to the slice parallel to the affine hull.\<close>
  6529   with the normal vector to the slice parallel to the affine hull.\<close>
  6530 
  6530 
  6531 proposition%unimportant affine_parallel_slice:
  6531 proposition\<^marker>\<open>tag unimportant\<close> affine_parallel_slice:
  6532   fixes S :: "'a :: euclidean_space set"
  6532   fixes S :: "'a :: euclidean_space set"
  6533   assumes "affine S"
  6533   assumes "affine S"
  6534       and "S \<inter> {x. a \<bullet> x \<le> b} \<noteq> {}"
  6534       and "S \<inter> {x. a \<bullet> x \<le> b} \<noteq> {}"
  6535       and "\<not> (S \<subseteq> {x. a \<bullet> x \<le> b})"
  6535       and "\<not> (S \<subseteq> {x. a \<bullet> x \<le> b})"
  6536   obtains a' b' where "a' \<noteq> 0"
  6536   obtains a' b' where "a' \<noteq> 0"
  6843       apply (auto intro: that finite_subset [OF *])
  6843       apply (auto intro: that finite_subset [OF *])
  6844       done
  6844       done
  6845     qed
  6845     qed
  6846 qed
  6846 qed
  6847 
  6847 
  6848 corollary%unimportant paracompact_closed:
  6848 corollary\<^marker>\<open>tag unimportant\<close> paracompact_closed:
  6849   fixes S :: "'a :: {metric_space,second_countable_topology} set"
  6849   fixes S :: "'a :: {metric_space,second_countable_topology} set"
  6850   assumes "closed S"
  6850   assumes "closed S"
  6851       and opC: "\<And>T. T \<in> \<C> \<Longrightarrow> open T"
  6851       and opC: "\<And>T. T \<in> \<C> \<Longrightarrow> open T"
  6852       and "S \<subseteq> \<Union>\<C>"
  6852       and "S \<subseteq> \<Union>\<C>"
  6853   obtains \<C>' where "S \<subseteq> \<Union>\<C>'"
  6853   obtains \<C>' where "S \<subseteq> \<Union>\<C>'"
  6855                and "\<And>x. \<exists>V. open V \<and> x \<in> V \<and>
  6855                and "\<And>x. \<exists>V. open V \<and> x \<in> V \<and>
  6856                                finite {U. U \<in> \<C>' \<and> (U \<inter> V \<noteq> {})}"
  6856                                finite {U. U \<in> \<C>' \<and> (U \<inter> V \<noteq> {})}"
  6857   by (rule paracompact_closedin [of UNIV S \<C>]) (auto simp: assms)
  6857   by (rule paracompact_closedin [of UNIV S \<C>]) (auto simp: assms)
  6858 
  6858 
  6859   
  6859   
  6860 subsection%unimportant\<open>Closed-graph characterization of continuity\<close>
  6860 subsection\<^marker>\<open>tag unimportant\<close>\<open>Closed-graph characterization of continuity\<close>
  6861 
  6861 
  6862 lemma continuous_closed_graph_gen:
  6862 lemma continuous_closed_graph_gen:
  6863   fixes T :: "'b::real_normed_vector set"
  6863   fixes T :: "'b::real_normed_vector set"
  6864   assumes contf: "continuous_on S f" and fim: "f ` S \<subseteq> T"
  6864   assumes contf: "continuous_on S f" and fim: "f ` S \<subseteq> T"
  6865     shows "closedin (top_of_set (S \<times> T)) ((\<lambda>x. Pair x (f x)) ` S)"
  6865     shows "closedin (top_of_set (S \<times> T)) ((\<lambda>x. Pair x (f x)) ` S)"
  6969   qed (auto simp: fg)
  6969   qed (auto simp: fg)
  6970   then show ?thesis
  6970   then show ?thesis
  6971     by simp
  6971     by simp
  6972 qed
  6972 qed
  6973 
  6973 
  6974 subsection%unimportant\<open>The union of two collinear segments is another segment\<close>
  6974 subsection\<^marker>\<open>tag unimportant\<close>\<open>The union of two collinear segments is another segment\<close>
  6975 
  6975 
  6976 proposition%unimportant in_convex_hull_exchange:
  6976 proposition\<^marker>\<open>tag unimportant\<close> in_convex_hull_exchange:
  6977   fixes a :: "'a::euclidean_space"
  6977   fixes a :: "'a::euclidean_space"
  6978   assumes a: "a \<in> convex hull S" and xS: "x \<in> convex hull S"
  6978   assumes a: "a \<in> convex hull S" and xS: "x \<in> convex hull S"
  6979   obtains b where "b \<in> S" "x \<in> convex hull (insert a (S - {b}))"
  6979   obtains b where "b \<in> S" "x \<in> convex hull (insert a (S - {b}))"
  6980 proof (cases "a \<in> S")
  6980 proof (cases "a \<in> S")
  6981   case True
  6981   case True
  7248 qed
  7248 qed
  7249 
  7249 
  7250 
  7250 
  7251 subsection\<open>Orthogonal complement\<close>
  7251 subsection\<open>Orthogonal complement\<close>
  7252 
  7252 
  7253 definition%important orthogonal_comp ("_\<^sup>\<bottom>" [80] 80)
  7253 definition\<^marker>\<open>tag important\<close> orthogonal_comp ("_\<^sup>\<bottom>" [80] 80)
  7254   where "orthogonal_comp W \<equiv> {x. \<forall>y \<in> W. orthogonal y x}"
  7254   where "orthogonal_comp W \<equiv> {x. \<forall>y \<in> W. orthogonal y x}"
  7255 
  7255 
  7256 proposition subspace_orthogonal_comp: "subspace (W\<^sup>\<bottom>)"
  7256 proposition subspace_orthogonal_comp: "subspace (W\<^sup>\<bottom>)"
  7257   unfolding subspace_def orthogonal_comp_def orthogonal_def
  7257   unfolding subspace_def orthogonal_comp_def orthogonal_def
  7258   by (auto simp: inner_right_distrib)
  7258   by (auto simp: inner_right_distrib)
  7364   shows "f -` {0} =  (range (adjoint f))\<^sup>\<bottom>"
  7364   shows "f -` {0} =  (range (adjoint f))\<^sup>\<bottom>"
  7365   apply (auto simp: orthogonal_comp_def orthogonal_def)
  7365   apply (auto simp: orthogonal_comp_def orthogonal_def)
  7366   apply (simp add: adjoint_works assms(1) inner_commute)
  7366   apply (simp add: adjoint_works assms(1) inner_commute)
  7367   by (metis adjoint_works all_zero_iff assms(1) inner_commute)
  7367   by (metis adjoint_works all_zero_iff assms(1) inner_commute)
  7368 
  7368 
  7369 subsection%unimportant \<open>A non-injective linear function maps into a hyperplane.\<close>
  7369 subsection\<^marker>\<open>tag unimportant\<close> \<open>A non-injective linear function maps into a hyperplane.\<close>
  7370 
  7370 
  7371 lemma linear_surj_adj_imp_inj:
  7371 lemma linear_surj_adj_imp_inj:
  7372   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
  7372   fixes f :: "'m::euclidean_space \<Rightarrow> 'n::euclidean_space"
  7373   assumes "linear f" "surj (adjoint f)"
  7373   assumes "linear f" "surj (adjoint f)"
  7374   shows "inj f"
  7374   shows "inj f"