author wenzelm
Mon Mar 25 17:21:26 2019 +0100 (2 months ago)
changeset 69981 3dced198b9ec
parent 69922 4a9167f377b0
child 70136 f03a01a18c6e
permissions -rw-r--r--
more strict AFP properties;
     1 section \<open>Faces, Extreme Points, Polytopes, Polyhedra etc\<close>
     3 text\<open>Ported from HOL Light by L C Paulson\<close>
     5 theory Polytope
     6 imports Cartesian_Euclidean_Space
     7 begin
     9 subsection \<open>Faces of a (usually convex) set\<close>
    11 definition%important face_of :: "['a::real_vector set, 'a set] \<Rightarrow> bool" (infixr "(face'_of)" 50)
    12   where
    13   "T face_of S \<longleftrightarrow>
    14         T \<subseteq> S \<and> convex T \<and>
    15         (\<forall>a \<in> S. \<forall>b \<in> S. \<forall>x \<in> T. x \<in> open_segment a b \<longrightarrow> a \<in> T \<and> b \<in> T)"
    17 lemma face_ofD: "\<lbrakk>T face_of S; x \<in> open_segment a b; a \<in> S; b \<in> S; x \<in> T\<rbrakk> \<Longrightarrow> a \<in> T \<and> b \<in> T"
    18   unfolding face_of_def by blast
    20 lemma face_of_translation_eq [simp]:
    21     "((+) a ` T face_of (+) a ` S) \<longleftrightarrow> T face_of S"
    22 proof -
    23   have *: "\<And>a T S. T face_of S \<Longrightarrow> ((+) a ` T face_of (+) a ` S)"
    24     apply (simp add: face_of_def Ball_def, clarify)
    25     apply (drule open_segment_translation_eq [THEN iffD1])
    26     using inj_image_mem_iff inj_add_left apply metis
    27     done
    28   show ?thesis
    29     apply (rule iffI)
    30     apply (force simp: image_comp o_def dest: * [where a = "-a"])
    31     apply (blast intro: *)
    32     done
    33 qed
    35 lemma face_of_linear_image:
    36   assumes "linear f" "inj f"
    37     shows "(f ` c face_of f ` S) \<longleftrightarrow> c face_of S"
    38 by (simp add: face_of_def inj_image_subset_iff inj_image_mem_iff open_segment_linear_image assms)
    40 lemma face_of_refl: "convex S \<Longrightarrow> S face_of S"
    41   by (auto simp: face_of_def)
    43 lemma face_of_refl_eq: "S face_of S \<longleftrightarrow> convex S"
    44   by (auto simp: face_of_def)
    46 lemma empty_face_of [iff]: "{} face_of S"
    47   by (simp add: face_of_def)
    49 lemma face_of_empty [simp]: "S face_of {} \<longleftrightarrow> S = {}"
    50   by (meson empty_face_of face_of_def subset_empty)
    52 lemma face_of_trans [trans]: "\<lbrakk>S face_of T; T face_of u\<rbrakk> \<Longrightarrow> S face_of u"
    53   unfolding face_of_def by (safe; blast)
    55 lemma face_of_face: "T face_of S \<Longrightarrow> (f face_of T \<longleftrightarrow> f face_of S \<and> f \<subseteq> T)"
    56   unfolding face_of_def by (safe; blast)
    58 lemma face_of_subset: "\<lbrakk>F face_of S; F \<subseteq> T; T \<subseteq> S\<rbrakk> \<Longrightarrow> F face_of T"
    59   unfolding face_of_def by (safe; blast)
    61 lemma face_of_slice: "\<lbrakk>F face_of S; convex T\<rbrakk> \<Longrightarrow> (F \<inter> T) face_of (S \<inter> T)"
    62   unfolding face_of_def by (blast intro: convex_Int)
    64 lemma face_of_Int: "\<lbrakk>t1 face_of S; t2 face_of S\<rbrakk> \<Longrightarrow> (t1 \<inter> t2) face_of S"
    65   unfolding face_of_def by (blast intro: convex_Int)
    67 lemma face_of_Inter: "\<lbrakk>A \<noteq> {}; \<And>T. T \<in> A \<Longrightarrow> T face_of S\<rbrakk> \<Longrightarrow> (\<Inter> A) face_of S"
    68   unfolding face_of_def by (blast intro: convex_Inter)
    70 lemma face_of_Int_Int: "\<lbrakk>F face_of T; F' face_of t'\<rbrakk> \<Longrightarrow> (F \<inter> F') face_of (T \<inter> t')"
    71   unfolding face_of_def by (blast intro: convex_Int)
    73 lemma face_of_imp_subset: "T face_of S \<Longrightarrow> T \<subseteq> S"
    74   unfolding face_of_def by blast
    76 proposition face_of_imp_eq_affine_Int:
    77   fixes S :: "'a::euclidean_space set"
    78   assumes S: "convex S"  and T: "T face_of S"
    79   shows "T = (affine hull T) \<inter> S"
    80 proof -
    81   have "convex T" using T by (simp add: face_of_def)
    82   have *: False if x: "x \<in> affine hull T" and "x \<in> S" "x \<notin> T" and y: "y \<in> rel_interior T" for x y
    83   proof -
    84     obtain e where "e>0" and e: "cball y e \<inter> affine hull T \<subseteq> T"
    85       using y by (auto simp: rel_interior_cball)
    86     have "y \<noteq> x" "y \<in> S" "y \<in> T"
    87       using face_of_imp_subset rel_interior_subset T that by blast+
    88     then have zne: "\<And>u. \<lbrakk>u \<in> {0<..<1}; (1 - u) *\<^sub>R y + u *\<^sub>R x \<in> T\<rbrakk> \<Longrightarrow>  False"
    89       using \<open>x \<in> S\<close> \<open>x \<notin> T\<close> \<open>T face_of S\<close> unfolding face_of_def
    90       apply clarify
    91       apply (drule_tac x=x in bspec, assumption)
    92       apply (drule_tac x=y in bspec, assumption)
    93       apply (subst (asm) open_segment_commute)
    94       apply (force simp: open_segment_image_interval image_def)
    95       done
    96     have in01: "min (1/2) (e / norm (x - y)) \<in> {0<..<1}"
    97       using \<open>y \<noteq> x\<close> \<open>e > 0\<close> by simp
    98     show ?thesis
    99       apply (rule zne [OF in01])
   100       apply (rule e [THEN subsetD])
   101       apply (rule IntI)
   102         using \<open>y \<noteq> x\<close> \<open>e > 0\<close>
   103         apply (simp add: cball_def dist_norm algebra_simps)
   104         apply (simp add: Real_Vector_Spaces.scaleR_diff_right [symmetric] norm_minus_commute min_mult_distrib_right)
   105       apply (rule mem_affine [OF affine_affine_hull _ x])
   106       using \<open>y \<in> T\<close>  apply (auto simp: hull_inc)
   107       done
   108   qed
   109   show ?thesis
   110     apply (rule subset_antisym)
   111     using assms apply (simp add: hull_subset face_of_imp_subset)
   112     apply (cases "T={}", simp)
   113     apply (force simp: rel_interior_eq_empty [symmetric] \<open>convex T\<close> intro: *)
   114     done
   115 qed
   117 lemma face_of_imp_closed:
   118      fixes S :: "'a::euclidean_space set"
   119      assumes "convex S" "closed S" "T face_of S" shows "closed T"
   120   by (metis affine_affine_hull affine_closed closed_Int face_of_imp_eq_affine_Int assms)
   122 lemma face_of_Int_supporting_hyperplane_le_strong:
   123     assumes "convex(S \<inter> {x. a \<bullet> x = b})" and aleb: "\<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<le> b"
   124       shows "(S \<inter> {x. a \<bullet> x = b}) face_of S"
   125 proof -
   126   have *: "a \<bullet> u = a \<bullet> x" if "x \<in> open_segment u v" "u \<in> S" "v \<in> S" and b: "b = a \<bullet> x"
   127           for u v x
   128   proof (rule antisym)
   129     show "a \<bullet> u \<le> a \<bullet> x"
   130       using aleb \<open>u \<in> S\<close> \<open>b = a \<bullet> x\<close> by blast
   131   next
   132     obtain \<xi> where "b = a \<bullet> ((1 - \<xi>) *\<^sub>R u + \<xi> *\<^sub>R v)" "0 < \<xi>" "\<xi> < 1"
   133       using \<open>b = a \<bullet> x\<close> \<open>x \<in> open_segment u v\<close> in_segment
   134       by (auto simp: open_segment_image_interval split: if_split_asm)
   135     then have "b + \<xi> * (a \<bullet> u) \<le> a \<bullet> u + \<xi> * b"
   136       using aleb [OF \<open>v \<in> S\<close>] by (simp add: algebra_simps)
   137     then have "(1 - \<xi>) * b \<le> (1 - \<xi>) * (a \<bullet> u)"
   138       by (simp add: algebra_simps)
   139     then have "b \<le> a \<bullet> u"
   140       using \<open>\<xi> < 1\<close> by auto
   141     with b show "a \<bullet> x \<le> a \<bullet> u" by simp
   142   qed
   143   show ?thesis
   144     apply (simp add: face_of_def assms)
   145     using "*" open_segment_commute by blast
   146 qed
   148 lemma face_of_Int_supporting_hyperplane_ge_strong:
   149    "\<lbrakk>convex(S \<inter> {x. a \<bullet> x = b}); \<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<ge> b\<rbrakk>
   150     \<Longrightarrow> (S \<inter> {x. a \<bullet> x = b}) face_of S"
   151   using face_of_Int_supporting_hyperplane_le_strong [of S "-a" "-b"] by simp
   153 lemma face_of_Int_supporting_hyperplane_le:
   154     "\<lbrakk>convex S; \<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<le> b\<rbrakk> \<Longrightarrow> (S \<inter> {x. a \<bullet> x = b}) face_of S"
   155   by (simp add: convex_Int convex_hyperplane face_of_Int_supporting_hyperplane_le_strong)
   157 lemma face_of_Int_supporting_hyperplane_ge:
   158     "\<lbrakk>convex S; \<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<ge> b\<rbrakk> \<Longrightarrow> (S \<inter> {x. a \<bullet> x = b}) face_of S"
   159   by (simp add: convex_Int convex_hyperplane face_of_Int_supporting_hyperplane_ge_strong)
   161 lemma face_of_imp_convex: "T face_of S \<Longrightarrow> convex T"
   162   using face_of_def by blast
   164 lemma face_of_imp_compact:
   165     fixes S :: "'a::euclidean_space set"
   166     shows "\<lbrakk>convex S; compact S; T face_of S\<rbrakk> \<Longrightarrow> compact T"
   167   by (meson bounded_subset compact_eq_bounded_closed face_of_imp_closed face_of_imp_subset)
   169 lemma face_of_Int_subface:
   170      "\<lbrakk>A \<inter> B face_of A; A \<inter> B face_of B; C face_of A; D face_of B\<rbrakk>
   171       \<Longrightarrow> (C \<inter> D) face_of C \<and> (C \<inter> D) face_of D"
   172   by (meson face_of_Int_Int face_of_face inf_le1 inf_le2)
   174 lemma subset_of_face_of:
   175     fixes S :: "'a::real_normed_vector set"
   176     assumes "T face_of S" "u \<subseteq> S" "T \<inter> (rel_interior u) \<noteq> {}"
   177       shows "u \<subseteq> T"
   178 proof
   179   fix c
   180   assume "c \<in> u"
   181   obtain b where "b \<in> T" "b \<in> rel_interior u" using assms by auto
   182   then obtain e where "e>0" "b \<in> u" and e: "cball b e \<inter> affine hull u \<subseteq> u"
   183     by (auto simp: rel_interior_cball)
   184   show "c \<in> T"
   185   proof (cases "b=c")
   186     case True with \<open>b \<in> T\<close> show ?thesis by blast
   187   next
   188     case False
   189     define d where "d = b + (e / norm(b - c)) *\<^sub>R (b - c)"
   190     have "d \<in> cball b e \<inter> affine hull u"
   191       using \<open>e > 0\<close> \<open>b \<in> u\<close> \<open>c \<in> u\<close>
   192       by (simp add: d_def dist_norm hull_inc mem_affine_3_minus False)
   193     with e have "d \<in> u" by blast
   194     have nbc: "norm (b - c) + e > 0" using \<open>e > 0\<close>
   195       by (metis add.commute le_less_trans less_add_same_cancel2 norm_ge_zero)
   196     then have [simp]: "d \<noteq> c" using False scaleR_cancel_left [of "1 + (e / norm (b - c))" b c]
   197       by (simp add: algebra_simps d_def) (simp add: divide_simps)
   198     have [simp]: "((e - e * e / (e + norm (b - c))) / norm (b - c)) = (e / (e + norm (b - c)))"
   199       using False nbc
   200       by (simp add: divide_simps) (simp add: algebra_simps)
   201     have "b \<in> open_segment d c"
   202       apply (simp add: open_segment_image_interval)
   203       apply (simp add: d_def algebra_simps image_def)
   204       apply (rule_tac x="e / (e + norm (b - c))" in bexI)
   205       using False nbc \<open>0 < e\<close>
   206       apply (auto simp: algebra_simps)
   207       done
   208     then have "d \<in> T \<and> c \<in> T"
   209       apply (rule face_ofD [OF \<open>T face_of S\<close>])
   210       using \<open>d \<in> u\<close>  \<open>c \<in> u\<close> \<open>u \<subseteq> S\<close>  \<open>b \<in> T\<close>  apply auto
   211       done
   212     then show ?thesis ..
   213   qed
   214 qed
   216 lemma face_of_eq:
   217     fixes S :: "'a::real_normed_vector set"
   218     assumes "T face_of S" "u face_of S" "(rel_interior T) \<inter> (rel_interior u) \<noteq> {}"
   219       shows "T = u"
   220   apply (rule subset_antisym)
   221   apply (metis assms disjoint_iff_not_equal face_of_imp_subset rel_interior_subset subsetCE subset_of_face_of)
   222   by (metis assms disjoint_iff_not_equal face_of_imp_subset rel_interior_subset subset_iff subset_of_face_of)
   224 lemma face_of_disjoint_rel_interior:
   225       fixes S :: "'a::real_normed_vector set"
   226       assumes "T face_of S" "T \<noteq> S"
   227         shows "T \<inter> rel_interior S = {}"
   228   by (meson assms subset_of_face_of face_of_imp_subset order_refl subset_antisym)
   230 lemma face_of_disjoint_interior:
   231       fixes S :: "'a::real_normed_vector set"
   232       assumes "T face_of S" "T \<noteq> S"
   233         shows "T \<inter> interior S = {}"
   234 proof -
   235   have "T \<inter> interior S \<subseteq> rel_interior S"
   236     by (meson inf_sup_ord(2) interior_subset_rel_interior order.trans)
   237   thus ?thesis
   238     by (metis (no_types) Int_greatest assms face_of_disjoint_rel_interior inf_sup_ord(1) subset_empty)
   239 qed
   241 lemma face_of_subset_rel_boundary:
   242   fixes S :: "'a::real_normed_vector set"
   243   assumes "T face_of S" "T \<noteq> S"
   244     shows "T \<subseteq> (S - rel_interior S)"
   245 by (meson DiffI assms disjoint_iff_not_equal face_of_disjoint_rel_interior face_of_imp_subset rev_subsetD subsetI)
   247 lemma face_of_subset_rel_frontier:
   248     fixes S :: "'a::real_normed_vector set"
   249     assumes "T face_of S" "T \<noteq> S"
   250       shows "T \<subseteq> rel_frontier S"
   251   using assms closure_subset face_of_disjoint_rel_interior face_of_imp_subset rel_frontier_def by fastforce
   253 lemma face_of_aff_dim_lt:
   254   fixes S :: "'a::euclidean_space set"
   255   assumes "convex S" "T face_of S" "T \<noteq> S"
   256     shows "aff_dim T < aff_dim S"
   257 proof -
   258   have "aff_dim T \<le> aff_dim S"
   259     by (simp add: face_of_imp_subset aff_dim_subset assms)
   260   moreover have "aff_dim T \<noteq> aff_dim S"
   261   proof (cases "T = {}")
   262     case True then show ?thesis
   263       by (metis aff_dim_empty \<open>T \<noteq> S\<close>)
   264   next case False then show ?thesis
   265     by (metis Set.set_insert assms convex_rel_frontier_aff_dim dual_order.irrefl face_of_imp_convex face_of_subset_rel_frontier insert_not_empty subsetI)
   266   qed
   267   ultimately show ?thesis
   268     by simp
   269 qed
   271 lemma subset_of_face_of_affine_hull:
   272     fixes S :: "'a::euclidean_space set"
   273   assumes T: "T face_of S" and "convex S" "U \<subseteq> S" and dis: "\<not> disjnt (affine hull T) (rel_interior U)"
   274   shows "U \<subseteq> T"
   275   apply (rule subset_of_face_of [OF T \<open>U \<subseteq> S\<close>])
   276   using face_of_imp_eq_affine_Int [OF \<open>convex S\<close> T]
   277   using rel_interior_subset [of U] dis
   278   using \<open>U \<subseteq> S\<close> disjnt_def by fastforce
   280 lemma affine_hull_face_of_disjoint_rel_interior:
   281     fixes S :: "'a::euclidean_space set"
   282   assumes "convex S" "F face_of S" "F \<noteq> S"
   283   shows "affine hull F \<inter> rel_interior S = {}"
   284   by (metis assms disjnt_def face_of_imp_subset order_refl subset_antisym subset_of_face_of_affine_hull)
   286 lemma affine_diff_divide:
   287     assumes "affine S" "k \<noteq> 0" "k \<noteq> 1" and xy: "x \<in> S" "y /\<^sub>R (1 - k) \<in> S"
   288       shows "(x - y) /\<^sub>R k \<in> S"
   289 proof -
   290   have "inverse(k) *\<^sub>R (x - y) = (1 - inverse k) *\<^sub>R inverse(1 - k) *\<^sub>R y + inverse(k) *\<^sub>R x"
   291     using assms
   292     by (simp add: algebra_simps) (simp add: scaleR_left_distrib [symmetric] divide_simps)
   293   then show ?thesis
   294     using \<open>affine S\<close> xy by (auto simp: affine_alt)
   295 qed
   297 proposition face_of_convex_hulls:
   298       assumes S: "finite S" "T \<subseteq> S" and disj: "affine hull T \<inter> convex hull (S - T) = {}"
   299       shows  "(convex hull T) face_of (convex hull S)"
   300 proof -
   301   have fin: "finite T" "finite (S - T)" using assms
   302     by (auto simp: finite_subset)
   303   have *: "x \<in> convex hull T"
   304           if x: "x \<in> convex hull S" and y: "y \<in> convex hull S" and w: "w \<in> convex hull T" "w \<in> open_segment x y"
   305           for x y w
   306   proof -
   307     have waff: "w \<in> affine hull T"
   308       using convex_hull_subset_affine_hull w by blast
   309     obtain a b where a: "\<And>i. i \<in> S \<Longrightarrow> 0 \<le> a i" and asum: "sum a S = 1" and aeqx: "(\<Sum>i\<in>S. a i *\<^sub>R i) = x"
   310                  and b: "\<And>i. i \<in> S \<Longrightarrow> 0 \<le> b i" and bsum: "sum b S = 1" and beqy: "(\<Sum>i\<in>S. b i *\<^sub>R i) = y"
   311       using x y by (auto simp: assms convex_hull_finite)
   312     obtain u where "(1 - u) *\<^sub>R x + u *\<^sub>R y \<in> convex hull T" "x \<noteq> y" and weq: "w = (1 - u) *\<^sub>R x + u *\<^sub>R y"
   313                and u01: "0 < u" "u < 1"
   314       using w by (auto simp: open_segment_image_interval split: if_split_asm)
   315     define c where "c i = (1 - u) * a i + u * b i" for i
   316     have cge0: "\<And>i. i \<in> S \<Longrightarrow> 0 \<le> c i"
   317       using a b u01 by (simp add: c_def)
   318     have sumc1: "sum c S = 1"
   319       by (simp add: c_def sum.distrib sum_distrib_left [symmetric] asum bsum)
   320     have sumci_xy: "(\<Sum>i\<in>S. c i *\<^sub>R i) = (1 - u) *\<^sub>R x + u *\<^sub>R y"
   321       apply (simp add: c_def sum.distrib scaleR_left_distrib)
   322       by (simp only: scaleR_scaleR [symmetric] Real_Vector_Spaces.scaleR_right.sum [symmetric] aeqx beqy)
   323     show ?thesis
   324     proof (cases "sum c (S - T) = 0")
   325       case True
   326       have ci0: "\<And>i. i \<in> (S - T) \<Longrightarrow> c i = 0"
   327         using True cge0 fin(2) sum_nonneg_eq_0_iff by auto
   328       have a0: "a i = 0" if "i \<in> (S - T)" for i
   329         using ci0 [OF that] u01 a [of i] b [of i] that
   330         by (simp add: c_def Groups.ordered_comm_monoid_add_class.add_nonneg_eq_0_iff)
   331       have [simp]: "sum a T = 1"
   332         using assms by (metis sum.mono_neutral_cong_right a0 asum)
   333       show ?thesis
   334         apply (simp add: convex_hull_finite \<open>finite T\<close>)
   335         apply (rule_tac x=a in exI)
   336         using a0 assms
   337         apply (auto simp: cge0 a aeqx [symmetric] sum.mono_neutral_right)
   338         done
   339     next
   340       case False
   341       define k where "k = sum c (S - T)"
   342       have "k > 0" using False
   343         unfolding k_def by (metis DiffD1 antisym_conv cge0 sum_nonneg not_less)
   344       have weq_sumsum: "w = sum (\<lambda>x. c x *\<^sub>R x) T + sum (\<lambda>x. c x *\<^sub>R x) (S - T)"
   345         by (metis (no_types) add.commute S(1) S(2) sum.subset_diff sumci_xy weq)
   346       show ?thesis
   347       proof (cases "k = 1")
   348         case True
   349         then have "sum c T = 0"
   350           by (simp add: S k_def sum_diff sumc1)
   351         then have [simp]: "sum c (S - T) = 1"
   352           by (simp add: S sum_diff sumc1)
   353         have ci0: "\<And>i. i \<in> T \<Longrightarrow> c i = 0"
   354           by (meson \<open>finite T\<close> \<open>sum c T = 0\<close> \<open>T \<subseteq> S\<close> cge0 sum_nonneg_eq_0_iff subsetCE)
   355         then have [simp]: "(\<Sum>i\<in>S-T. c i *\<^sub>R i) = w"
   356           by (simp add: weq_sumsum)
   357         have "w \<in> convex hull (S - T)"
   358           apply (simp add: convex_hull_finite fin)
   359           apply (rule_tac x=c in exI)
   360           apply (auto simp: cge0 weq True k_def)
   361           done
   362         then show ?thesis
   363           using disj waff by blast
   364       next
   365         case False
   366         then have sumcf: "sum c T = 1 - k"
   367           by (simp add: S k_def sum_diff sumc1)
   368         have "(\<Sum>i\<in>T. c i *\<^sub>R i) /\<^sub>R (1 - k) \<in> convex hull T"
   369           apply (simp add: convex_hull_finite fin)
   370           apply (rule_tac x="\<lambda>i. inverse (1-k) * c i" in exI)
   371           apply auto
   372           apply (metis sumcf cge0 inverse_nonnegative_iff_nonnegative mult_nonneg_nonneg S(2) sum_nonneg subsetCE)
   373           apply (metis False mult.commute right_inverse right_minus_eq sum_distrib_left sumcf)
   374           by (metis (mono_tags, lifting) scaleR_right.sum scaleR_scaleR sum.cong)
   375         with \<open>0 < k\<close>  have "inverse(k) *\<^sub>R (w - sum (\<lambda>i. c i *\<^sub>R i) T) \<in> affine hull T"
   376           by (simp add: affine_diff_divide [OF affine_affine_hull] False waff convex_hull_subset_affine_hull [THEN subsetD])
   377         moreover have "inverse(k) *\<^sub>R (w - sum (\<lambda>x. c x *\<^sub>R x) T) \<in> convex hull (S - T)"
   378           apply (simp add: weq_sumsum convex_hull_finite fin)
   379           apply (rule_tac x="\<lambda>i. inverse k * c i" in exI)
   380           using \<open>k > 0\<close> cge0
   381           apply (auto simp: scaleR_right.sum sum_distrib_left [symmetric] k_def [symmetric])
   382           done
   383         ultimately show ?thesis
   384           using disj by blast
   385       qed
   386     qed
   387   qed
   388   have [simp]: "convex hull T \<subseteq> convex hull S"
   389     by (simp add: \<open>T \<subseteq> S\<close> hull_mono)
   390   show ?thesis
   391     using open_segment_commute by (auto simp: face_of_def intro: *)
   392 qed
   394 proposition face_of_convex_hull_insert:
   395    "\<lbrakk>finite S; a \<notin> affine hull S; T face_of convex hull S\<rbrakk> \<Longrightarrow> T face_of convex hull insert a S"
   396   apply (rule face_of_trans, blast)
   397   apply (rule face_of_convex_hulls; force simp: insert_Diff_if)
   398   done
   400 proposition face_of_affine_trivial:
   401     assumes "affine S" "T face_of S"
   402     shows "T = {} \<or> T = S"
   403 proof (rule ccontr, clarsimp)
   404   assume "T \<noteq> {}" "T \<noteq> S"
   405   then obtain a where "a \<in> T" by auto
   406   then have "a \<in> S"
   407     using \<open>T face_of S\<close> face_of_imp_subset by blast
   408   have "S \<subseteq> T"
   409   proof
   410     fix b  assume "b \<in> S"
   411     show "b \<in> T"
   412     proof (cases "a = b")
   413       case True with \<open>a \<in> T\<close> show ?thesis by auto
   414     next
   415       case False
   416       then have "a \<in> open_segment (2 *\<^sub>R a - b) b"
   417         apply (auto simp: open_segment_def closed_segment_def)
   418         apply (rule_tac x="1/2" in exI)
   419         apply (simp add: algebra_simps)
   420         by (simp add: scaleR_2)
   421       moreover have "2 *\<^sub>R a - b \<in> S"
   422         by (rule mem_affine [OF \<open>affine S\<close> \<open>a \<in> S\<close> \<open>b \<in> S\<close>, of 2 "-1", simplified])
   423       moreover note \<open>b \<in> S\<close> \<open>a \<in> T\<close>
   424       ultimately show ?thesis
   425         by (rule face_ofD [OF \<open>T face_of S\<close>, THEN conjunct2])
   426     qed
   427   qed
   428   then show False
   429     using \<open>T \<noteq> S\<close> \<open>T face_of S\<close> face_of_imp_subset by blast
   430 qed
   433 lemma face_of_affine_eq:
   434    "affine S \<Longrightarrow> (T face_of S \<longleftrightarrow> T = {} \<or> T = S)"
   435 using affine_imp_convex face_of_affine_trivial face_of_refl by auto
   438 proposition Inter_faces_finite_altbound:
   439     fixes T :: "'a::euclidean_space set set"
   440     assumes cfaI: "\<And>c. c \<in> T \<Longrightarrow> c face_of S"
   441     shows "\<exists>F'. finite F' \<and> F' \<subseteq> T \<and> card F' \<le> DIM('a) + 2 \<and> \<Inter>F' = \<Inter>T"
   442 proof (cases "\<forall>F'. finite F' \<and> F' \<subseteq> T \<and> card F' \<le> DIM('a) + 2 \<longrightarrow> (\<exists>c. c \<in> T \<and> c \<inter> (\<Inter>F') \<subset> (\<Inter>F'))")
   443   case True
   444   then obtain c where c:
   445        "\<And>F'. \<lbrakk>finite F'; F' \<subseteq> T; card F' \<le> DIM('a) + 2\<rbrakk> \<Longrightarrow> c F' \<in> T \<and> c F' \<inter> (\<Inter>F') \<subset> (\<Inter>F')"
   446     by metis
   447   define d where "d = rec_nat {c{}} (\<lambda>n r. insert (c r) r)"
   448   have [simp]: "d 0 = {c {}}"
   449     by (simp add: d_def)
   450   have dSuc [simp]: "\<And>n. d (Suc n) = insert (c (d n)) (d n)"
   451     by (simp add: d_def)
   452   have dn_notempty: "d n \<noteq> {}" for n
   453     by (induction n) auto
   454   have dn_le_Suc: "d n \<subseteq> T \<and> finite(d n) \<and> card(d n) \<le> Suc n" if "n \<le> DIM('a) + 2" for n
   455   using that
   456   proof (induction n)
   457     case 0
   458     then show ?case by (simp add: c)
   459   next
   460     case (Suc n)
   461     then show ?case by (auto simp: c card_insert_if)
   462   qed
   463   have aff_dim_le: "aff_dim(\<Inter>(d n)) \<le> DIM('a) - int n" if "n \<le> DIM('a) + 2" for n
   464   using that
   465   proof (induction n)
   466     case 0
   467     then show ?case
   468       by (simp add: aff_dim_le_DIM)
   469   next
   470     case (Suc n)
   471     have fs: "\<Inter>(d (Suc n)) face_of S"
   472       by (meson Suc.prems cfaI dn_le_Suc dn_notempty face_of_Inter subsetCE)
   473     have condn: "convex (\<Inter>(d n))"
   474       using Suc.prems nat_le_linear not_less_eq_eq
   475       by (blast intro: face_of_imp_convex cfaI convex_Inter dest: dn_le_Suc)
   476     have fdn: "\<Inter>(d (Suc n)) face_of \<Inter>(d n)"
   477       by (metis (no_types, lifting) Inter_anti_mono Suc.prems dSuc cfaI dn_le_Suc dn_notempty face_of_Inter face_of_imp_subset face_of_subset subset_iff subset_insertI)
   478     have ne: "\<Inter>(d (Suc n)) \<noteq> \<Inter>(d n)"
   479       by (metis (no_types, lifting) Suc.prems Suc_leD c complete_lattice_class.Inf_insert dSuc dn_le_Suc less_irrefl order.trans)
   480     have *: "\<And>m::int. \<And>d. \<And>d'::int. d < d' \<and> d' \<le> m - n \<Longrightarrow> d \<le> m - of_nat(n+1)"
   481       by arith
   482     have "aff_dim (\<Inter>(d (Suc n))) < aff_dim (\<Inter>(d n))"
   483       by (rule face_of_aff_dim_lt [OF condn fdn ne])
   484     moreover have "aff_dim (\<Inter>(d n)) \<le> int (DIM('a)) - int n"
   485       using Suc by auto
   486     ultimately
   487     have "aff_dim (\<Inter>(d (Suc n))) \<le> int (DIM('a)) - (n+1)" by arith
   488     then show ?case by linarith
   489   qed
   490   have "aff_dim (\<Inter>(d (DIM('a) + 2))) \<le> -2"
   491       using aff_dim_le [OF order_refl] by simp
   492   with aff_dim_geq [of "\<Inter>(d (DIM('a) + 2))"] show ?thesis
   493     using order.trans by fastforce
   494 next
   495   case False
   496   then show ?thesis
   497     apply simp
   498     apply (erule ex_forward)
   499     by blast
   500 qed
   502 lemma faces_of_translation:
   503    "{F. F face_of image (\<lambda>x. a + x) S} = image (image (\<lambda>x. a + x)) {F. F face_of S}"
   504 apply (rule subset_antisym, clarify)
   505 apply (auto simp: image_iff)
   506 apply (metis face_of_imp_subset face_of_translation_eq subset_imageE)
   507 done
   509 proposition face_of_Times:
   510   assumes "F face_of S" and "F' face_of S'"
   511     shows "(F \<times> F') face_of (S \<times> S')"
   512 proof -
   513   have "F \<times> F' \<subseteq> S \<times> S'"
   514     using assms [unfolded face_of_def] by blast
   515   moreover
   516   have "convex (F \<times> F')"
   517     using assms [unfolded face_of_def] by (blast intro: convex_Times)
   518   moreover
   519     have "a \<in> F \<and> a' \<in> F' \<and> b \<in> F \<and> b' \<in> F'"
   520        if "a \<in> S" "b \<in> S" "a' \<in> S'" "b' \<in> S'" "x \<in> F \<times> F'" "x \<in> open_segment (a,a') (b,b')"
   521        for a b a' b' x
   522   proof (cases "b=a \<or> b'=a'")
   523     case True with that show ?thesis
   524       using assms
   525       by (force simp: in_segment dest: face_ofD)
   526   next
   527     case False with assms [unfolded face_of_def] that show ?thesis
   528       by (blast dest!: open_segment_PairD)
   529   qed
   530   ultimately show ?thesis
   531     unfolding face_of_def by blast
   532 qed
   534 corollary face_of_Times_decomp:
   535     fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
   536     shows "c face_of (S \<times> S') \<longleftrightarrow> (\<exists>F F'. F face_of S \<and> F' face_of S' \<and> c = F \<times> F')"
   537      (is "?lhs = ?rhs")
   538 proof
   539   assume c: ?lhs
   540   show ?rhs
   541   proof (cases "c = {}")
   542     case True then show ?thesis by auto
   543   next
   544     case False
   545     have 1: "fst ` c \<subseteq> S" "snd ` c \<subseteq> S'"
   546       using c face_of_imp_subset by fastforce+
   547     have "convex c"
   548       using c by (metis face_of_imp_convex)
   549     have conv: "convex (fst ` c)" "convex (snd ` c)"
   550       by (simp_all add: \<open>convex c\<close> convex_linear_image fst_linear snd_linear)
   551     have fstab: "a \<in> fst ` c \<and> b \<in> fst ` c"
   552             if "a \<in> S" "b \<in> S" "x \<in> open_segment a b" "(x,x') \<in> c" for a b x x'
   553     proof -
   554       have *: "(x,x') \<in> open_segment (a,x') (b,x')"
   555         using that by (auto simp: in_segment)
   556       show ?thesis
   557         using face_ofD [OF c *] that face_of_imp_subset [OF c] by force
   558     qed
   559     have fst: "fst ` c face_of S"
   560       by (force simp: face_of_def 1 conv fstab)
   561     have sndab: "a' \<in> snd ` c \<and> b' \<in> snd ` c"
   562             if "a' \<in> S'" "b' \<in> S'" "x' \<in> open_segment a' b'" "(x,x') \<in> c" for a' b' x x'
   563     proof -
   564       have *: "(x,x') \<in> open_segment (x,a') (x,b')"
   565         using that by (auto simp: in_segment)
   566       show ?thesis
   567         using face_ofD [OF c *] that face_of_imp_subset [OF c] by force
   568     qed
   569     have snd: "snd ` c face_of S'"
   570       by (force simp: face_of_def 1 conv sndab)
   571     have cc: "rel_interior c \<subseteq> rel_interior (fst ` c) \<times> rel_interior (snd ` c)"
   572       by (force simp: face_of_Times rel_interior_Times conv fst snd \<open>convex c\<close> fst_linear snd_linear rel_interior_convex_linear_image [symmetric])
   573     have "c = fst ` c \<times> snd ` c"
   574       apply (rule face_of_eq [OF c])
   575       apply (simp_all add: face_of_Times rel_interior_Times conv fst snd)
   576       using False rel_interior_eq_empty \<open>convex c\<close> cc
   577       apply blast
   578       done
   579     with fst snd show ?thesis by metis
   580   qed
   581 next
   582   assume ?rhs with face_of_Times show ?lhs by auto
   583 qed
   585 lemma face_of_Times_eq:
   586     fixes S :: "'a::euclidean_space set" and S' :: "'b::euclidean_space set"
   587     shows "(F \<times> F') face_of (S \<times> S') \<longleftrightarrow>
   588            F = {} \<or> F' = {} \<or> F face_of S \<and> F' face_of S'"
   589 by (auto simp: face_of_Times_decomp times_eq_iff)
   591 lemma hyperplane_face_of_halfspace_le: "{x. a \<bullet> x = b} face_of {x. a \<bullet> x \<le> b}"
   592 proof -
   593   have "{x. a \<bullet> x \<le> b} \<inter> {x. a \<bullet> x = b} = {x. a \<bullet> x = b}"
   594     by auto
   595   with face_of_Int_supporting_hyperplane_le [OF convex_halfspace_le [of a b], of a b]
   596   show ?thesis by auto
   597 qed
   599 lemma hyperplane_face_of_halfspace_ge: "{x. a \<bullet> x = b} face_of {x. a \<bullet> x \<ge> b}"
   600 proof -
   601   have "{x. a \<bullet> x \<ge> b} \<inter> {x. a \<bullet> x = b} = {x. a \<bullet> x = b}"
   602     by auto
   603   with face_of_Int_supporting_hyperplane_ge [OF convex_halfspace_ge [of b a], of b a]
   604   show ?thesis by auto
   605 qed
   607 lemma face_of_halfspace_le:
   608   fixes a :: "'n::euclidean_space"
   609   shows "F face_of {x. a \<bullet> x \<le> b} \<longleftrightarrow>
   610          F = {} \<or> F = {x. a \<bullet> x = b} \<or> F = {x. a \<bullet> x \<le> b}"
   611      (is "?lhs = ?rhs")
   612 proof (cases "a = 0")
   613   case True then show ?thesis
   614     using face_of_affine_eq affine_UNIV by auto
   615 next
   616   case False
   617   then have ine: "interior {x. a \<bullet> x \<le> b} \<noteq> {}"
   618     using halfspace_eq_empty_lt interior_halfspace_le by blast
   619   show ?thesis
   620   proof
   621     assume L: ?lhs
   622     have "F \<noteq> {x. a \<bullet> x \<le> b} \<Longrightarrow> F face_of {x. a \<bullet> x = b}"
   623       using False
   624       apply (simp add: frontier_halfspace_le [symmetric] rel_frontier_nonempty_interior [OF ine, symmetric])
   625       apply (rule face_of_subset [OF L])
   626       apply (simp add: face_of_subset_rel_frontier [OF L])
   627       apply (force simp: rel_frontier_def closed_halfspace_le)
   628       done
   629     with L show ?rhs
   630       using affine_hyperplane face_of_affine_eq by blast
   631   next
   632     assume ?rhs
   633     then show ?lhs
   634       by (metis convex_halfspace_le empty_face_of face_of_refl hyperplane_face_of_halfspace_le)
   635   qed
   636 qed
   638 lemma face_of_halfspace_ge:
   639   fixes a :: "'n::euclidean_space"
   640   shows "F face_of {x. a \<bullet> x \<ge> b} \<longleftrightarrow>
   641          F = {} \<or> F = {x. a \<bullet> x = b} \<or> F = {x. a \<bullet> x \<ge> b}"
   642 using face_of_halfspace_le [of F "-a" "-b"] by simp
   644 subsection\<open>Exposed faces\<close>
   646 text\<open>That is, faces that are intersection with supporting hyperplane\<close>
   648 definition%important exposed_face_of :: "['a::euclidean_space set, 'a set] \<Rightarrow> bool"
   649                                (infixr "(exposed'_face'_of)" 50)
   650   where "T exposed_face_of S \<longleftrightarrow>
   651          T face_of S \<and> (\<exists>a b. S \<subseteq> {x. a \<bullet> x \<le> b} \<and> T = S \<inter> {x. a \<bullet> x = b})"
   653 lemma empty_exposed_face_of [iff]: "{} exposed_face_of S"
   654   apply (simp add: exposed_face_of_def)
   655   apply (rule_tac x=0 in exI)
   656   apply (rule_tac x=1 in exI, force)
   657   done
   659 lemma exposed_face_of_refl_eq [simp]: "S exposed_face_of S \<longleftrightarrow> convex S"
   660   apply (simp add: exposed_face_of_def face_of_refl_eq, auto)
   661   apply (rule_tac x=0 in exI)+
   662   apply force
   663   done
   665 lemma exposed_face_of_refl: "convex S \<Longrightarrow> S exposed_face_of S"
   666   by simp
   668 lemma exposed_face_of:
   669     "T exposed_face_of S \<longleftrightarrow>
   670      T face_of S \<and>
   671      (T = {} \<or> T = S \<or>
   672       (\<exists>a b. a \<noteq> 0 \<and> S \<subseteq> {x. a \<bullet> x \<le> b} \<and> T = S \<inter> {x. a \<bullet> x = b}))"
   673 proof (cases "T = {}")
   674   case True then show ?thesis
   675     by simp
   676 next
   677   case False
   678   show ?thesis
   679   proof (cases "T = S")
   680     case True then show ?thesis
   681       by (simp add: face_of_refl_eq)
   682   next
   683     case False
   684     with \<open>T \<noteq> {}\<close> show ?thesis
   685       apply (auto simp: exposed_face_of_def)
   686       apply (metis inner_zero_left)
   687       done
   688   qed
   689 qed
   691 lemma exposed_face_of_Int_supporting_hyperplane_le:
   692    "\<lbrakk>convex S; \<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<le> b\<rbrakk> \<Longrightarrow> (S \<inter> {x. a \<bullet> x = b}) exposed_face_of S"
   693 by (force simp: exposed_face_of_def face_of_Int_supporting_hyperplane_le)
   695 lemma exposed_face_of_Int_supporting_hyperplane_ge:
   696    "\<lbrakk>convex S; \<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<ge> b\<rbrakk> \<Longrightarrow> (S \<inter> {x. a \<bullet> x = b}) exposed_face_of S"
   697 using exposed_face_of_Int_supporting_hyperplane_le [of S "-a" "-b"] by simp
   699 proposition exposed_face_of_Int:
   700   assumes "T exposed_face_of S"
   701       and "u exposed_face_of S"
   702     shows "(T \<inter> u) exposed_face_of S"
   703 proof -
   704   obtain a b where T: "S \<inter> {x. a \<bullet> x = b} face_of S"
   705                and S: "S \<subseteq> {x. a \<bullet> x \<le> b}"
   706                and teq: "T = S \<inter> {x. a \<bullet> x = b}"
   707     using assms by (auto simp: exposed_face_of_def)
   708   obtain a' b' where u: "S \<inter> {x. a' \<bullet> x = b'} face_of S"
   709                  and s': "S \<subseteq> {x. a' \<bullet> x \<le> b'}"
   710                  and ueq: "u = S \<inter> {x. a' \<bullet> x = b'}"
   711     using assms by (auto simp: exposed_face_of_def)
   712   have tu: "T \<inter> u face_of S"
   713     using T teq u ueq by (simp add: face_of_Int)
   714   have ss: "S \<subseteq> {x. (a + a') \<bullet> x \<le> b + b'}"
   715     using S s' by (force simp: inner_left_distrib)
   716   show ?thesis
   717     apply (simp add: exposed_face_of_def tu)
   718     apply (rule_tac x="a+a'" in exI)
   719     apply (rule_tac x="b+b'" in exI)
   720     using S s'
   721     apply (fastforce simp: ss inner_left_distrib teq ueq)
   722     done
   723 qed
   725 proposition exposed_face_of_Inter:
   726     fixes P :: "'a::euclidean_space set set"
   727   assumes "P \<noteq> {}"
   728       and "\<And>T. T \<in> P \<Longrightarrow> T exposed_face_of S"
   729     shows "\<Inter>P exposed_face_of S"
   730 proof -
   731   obtain Q where "finite Q" and QsubP: "Q \<subseteq> P" "card Q \<le> DIM('a) + 2" and IntQ: "\<Inter>Q = \<Inter>P"
   732     using Inter_faces_finite_altbound [of P S] assms [unfolded exposed_face_of]
   733     by force
   734   show ?thesis
   735   proof (cases "Q = {}")
   736     case True then show ?thesis
   737       by (metis IntQ Inter_UNIV_conv(2) assms(1) assms(2) ex_in_conv)
   738   next
   739     case False
   740     have "Q \<subseteq> {T. T exposed_face_of S}"
   741       using QsubP assms by blast
   742     moreover have "Q \<subseteq> {T. T exposed_face_of S} \<Longrightarrow> \<Inter>Q exposed_face_of S"
   743       using \<open>finite Q\<close> False
   744       apply (induction Q rule: finite_induct)
   745       using exposed_face_of_Int apply fastforce+
   746       done
   747     ultimately show ?thesis
   748       by (simp add: IntQ)
   749   qed
   750 qed
   752 proposition exposed_face_of_sums:
   753   assumes "convex S" and "convex T"
   754       and "F exposed_face_of {x + y | x y. x \<in> S \<and> y \<in> T}"
   755           (is "F exposed_face_of ?ST")
   756   obtains k l
   757     where "k exposed_face_of S" "l exposed_face_of T"
   758           "F = {x + y | x y. x \<in> k \<and> y \<in> l}"
   759 proof (cases "F = {}")
   760   case True then show ?thesis
   761     using that by blast
   762 next
   763   case False
   764   show ?thesis
   765   proof (cases "F = ?ST")
   766     case True then show ?thesis
   767       using assms exposed_face_of_refl_eq that by blast
   768   next
   769     case False
   770     obtain p where "p \<in> F" using \<open>F \<noteq> {}\<close> by blast
   771     moreover
   772     obtain u z where T: "?ST \<inter> {x. u \<bullet> x = z} face_of ?ST"
   773                  and S: "?ST \<subseteq> {x. u \<bullet> x \<le> z}"
   774                  and feq: "F = ?ST \<inter> {x. u \<bullet> x = z}"
   775       using assms by (auto simp: exposed_face_of_def)
   776     ultimately obtain a0 b0
   777             where p: "p = a0 + b0" and "a0 \<in> S" "b0 \<in> T" and z: "u \<bullet> p = z"
   778       by auto
   779     have lez: "u \<bullet> (x + y) \<le> z" if "x \<in> S" "y \<in> T" for x y
   780       using S that by auto
   781     have sef: "S \<inter> {x. u \<bullet> x = u \<bullet> a0} exposed_face_of S"
   782       apply (rule exposed_face_of_Int_supporting_hyperplane_le [OF \<open>convex S\<close>])
   783       apply (metis p z add_le_cancel_right inner_right_distrib lez [OF _ \<open>b0 \<in> T\<close>])
   784       done
   785     have tef: "T \<inter> {x. u \<bullet> x = u \<bullet> b0} exposed_face_of T"
   786       apply (rule exposed_face_of_Int_supporting_hyperplane_le [OF \<open>convex T\<close>])
   787       apply (metis p z add.commute add_le_cancel_right inner_right_distrib lez [OF \<open>a0 \<in> S\<close>])
   788       done
   789     have "{x + y |x y. x \<in> S \<and> u \<bullet> x = u \<bullet> a0 \<and> y \<in> T \<and> u \<bullet> y = u \<bullet> b0} \<subseteq> F"
   790       by (auto simp: feq) (metis inner_right_distrib p z)
   791     moreover have "F \<subseteq> {x + y |x y. x \<in> S \<and> u \<bullet> x = u \<bullet> a0 \<and> y \<in> T \<and> u \<bullet> y = u \<bullet> b0}"
   792       apply (auto simp: feq)
   793       apply (rename_tac x y)
   794       apply (rule_tac x=x in exI)
   795       apply (rule_tac x=y in exI, simp)
   796       using z p \<open>a0 \<in> S\<close> \<open>b0 \<in> T\<close>
   797       apply clarify
   798       apply (simp add: inner_right_distrib)
   799       apply (metis add_le_cancel_right antisym lez [unfolded inner_right_distrib] add.commute)
   800       done
   801     ultimately have "F = {x + y |x y. x \<in> S \<inter> {x. u \<bullet> x = u \<bullet> a0} \<and> y \<in> T \<inter> {x. u \<bullet> x = u \<bullet> b0}}"
   802       by blast
   803     then show ?thesis
   804       by (rule that [OF sef tef])
   805   qed
   806 qed
   808 proposition exposed_face_of_parallel:
   809    "T exposed_face_of S \<longleftrightarrow>
   810          T face_of S \<and>
   811          (\<exists>a b. S \<subseteq> {x. a \<bullet> x \<le> b} \<and> T = S \<inter> {x. a \<bullet> x = b} \<and>
   812                 (T \<noteq> {} \<longrightarrow> T \<noteq> S \<longrightarrow> a \<noteq> 0) \<and>
   813                 (T \<noteq> S \<longrightarrow> (\<forall>w \<in> affine hull S. (w + a) \<in> affine hull S)))"
   814   (is "?lhs = ?rhs")
   815 proof
   816   assume ?lhs then show ?rhs
   817   proof (clarsimp simp: exposed_face_of_def)
   818     fix a b
   819     assume faceS: "S \<inter> {x. a \<bullet> x = b} face_of S" and Ssub: "S \<subseteq> {x. a \<bullet> x \<le> b}" 
   820     show "\<exists>c d. S \<subseteq> {x. c \<bullet> x \<le> d} \<and>
   821                 S \<inter> {x. a \<bullet> x = b} = S \<inter> {x. c \<bullet> x = d} \<and>
   822                 (S \<inter> {x. a \<bullet> x = b} \<noteq> {} \<longrightarrow> S \<inter> {x. a \<bullet> x = b} \<noteq> S \<longrightarrow> c \<noteq> 0) \<and>
   823                 (S \<inter> {x. a \<bullet> x = b} \<noteq> S \<longrightarrow> (\<forall>w \<in> affine hull S. w + c \<in> affine hull S))"
   824     proof (cases "affine hull S \<inter> {x. -a \<bullet> x \<le> -b} = {} \<or> affine hull S \<subseteq> {x. - a \<bullet> x \<le> - b}")
   825       case True
   826       then show ?thesis
   827       proof
   828         assume "affine hull S \<inter> {x. - a \<bullet> x \<le> - b} = {}"
   829        then show ?thesis
   830          apply (rule_tac x="0" in exI)
   831          apply (rule_tac x="1" in exI)
   832          using hull_subset by fastforce
   833     next
   834       assume "affine hull S \<subseteq> {x. - a \<bullet> x \<le> - b}"
   835       then show ?thesis
   836          apply (rule_tac x="0" in exI)
   837          apply (rule_tac x="0" in exI)
   838         using Ssub hull_subset by fastforce
   839     qed
   840   next
   841     case False
   842     then obtain a' b' where "a' \<noteq> 0" 
   843       and le: "affine hull S \<inter> {x. a' \<bullet> x \<le> b'} = affine hull S \<inter> {x. - a \<bullet> x \<le> - b}" 
   844       and eq: "affine hull S \<inter> {x. a' \<bullet> x = b'} = affine hull S \<inter> {x. - a \<bullet> x = - b}" 
   845       and mem: "\<And>w. w \<in> affine hull S \<Longrightarrow> w + a' \<in> affine hull S"
   846       using affine_parallel_slice affine_affine_hull by metis 
   847     show ?thesis
   848     proof (intro conjI impI allI ballI exI)
   849       have *: "S \<subseteq> - (affine hull S \<inter> {x. P x}) \<union> affine hull S \<inter> {x. Q x} \<Longrightarrow> S \<subseteq> {x. \<not> P x \<or> Q x}" 
   850         for P Q 
   851         using hull_subset by fastforce  
   852       have "S \<subseteq> {x. \<not> (a' \<bullet> x \<le> b') \<or> a' \<bullet> x = b'}"
   853         apply (rule *)
   854         apply (simp only: le eq)
   855         using Ssub by auto
   856       then show "S \<subseteq> {x. - a' \<bullet> x \<le> - b'}"
   857         by auto 
   858       show "S \<inter> {x. a \<bullet> x = b} = S \<inter> {x. - a' \<bullet> x = - b'}"
   859         using eq hull_subset [of S affine] by force
   860       show "\<lbrakk>S \<inter> {x. a \<bullet> x = b} \<noteq> {}; S \<inter> {x. a \<bullet> x = b} \<noteq> S\<rbrakk> \<Longrightarrow> - a' \<noteq> 0"
   861         using \<open>a' \<noteq> 0\<close> by auto
   862       show "w + - a' \<in> affine hull S"
   863         if "S \<inter> {x. a \<bullet> x = b} \<noteq> S" "w \<in> affine hull S" for w
   864       proof -
   865         have "w + 1 *\<^sub>R (w - (w + a')) \<in> affine hull S"
   866           using affine_affine_hull mem mem_affine_3_minus that(2) by blast
   867         then show ?thesis  by simp
   868       qed
   869     qed
   870   qed
   871 qed
   872 next
   873   assume ?rhs then show ?lhs
   874     unfolding exposed_face_of_def by blast
   875 qed
   877 subsection\<open>Extreme points of a set: its singleton faces\<close>
   879 definition%important extreme_point_of :: "['a::real_vector, 'a set] \<Rightarrow> bool"
   880                                (infixr "(extreme'_point'_of)" 50)
   881   where "x extreme_point_of S \<longleftrightarrow>
   882          x \<in> S \<and> (\<forall>a \<in> S. \<forall>b \<in> S. x \<notin> open_segment a b)"
   884 lemma extreme_point_of_stillconvex:
   885    "convex S \<Longrightarrow> (x extreme_point_of S \<longleftrightarrow> x \<in> S \<and> convex(S - {x}))"
   886   by (fastforce simp add: convex_contains_segment extreme_point_of_def open_segment_def)
   888 lemma face_of_singleton:
   889    "{x} face_of S \<longleftrightarrow> x extreme_point_of S"
   890 by (fastforce simp add: extreme_point_of_def face_of_def)
   892 lemma extreme_point_not_in_REL_INTERIOR:
   893     fixes S :: "'a::real_normed_vector set"
   894     shows "\<lbrakk>x extreme_point_of S; S \<noteq> {x}\<rbrakk> \<Longrightarrow> x \<notin> rel_interior S"
   895 apply (simp add: face_of_singleton [symmetric])
   896 apply (blast dest: face_of_disjoint_rel_interior)
   897 done
   899 lemma extreme_point_not_in_interior:
   900     fixes S :: "'a::{real_normed_vector, perfect_space} set"
   901     shows "x extreme_point_of S \<Longrightarrow> x \<notin> interior S"
   902 apply (case_tac "S = {x}")
   903 apply (simp add: empty_interior_finite)
   904 by (meson contra_subsetD extreme_point_not_in_REL_INTERIOR interior_subset_rel_interior)
   906 lemma extreme_point_of_face:
   907      "F face_of S \<Longrightarrow> v extreme_point_of F \<longleftrightarrow> v extreme_point_of S \<and> v \<in> F"
   908   by (meson empty_subsetI face_of_face face_of_singleton insert_subset)
   910 lemma extreme_point_of_convex_hull:
   911    "x extreme_point_of (convex hull S) \<Longrightarrow> x \<in> S"
   912 apply (simp add: extreme_point_of_stillconvex)
   913 using hull_minimal [of S "(convex hull S) - {x}" convex]
   914 using hull_subset [of S convex]
   915 apply blast
   916 done
   918 proposition extreme_points_of_convex_hull:
   919    "{x. x extreme_point_of (convex hull S)} \<subseteq> S"
   920   using extreme_point_of_convex_hull by auto
   922 lemma extreme_point_of_empty [simp]: "\<not> (x extreme_point_of {})"
   923   by (simp add: extreme_point_of_def)
   925 lemma extreme_point_of_singleton [iff]: "x extreme_point_of {a} \<longleftrightarrow> x = a"
   926   using extreme_point_of_stillconvex by auto
   928 lemma extreme_point_of_translation_eq:
   929    "(a + x) extreme_point_of (image (\<lambda>x. a + x) S) \<longleftrightarrow> x extreme_point_of S"
   930 by (auto simp: extreme_point_of_def)
   932 lemma extreme_points_of_translation:
   933    "{x. x extreme_point_of (image (\<lambda>x. a + x) S)} =
   934     (\<lambda>x. a + x) ` {x. x extreme_point_of S}"
   935   using extreme_point_of_translation_eq
   936   by auto (metis (no_types, lifting) image_iff mem_Collect_eq minus_add_cancel)
   938 lemma extreme_points_of_translation_subtract:
   939    "{x. x extreme_point_of (image (\<lambda>x. x - a) S)} =
   940     (\<lambda>x. x - a) ` {x. x extreme_point_of S}"
   941   using extreme_points_of_translation [of "- a" S]
   942   by simp
   944 lemma extreme_point_of_Int:
   945    "\<lbrakk>x extreme_point_of S; x extreme_point_of T\<rbrakk> \<Longrightarrow> x extreme_point_of (S \<inter> T)"
   946 by (simp add: extreme_point_of_def)
   948 lemma extreme_point_of_Int_supporting_hyperplane_le:
   949    "\<lbrakk>S \<inter> {x. a \<bullet> x = b} = {c}; \<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<le> b\<rbrakk> \<Longrightarrow> c extreme_point_of S"
   950 apply (simp add: face_of_singleton [symmetric])
   951 by (metis face_of_Int_supporting_hyperplane_le_strong convex_singleton)
   953 lemma extreme_point_of_Int_supporting_hyperplane_ge:
   954    "\<lbrakk>S \<inter> {x. a \<bullet> x = b} = {c}; \<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<ge> b\<rbrakk> \<Longrightarrow> c extreme_point_of S"
   955 apply (simp add: face_of_singleton [symmetric])
   956 by (metis face_of_Int_supporting_hyperplane_ge_strong convex_singleton)
   958 lemma exposed_point_of_Int_supporting_hyperplane_le:
   959    "\<lbrakk>S \<inter> {x. a \<bullet> x = b} = {c}; \<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<le> b\<rbrakk> \<Longrightarrow> {c} exposed_face_of S"
   960 apply (simp add: exposed_face_of_def face_of_singleton)
   961 apply (force simp: extreme_point_of_Int_supporting_hyperplane_le)
   962 done
   964 lemma exposed_point_of_Int_supporting_hyperplane_ge:
   965     "\<lbrakk>S \<inter> {x. a \<bullet> x = b} = {c}; \<And>x. x \<in> S \<Longrightarrow> a \<bullet> x \<ge> b\<rbrakk> \<Longrightarrow> {c} exposed_face_of S"
   966 using exposed_point_of_Int_supporting_hyperplane_le [of S "-a" "-b" c]
   967 by simp
   969 lemma extreme_point_of_convex_hull_insert:
   970    "\<lbrakk>finite S; a \<notin> convex hull S\<rbrakk> \<Longrightarrow> a extreme_point_of (convex hull (insert a S))"
   971 apply (case_tac "a \<in> S")
   972 apply (simp add: hull_inc)
   973 using face_of_convex_hulls [of "insert a S" "{a}"]
   974 apply (auto simp: face_of_singleton hull_same)
   975 done
   977 subsection\<open>Facets\<close>
   979 definition%important facet_of :: "['a::euclidean_space set, 'a set] \<Rightarrow> bool"
   980                     (infixr "(facet'_of)" 50)
   981   where "F facet_of S \<longleftrightarrow> F face_of S \<and> F \<noteq> {} \<and> aff_dim F = aff_dim S - 1"
   983 lemma facet_of_empty [simp]: "\<not> S facet_of {}"
   984   by (simp add: facet_of_def)
   986 lemma facet_of_irrefl [simp]: "\<not> S facet_of S "
   987   by (simp add: facet_of_def)
   989 lemma facet_of_imp_face_of: "F facet_of S \<Longrightarrow> F face_of S"
   990   by (simp add: facet_of_def)
   992 lemma facet_of_imp_subset: "F facet_of S \<Longrightarrow> F \<subseteq> S"
   993   by (simp add: face_of_imp_subset facet_of_def)
   995 lemma hyperplane_facet_of_halfspace_le:
   996    "a \<noteq> 0 \<Longrightarrow> {x. a \<bullet> x = b} facet_of {x. a \<bullet> x \<le> b}"
   997 unfolding facet_of_def hyperplane_eq_empty
   998 by (auto simp: hyperplane_face_of_halfspace_ge hyperplane_face_of_halfspace_le
   999            DIM_positive Suc_leI of_nat_diff aff_dim_halfspace_le)
  1001 lemma hyperplane_facet_of_halfspace_ge:
  1002     "a \<noteq> 0 \<Longrightarrow> {x. a \<bullet> x = b} facet_of {x. a \<bullet> x \<ge> b}"
  1003 unfolding facet_of_def hyperplane_eq_empty
  1004 by (auto simp: hyperplane_face_of_halfspace_le hyperplane_face_of_halfspace_ge
  1005            DIM_positive Suc_leI of_nat_diff aff_dim_halfspace_ge)
  1007 lemma facet_of_halfspace_le:
  1008     "F facet_of {x. a \<bullet> x \<le> b} \<longleftrightarrow> a \<noteq> 0 \<and> F = {x. a \<bullet> x = b}"
  1009     (is "?lhs = ?rhs")
  1010 proof
  1011   assume c: ?lhs
  1012   with c facet_of_irrefl show ?rhs
  1013     by (force simp: aff_dim_halfspace_le facet_of_def face_of_halfspace_le cong: conj_cong split: if_split_asm)
  1014 next
  1015   assume ?rhs then show ?lhs
  1016     by (simp add: hyperplane_facet_of_halfspace_le)
  1017 qed
  1019 lemma facet_of_halfspace_ge:
  1020     "F facet_of {x. a \<bullet> x \<ge> b} \<longleftrightarrow> a \<noteq> 0 \<and> F = {x. a \<bullet> x = b}"
  1021 using facet_of_halfspace_le [of F "-a" "-b"] by simp
  1023 subsection \<open>Edges: faces of affine dimension 1\<close> (*FIXME too small subsection, rearrange? *)
  1025 definition%important edge_of :: "['a::euclidean_space set, 'a set] \<Rightarrow> bool"  (infixr "(edge'_of)" 50)
  1026   where "e edge_of S \<longleftrightarrow> e face_of S \<and> aff_dim e = 1"
  1028 lemma edge_of_imp_subset:
  1029    "S edge_of T \<Longrightarrow> S \<subseteq> T"
  1030 by (simp add: edge_of_def face_of_imp_subset)
  1032 subsection\<open>Existence of extreme points\<close>
  1034 proposition different_norm_3_collinear_points:
  1035   fixes a :: "'a::euclidean_space"
  1036   assumes "x \<in> open_segment a b" "norm(a) = norm(b)" "norm(x) = norm(b)"
  1037   shows False
  1038 proof -
  1039   obtain u where "norm ((1 - u) *\<^sub>R a + u *\<^sub>R b) = norm b"
  1040              and "a \<noteq> b"
  1041              and u01: "0 < u" "u < 1"
  1042     using assms by (auto simp: open_segment_image_interval if_splits)
  1043   then have "(1 - u) *\<^sub>R a \<bullet> (1 - u) *\<^sub>R a + ((1 - u) * 2) *\<^sub>R a \<bullet> u *\<^sub>R b =
  1044              (1 - u * u) *\<^sub>R (a \<bullet> a)"
  1045     using assms by (simp add: norm_eq algebra_simps inner_commute)
  1046   then have "(1 - u) *\<^sub>R ((1 - u) *\<^sub>R a \<bullet> a + (2 * u) *\<^sub>R  a \<bullet> b) =
  1047              (1 - u) *\<^sub>R ((1 + u) *\<^sub>R (a \<bullet> a))"
  1048     by (simp add: algebra_simps)
  1049   then have "(1 - u) *\<^sub>R (a \<bullet> a) + (2 * u) *\<^sub>R (a \<bullet> b) = (1 + u) *\<^sub>R (a \<bullet> a)"
  1050     using u01 by auto
  1051   then have "a \<bullet> b = a \<bullet> a"
  1052     using u01 by (simp add: algebra_simps)
  1053   then have "a = b"
  1054     using \<open>norm(a) = norm(b)\<close> norm_eq vector_eq by fastforce
  1055   then show ?thesis
  1056     using \<open>a \<noteq> b\<close> by force
  1057 qed
  1059 proposition extreme_point_exists_convex:
  1060   fixes S :: "'a::euclidean_space set"
  1061   assumes "compact S" "convex S" "S \<noteq> {}"
  1062   obtains x where "x extreme_point_of S"
  1063 proof -
  1064   obtain x where "x \<in> S" and xsup: "\<And>y. y \<in> S \<Longrightarrow> norm y \<le> norm x"
  1065     using distance_attains_sup [of S 0] assms by auto
  1066   have False if "a \<in> S" "b \<in> S" and x: "x \<in> open_segment a b" for a b
  1067   proof -
  1068     have noax: "norm a \<le> norm x" and nobx: "norm b \<le> norm x" using xsup that by auto
  1069     have "a \<noteq> b"
  1070       using empty_iff open_segment_idem x by auto
  1071     have *: "(1 - u) * na + u * nb < norm x" if "na < norm x"  "nb \<le> norm x" "0 < u" "u < 1" for na nb u
  1072     proof -
  1073       have "(1 - u) * na + u * nb < (1 - u) * norm x + u * nb"
  1074         by (simp add: that)
  1075       also have "... \<le> (1 - u) * norm x + u * norm x"
  1076         by (simp add: that)
  1077       finally have "(1 - u) * na + u * nb < (1 - u) * norm x + u * norm x" .
  1078       then show ?thesis
  1079       using scaleR_collapse [symmetric, of "norm x" u] by auto
  1080     qed
  1081     have "norm x < norm x" if "norm a < norm x"
  1082       using x
  1083       apply (clarsimp simp only: open_segment_image_interval \<open>a \<noteq> b\<close> if_False)
  1084       apply (rule norm_triangle_lt)
  1085       apply (simp add: norm_mult)
  1086       using * [of "norm a" "norm b"] nobx that
  1087         apply blast
  1088       done
  1089     moreover have "norm x < norm x" if "norm b < norm x"
  1090       using x
  1091       apply (clarsimp simp only: open_segment_image_interval \<open>a \<noteq> b\<close> if_False)
  1092       apply (rule norm_triangle_lt)
  1093       apply (simp add: norm_mult)
  1094       using * [of "norm b" "norm a" "1-u" for u] noax that
  1095         apply (simp add: add.commute)
  1096       done
  1097     ultimately have "\<not> (norm a < norm x) \<and> \<not> (norm b < norm x)"
  1098       by auto
  1099     then show ?thesis
  1100       using different_norm_3_collinear_points noax nobx that(3) by fastforce
  1101   qed
  1102   then show ?thesis
  1103     apply (rule_tac x=x in that)
  1104     apply (force simp: extreme_point_of_def \<open>x \<in> S\<close>)
  1105     done
  1106 qed
  1108 subsection\<open>Krein-Milman, the weaker form\<close>
  1110 proposition Krein_Milman:
  1111   fixes S :: "'a::euclidean_space set"
  1112   assumes "compact S" "convex S"
  1113     shows "S = closure(convex hull {x. x extreme_point_of S})"
  1114 proof (cases "S = {}")
  1115   case True then show ?thesis   by simp
  1116 next
  1117   case False
  1118   have "closed S"
  1119     by (simp add: \<open>compact S\<close> compact_imp_closed)
  1120   have "closure (convex hull {x. x extreme_point_of S}) \<subseteq> S"
  1121     apply (rule closure_minimal [OF hull_minimal \<open>closed S\<close>])
  1122     using assms
  1123     apply (auto simp: extreme_point_of_def)
  1124     done
  1125   moreover have "u \<in> closure (convex hull {x. x extreme_point_of S})"
  1126                 if "u \<in> S" for u
  1127   proof (rule ccontr)
  1128     assume unot: "u \<notin> closure(convex hull {x. x extreme_point_of S})"
  1129     then obtain a b where "a \<bullet> u < b"
  1130           and ab: "\<And>x. x \<in> closure(convex hull {x. x extreme_point_of S}) \<Longrightarrow> b < a \<bullet> x"
  1131       using separating_hyperplane_closed_point [of "closure(convex hull {x. x extreme_point_of S})"]
  1132       by blast
  1133     have "continuous_on S ((\<bullet>) a)"
  1134       by (rule continuous_intros)+
  1135     then obtain m where "m \<in> S" and m: "\<And>y. y \<in> S \<Longrightarrow> a \<bullet> m \<le> a \<bullet> y"
  1136       using continuous_attains_inf [of S "\<lambda>x. a \<bullet> x"] \<open>compact S\<close> \<open>u \<in> S\<close>
  1137       by auto
  1138     define T where "T = S \<inter> {x. a \<bullet> x = a \<bullet> m}"
  1139     have "m \<in> T"
  1140       by (simp add: T_def \<open>m \<in> S\<close>)
  1141     moreover have "compact T"
  1142       by (simp add: T_def compact_Int_closed [OF \<open>compact S\<close> closed_hyperplane])
  1143     moreover have "convex T"
  1144       by (simp add: T_def convex_Int [OF \<open>convex S\<close> convex_hyperplane])
  1145     ultimately obtain v where v: "v extreme_point_of T"
  1146       using extreme_point_exists_convex [of T] by auto
  1147     then have "{v} face_of T"
  1148       by (simp add: face_of_singleton)
  1149     also have "T face_of S"
  1150       by (simp add: T_def m face_of_Int_supporting_hyperplane_ge [OF \<open>convex S\<close>])
  1151     finally have "v extreme_point_of S"
  1152       by (simp add: face_of_singleton)
  1153     then have "b < a \<bullet> v"
  1154       using closure_subset by (simp add: closure_hull hull_inc ab)
  1155     then show False
  1156       using \<open>a \<bullet> u < b\<close> \<open>{v} face_of T\<close> face_of_imp_subset m T_def that by fastforce
  1157   qed
  1158   ultimately show ?thesis
  1159     by blast
  1160 qed
  1162 text\<open>Now the sharper form.\<close>
  1164 lemma Krein_Milman_Minkowski_aux:
  1165   fixes S :: "'a::euclidean_space set"
  1166   assumes n: "dim S = n" and S: "compact S" "convex S" "0 \<in> S"
  1167     shows "0 \<in> convex hull {x. x extreme_point_of S}"
  1168 using n S
  1169 proof (induction n arbitrary: S rule: less_induct)
  1170   case (less n S) show ?case
  1171   proof (cases "0 \<in> rel_interior S")
  1172     case True with Krein_Milman show ?thesis
  1173       by (metis subsetD convex_convex_hull convex_rel_interior_closure less.prems(2) less.prems(3) rel_interior_subset)
  1174   next
  1175     case False
  1176     have "rel_interior S \<noteq> {}"
  1177       by (simp add: rel_interior_convex_nonempty_aux less)
  1178     then obtain c where c: "c \<in> rel_interior S" by blast
  1179     obtain a where "a \<noteq> 0"
  1180               and le_ay: "\<And>y. y \<in> S \<Longrightarrow> a \<bullet> 0 \<le> a \<bullet> y"
  1181               and less_ay: "\<And>y. y \<in> rel_interior S \<Longrightarrow> a \<bullet> 0 < a \<bullet> y"
  1182       by (blast intro: supporting_hyperplane_rel_boundary intro!: less False)
  1183     have face: "S \<inter> {x. a \<bullet> x = 0} face_of S"
  1184       apply (rule face_of_Int_supporting_hyperplane_ge [OF \<open>convex S\<close>])
  1185       using le_ay by auto
  1186     then have co: "compact (S \<inter> {x. a \<bullet> x = 0})" "convex (S \<inter> {x. a \<bullet> x = 0})"
  1187       using less.prems by (blast intro: face_of_imp_compact face_of_imp_convex)+
  1188     have "a \<bullet> y = 0" if "y \<in> span (S \<inter> {x. a \<bullet> x = 0})" for y
  1189     proof -
  1190       have "y \<in> span {x. a \<bullet> x = 0}"
  1191         by (metis inf.cobounded2 span_mono subsetCE that)
  1192       then show ?thesis
  1193         by (blast intro: span_induct [OF _ subspace_hyperplane])
  1194     qed
  1195     then have "dim (S \<inter> {x. a \<bullet> x = 0}) < n"
  1196       by (metis (no_types) less_ay c subsetD dim_eq_span inf.strict_order_iff
  1197            inf_le1 \<open>dim S = n\<close> not_le rel_interior_subset span_0 span_base)
  1198     then have "0 \<in> convex hull {x. x extreme_point_of (S \<inter> {x. a \<bullet> x = 0})}"
  1199       by (rule less.IH) (auto simp: co less.prems)
  1200     then show ?thesis
  1201       by (metis (mono_tags, lifting) Collect_mono_iff \<open>S \<inter> {x. a \<bullet> x = 0} face_of S\<close> extreme_point_of_face hull_mono subset_iff)
  1202   qed
  1203 qed
  1206 theorem Krein_Milman_Minkowski:
  1207   fixes S :: "'a::euclidean_space set"
  1208   assumes "compact S" "convex S"
  1209     shows "S = convex hull {x. x extreme_point_of S}"
  1210 proof
  1211   show "S \<subseteq> convex hull {x. x extreme_point_of S}"
  1212   proof
  1213     fix a assume [simp]: "a \<in> S"
  1214     have 1: "compact ((+) (- a) ` S)"
  1215       by (simp add: \<open>compact S\<close> compact_translation_subtract cong: image_cong_simp)
  1216     have 2: "convex ((+) (- a) ` S)"
  1217       by (simp add: \<open>convex S\<close> compact_translation_subtract)
  1218     show a_invex: "a \<in> convex hull {x. x extreme_point_of S}"
  1219       using Krein_Milman_Minkowski_aux [OF refl 1 2]
  1220             convex_hull_translation [of "-a"]
  1221       by (auto simp: extreme_points_of_translation_subtract translation_assoc cong: image_cong_simp)
  1222     qed
  1223 next
  1224   show "convex hull {x. x extreme_point_of S} \<subseteq> S"
  1225   proof -
  1226     have "{a. a extreme_point_of S} \<subseteq> S"
  1227       using extreme_point_of_def by blast
  1228     then show ?thesis
  1229       by (simp add: \<open>convex S\<close> hull_minimal)
  1230   qed
  1231 qed
  1234 subsection\<open>Applying it to convex hulls of explicitly indicated finite sets\<close>
  1236 corollary Krein_Milman_polytope:
  1237   fixes S :: "'a::euclidean_space set"
  1238   shows
  1239    "finite S
  1240        \<Longrightarrow> convex hull S =
  1241            convex hull {x. x extreme_point_of (convex hull S)}"
  1242   by (simp add: Krein_Milman_Minkowski finite_imp_compact_convex_hull)
  1244 lemma extreme_points_of_convex_hull_eq:
  1245   fixes S :: "'a::euclidean_space set"
  1246   shows
  1247    "\<lbrakk>compact S; \<And>T. T \<subset> S \<Longrightarrow> convex hull T \<noteq> convex hull S\<rbrakk>
  1248         \<Longrightarrow> {x. x extreme_point_of (convex hull S)} = S"
  1249 by (metis (full_types) Krein_Milman_Minkowski compact_convex_hull convex_convex_hull extreme_points_of_convex_hull psubsetI)
  1252 lemma extreme_point_of_convex_hull_eq:
  1253   fixes S :: "'a::euclidean_space set"
  1254   shows
  1255    "\<lbrakk>compact S; \<And>T. T \<subset> S \<Longrightarrow> convex hull T \<noteq> convex hull S\<rbrakk>
  1256     \<Longrightarrow> (x extreme_point_of (convex hull S) \<longleftrightarrow> x \<in> S)"
  1257 using extreme_points_of_convex_hull_eq by auto
  1259 lemma extreme_point_of_convex_hull_convex_independent:
  1260   fixes S :: "'a::euclidean_space set"
  1261   assumes "compact S" and S: "\<And>a. a \<in> S \<Longrightarrow> a \<notin> convex hull (S - {a})"
  1262   shows "(x extreme_point_of (convex hull S) \<longleftrightarrow> x \<in> S)"
  1263 proof -
  1264   have "convex hull T \<noteq> convex hull S" if "T \<subset> S" for T
  1265   proof -
  1266     obtain a where  "T \<subseteq> S" "a \<in> S" "a \<notin> T" using \<open>T \<subset> S\<close> by blast
  1267     then show ?thesis
  1268       by (metis (full_types) Diff_eq_empty_iff Diff_insert0 S hull_mono hull_subset insert_Diff_single subsetCE)
  1269   qed
  1270   then show ?thesis
  1271     by (rule extreme_point_of_convex_hull_eq [OF \<open>compact S\<close>])
  1272 qed
  1274 lemma extreme_point_of_convex_hull_affine_independent:
  1275   fixes S :: "'a::euclidean_space set"
  1276   shows
  1277    "\<not> affine_dependent S
  1278          \<Longrightarrow> (x extreme_point_of (convex hull S) \<longleftrightarrow> x \<in> S)"
  1279 by (metis aff_independent_finite affine_dependent_def affine_hull_convex_hull extreme_point_of_convex_hull_convex_independent finite_imp_compact hull_inc)
  1281 text\<open>Elementary proofs exist, not requiring Euclidean spaces and all this development\<close>
  1282 lemma extreme_point_of_convex_hull_2:
  1283   fixes x :: "'a::euclidean_space"
  1284   shows "x extreme_point_of (convex hull {a,b}) \<longleftrightarrow> x = a \<or> x = b"
  1285 proof -
  1286   have "x extreme_point_of (convex hull {a,b}) \<longleftrightarrow> x \<in> {a,b}"
  1287     by (intro extreme_point_of_convex_hull_affine_independent affine_independent_2)
  1288   then show ?thesis
  1289     by simp
  1290 qed
  1292 lemma extreme_point_of_segment:
  1293   fixes x :: "'a::euclidean_space"
  1294   shows
  1295    "x extreme_point_of closed_segment a b \<longleftrightarrow> x = a \<or> x = b"
  1296 by (simp add: extreme_point_of_convex_hull_2 segment_convex_hull)
  1298 lemma face_of_convex_hull_subset:
  1299   fixes S :: "'a::euclidean_space set"
  1300   assumes "compact S" and T: "T face_of (convex hull S)"
  1301   obtains s' where "s' \<subseteq> S" "T = convex hull s'"
  1302 apply (rule_tac s' = "{x. x extreme_point_of T}" in that)
  1303 using T extreme_point_of_convex_hull extreme_point_of_face apply blast
  1304 by (metis (no_types) Krein_Milman_Minkowski assms compact_convex_hull convex_convex_hull face_of_imp_compact face_of_imp_convex)
  1307 lemma face_of_convex_hull_aux:
  1308   assumes eq: "x *\<^sub>R p = u *\<^sub>R a + v *\<^sub>R b + w *\<^sub>R c"
  1309     and x: "u + v + w = x" "x \<noteq> 0" and S: "affine S" "a \<in> S" "b \<in> S" "c \<in> S"
  1310   shows "p \<in> S"
  1311 proof -
  1312   have "p = (u *\<^sub>R a + v *\<^sub>R b + w *\<^sub>R c) /\<^sub>R x"
  1313     by (metis \<open>x \<noteq> 0\<close> eq mult.commute right_inverse scaleR_one scaleR_scaleR)
  1314   moreover have "affine hull {a,b,c} \<subseteq> S"
  1315     by (simp add: S hull_minimal)
  1316   moreover have "(u *\<^sub>R a + v *\<^sub>R b + w *\<^sub>R c) /\<^sub>R x \<in> affine hull {a,b,c}"
  1317     apply (simp add: affine_hull_3)
  1318     apply (rule_tac x="u/x" in exI)
  1319     apply (rule_tac x="v/x" in exI)
  1320     apply (rule_tac x="w/x" in exI)
  1321     using x apply (auto simp: algebra_simps divide_simps)
  1322     done
  1323   ultimately show ?thesis by force
  1324 qed
  1326 proposition face_of_convex_hull_insert_eq:
  1327   fixes a :: "'a :: euclidean_space"
  1328   assumes "finite S" and a: "a \<notin> affine hull S"
  1329   shows "(F face_of (convex hull (insert a S)) \<longleftrightarrow>
  1330           F face_of (convex hull S) \<or>
  1331           (\<exists>F'. F' face_of (convex hull S) \<and> F = convex hull (insert a F')))"
  1332          (is "F face_of ?CAS \<longleftrightarrow> _")
  1333 proof safe
  1334   assume F: "F face_of ?CAS"
  1335     and *: "\<nexists>F'. F' face_of convex hull S \<and> F = convex hull insert a F'"
  1336   obtain T where T: "T \<subseteq> insert a S" and FeqT: "F = convex hull T"
  1337     by (metis F \<open>finite S\<close> compact_insert finite_imp_compact face_of_convex_hull_subset)
  1338   show "F face_of convex hull S"
  1339   proof (cases "a \<in> T")
  1340     case True
  1341     have "F = convex hull insert a (convex hull T \<inter> convex hull S)"
  1342     proof
  1343       have "T \<subseteq> insert a (convex hull T \<inter> convex hull S)"
  1344         using T hull_subset by fastforce
  1345       then show "F \<subseteq> convex hull insert a (convex hull T \<inter> convex hull S)"
  1346         by (simp add: FeqT hull_mono)
  1347       show "convex hull insert a (convex hull T \<inter> convex hull S) \<subseteq> F"
  1348         apply (rule hull_minimal)
  1349         using True by (auto simp: \<open>F = convex hull T\<close> hull_inc)
  1350     qed
  1351     moreover have "convex hull T \<inter> convex hull S face_of convex hull S"
  1352       by (metis F FeqT convex_convex_hull face_of_slice hull_mono inf.absorb_iff2 subset_insertI)
  1353     ultimately show ?thesis
  1354       using * by force
  1355   next
  1356     case False
  1357     then show ?thesis
  1358       by (metis FeqT F T face_of_subset hull_mono subset_insert subset_insertI)
  1359   qed
  1360 next
  1361   assume "F face_of convex hull S"
  1362   show "F face_of ?CAS"
  1363     by (simp add: \<open>F face_of convex hull S\<close> a face_of_convex_hull_insert \<open>finite S\<close>)
  1364 next
  1365   fix F
  1366   assume F: "F face_of convex hull S"
  1367   show "convex hull insert a F face_of ?CAS"
  1368   proof (cases "S = {}")
  1369     case True
  1370     then show ?thesis
  1371       using F face_of_affine_eq by auto
  1372   next
  1373     case False
  1374     have anotc: "a \<notin> convex hull S"
  1375       by (metis (no_types) a affine_hull_convex_hull hull_inc)
  1376     show ?thesis
  1377     proof (cases "F = {}")
  1378       case True show ?thesis
  1379         using anotc by (simp add: \<open>F = {}\<close> \<open>finite S\<close> extreme_point_of_convex_hull_insert face_of_singleton)
  1380     next
  1381       case False
  1382       have "convex hull insert a F \<subseteq> ?CAS"
  1383         by (simp add: F a \<open>finite S\<close> convex_hull_subset face_of_convex_hull_insert face_of_imp_subset hull_inc)
  1384       moreover
  1385       have "(\<exists>y v. (1 - ub) *\<^sub>R a + ub *\<^sub>R b = (1 - v) *\<^sub>R a + v *\<^sub>R y \<and>
  1386                    0 \<le> v \<and> v \<le> 1 \<and> y \<in> F) \<and>
  1387             (\<exists>x u. (1 - uc) *\<^sub>R a + uc *\<^sub>R c = (1 - u) *\<^sub>R a + u *\<^sub>R x \<and>
  1388                    0 \<le> u \<and> u \<le> 1 \<and> x \<in> F)"
  1389         if *: "(1 - ux) *\<^sub>R a + ux *\<^sub>R x
  1390                \<in> open_segment ((1 - ub) *\<^sub>R a + ub *\<^sub>R b) ((1 - uc) *\<^sub>R a + uc *\<^sub>R c)"
  1391           and "0 \<le> ub" "ub \<le> 1" "0 \<le> uc" "uc \<le> 1" "0 \<le> ux" "ux \<le> 1"
  1392           and b: "b \<in> convex hull S" and c: "c \<in> convex hull S" and "x \<in> F"
  1393         for b c ub uc ux x
  1394       proof -
  1395         obtain v where ne: "(1 - ub) *\<^sub>R a + ub *\<^sub>R b \<noteq> (1 - uc) *\<^sub>R a + uc *\<^sub>R c"
  1396           and eq: "(1 - ux) *\<^sub>R a + ux *\<^sub>R x =
  1397                     (1 - v) *\<^sub>R ((1 - ub) *\<^sub>R a + ub *\<^sub>R b) + v *\<^sub>R ((1 - uc) *\<^sub>R a + uc *\<^sub>R c)"
  1398           and "0 < v" "v < 1"
  1399           using * by (auto simp: in_segment)
  1400         then have 0: "((1 - ux) - ((1 - v) * (1 - ub) + v * (1 - uc))) *\<^sub>R a +
  1401                       (ux *\<^sub>R x - (((1 - v) * ub) *\<^sub>R b + (v * uc) *\<^sub>R c)) = 0"
  1402           by (auto simp: algebra_simps)
  1403         then have "((1 - ux) - ((1 - v) * (1 - ub) + v * (1 - uc))) *\<^sub>R a =
  1404                    ((1 - v) * ub) *\<^sub>R b + (v * uc) *\<^sub>R c + (-ux) *\<^sub>R x"
  1405           by (auto simp: algebra_simps)
  1406         then have "a \<in> affine hull S" if "1 - ux - ((1 - v) * (1 - ub) + v * (1 - uc)) \<noteq> 0"
  1407           apply (rule face_of_convex_hull_aux)
  1408           using b c that apply (auto simp: algebra_simps)
  1409           using F convex_hull_subset_affine_hull face_of_imp_subset \<open>x \<in> F\<close> apply blast+
  1410           done
  1411         then have "1 - ux - ((1 - v) * (1 - ub) + v * (1 - uc)) = 0"
  1412           using a by blast
  1413         with 0 have equx: "(1 - v) * ub + v * uc = ux"
  1414           and uxx: "ux *\<^sub>R x = (((1 - v) * ub) *\<^sub>R b + (v * uc) *\<^sub>R c)"
  1415           by auto (auto simp: algebra_simps)
  1416         show ?thesis
  1417         proof (cases "uc = 0")
  1418           case True
  1419           then show ?thesis
  1420             using equx 0 \<open>0 \<le> ub\<close> \<open>ub \<le> 1\<close> \<open>v < 1\<close> \<open>x \<in> F\<close>
  1421             apply (auto simp: algebra_simps)
  1422              apply (rule_tac x=x in exI, simp)
  1423              apply (rule_tac x=ub in exI, auto)
  1424              apply (metis add.left_neutral diff_eq_eq less_irrefl mult.commute mult_cancel_right1 real_vector.scale_cancel_left real_vector.scale_left_diff_distrib)
  1425             using \<open>x \<in> F\<close> \<open>uc \<le> 1\<close> apply blast
  1426             done
  1427         next
  1428           case False
  1429           show ?thesis
  1430           proof (cases "ub = 0")
  1431             case True
  1432             then show ?thesis
  1433               using equx 0 \<open>0 \<le> uc\<close> \<open>uc \<le> 1\<close> \<open>0 < v\<close> \<open>x \<in> F\<close> \<open>uc \<noteq> 0\<close> by (force simp: algebra_simps)
  1434           next
  1435             case False
  1436             then have "0 < ub" "0 < uc"
  1437               using \<open>uc \<noteq> 0\<close> \<open>0 \<le> ub\<close> \<open>0 \<le> uc\<close> by auto
  1438             then have "ux \<noteq> 0"
  1439               by (metis \<open>0 < v\<close> \<open>v < 1\<close> diff_ge_0_iff_ge dual_order.strict_implies_order equx leD le_add_same_cancel2 zero_le_mult_iff zero_less_mult_iff)
  1440             have "b \<in> F \<and> c \<in> F"
  1441             proof (cases "b = c")
  1442               case True
  1443               then show ?thesis
  1444                 by (metis \<open>ux \<noteq> 0\<close> equx real_vector.scale_cancel_left scaleR_add_left uxx \<open>x \<in> F\<close>)
  1445             next
  1446               case False
  1447               have "x = (((1 - v) * ub) *\<^sub>R b + (v * uc) *\<^sub>R c) /\<^sub>R ux"
  1448                 by (metis \<open>ux \<noteq> 0\<close> uxx mult.commute right_inverse scaleR_one scaleR_scaleR)
  1449               also have "... = (1 - v * uc / ux) *\<^sub>R b + (v * uc / ux) *\<^sub>R c"
  1450                 using \<open>ux \<noteq> 0\<close> equx apply (auto simp: algebra_simps divide_simps)
  1451                 by (metis add.commute add_diff_eq add_divide_distrib diff_add_cancel scaleR_add_left)
  1452               finally have "x = (1 - v * uc / ux) *\<^sub>R b + (v * uc / ux) *\<^sub>R c" .
  1453               then have "x \<in> open_segment b c"
  1454                 apply (simp add: in_segment \<open>b \<noteq> c\<close>)
  1455                 apply (rule_tac x="(v * uc) / ux" in exI)
  1456                 using \<open>0 \<le> ux\<close> \<open>ux \<noteq> 0\<close> \<open>0 < uc\<close> \<open>0 < v\<close> \<open>0 < ub\<close> \<open>v < 1\<close> equx
  1457                 apply (force simp: algebra_simps divide_simps)
  1458                 done
  1459               then show ?thesis
  1460                 by (rule face_ofD [OF F _ b c \<open>x \<in> F\<close>])
  1461             qed
  1462             with \<open>0 \<le> ub\<close> \<open>ub \<le> 1\<close> \<open>0 \<le> uc\<close> \<open>uc \<le> 1\<close> show ?thesis by blast
  1463           qed
  1464         qed
  1465       qed
  1466       moreover have "convex hull F = F"
  1467         by (meson F convex_hull_eq face_of_imp_convex)
  1468       ultimately show ?thesis
  1469         unfolding face_of_def by (fastforce simp: convex_hull_insert_alt \<open>S \<noteq> {}\<close> \<open>F \<noteq> {}\<close>)
  1470     qed
  1471   qed
  1472 qed
  1474 lemma face_of_convex_hull_insert2:
  1475   fixes a :: "'a :: euclidean_space"
  1476   assumes S: "finite S" and a: "a \<notin> affine hull S" and F: "F face_of convex hull S"
  1477   shows "convex hull (insert a F) face_of convex hull (insert a S)"
  1478   by (metis F face_of_convex_hull_insert_eq [OF S a])
  1480 proposition face_of_convex_hull_affine_independent:
  1481   fixes S :: "'a::euclidean_space set"
  1482   assumes "\<not> affine_dependent S"
  1483     shows "(T face_of (convex hull S) \<longleftrightarrow> (\<exists>c. c \<subseteq> S \<and> T = convex hull c))"
  1484           (is "?lhs = ?rhs")
  1485 proof
  1486   assume ?lhs
  1487   then show ?rhs
  1488     by (meson \<open>T face_of convex hull S\<close> aff_independent_finite assms face_of_convex_hull_subset finite_imp_compact)
  1489 next
  1490   assume ?rhs
  1491   then obtain c where "c \<subseteq> S" and T: "T = convex hull c"
  1492     by blast
  1493   have "affine hull c \<inter> affine hull (S - c) = {}"
  1494     apply (rule disjoint_affine_hull [OF assms \<open>c \<subseteq> S\<close>], auto)
  1495     done
  1496   then have "affine hull c \<inter> convex hull (S - c) = {}"
  1497     using convex_hull_subset_affine_hull by fastforce
  1498   then show ?lhs
  1499     by (metis face_of_convex_hulls \<open>c \<subseteq> S\<close> aff_independent_finite assms T)
  1500 qed
  1502 lemma facet_of_convex_hull_affine_independent:
  1503   fixes S :: "'a::euclidean_space set"
  1504   assumes "\<not> affine_dependent S"
  1505     shows "T facet_of (convex hull S) \<longleftrightarrow>
  1506            T \<noteq> {} \<and> (\<exists>u. u \<in> S \<and> T = convex hull (S - {u}))"
  1507           (is "?lhs = ?rhs")
  1508 proof
  1509   assume ?lhs
  1510   then have "T face_of (convex hull S)" "T \<noteq> {}"
  1511         and afft: "aff_dim T = aff_dim (convex hull S) - 1"
  1512     by (auto simp: facet_of_def)
  1513   then obtain c where "c \<subseteq> S" and c: "T = convex hull c"
  1514     by (auto simp: face_of_convex_hull_affine_independent [OF assms])
  1515   then have affs: "aff_dim S = aff_dim c + 1"
  1516     by (metis aff_dim_convex_hull afft eq_diff_eq)
  1517   have "\<not> affine_dependent c"
  1518     using \<open>c \<subseteq> S\<close> affine_dependent_subset assms by blast
  1519   with affs have "card (S - c) = 1"
  1520     apply (simp add: aff_dim_affine_independent [symmetric] aff_dim_convex_hull)
  1521     by (metis aff_dim_affine_independent aff_independent_finite One_nat_def \<open>c \<subseteq> S\<close> add.commute
  1522                 add_diff_cancel_right' assms card_Diff_subset card_mono of_nat_1 of_nat_diff of_nat_eq_iff)
  1523   then obtain u where u: "u \<in> S - c"
  1524     by (metis DiffI \<open>c \<subseteq> S\<close> aff_independent_finite assms cancel_comm_monoid_add_class.diff_cancel
  1525                 card_Diff_subset subsetI subset_antisym zero_neq_one)
  1526   then have u: "S = insert u c"
  1527     by (metis Diff_subset \<open>c \<subseteq> S\<close> \<open>card (S - c) = 1\<close> card_1_singletonE double_diff insert_Diff insert_subset singletonD)
  1528   have "T = convex hull (c - {u})"
  1529     by (metis Diff_empty Diff_insert0 \<open>T facet_of convex hull S\<close> c facet_of_irrefl insert_absorb u)
  1530   with \<open>T \<noteq> {}\<close> show ?rhs
  1531     using c u by auto
  1532 next
  1533   assume ?rhs
  1534   then obtain u where "T \<noteq> {}" "u \<in> S" and u: "T = convex hull (S - {u})"
  1535     by (force simp: facet_of_def)
  1536   then have "\<not> S \<subseteq> {u}"
  1537     using \<open>T \<noteq> {}\<close> u by auto
  1538   have [simp]: "aff_dim (convex hull (S - {u})) = aff_dim (convex hull S) - 1"
  1539     using assms \<open>u \<in> S\<close>
  1540     apply (simp add: aff_dim_convex_hull affine_dependent_def)
  1541     apply (drule bspec, assumption)
  1542     by (metis add_diff_cancel_right' aff_dim_insert insert_Diff [of u S])
  1543   show ?lhs
  1544     apply (subst u)
  1545     apply (simp add: \<open>\<not> S \<subseteq> {u}\<close> facet_of_def face_of_convex_hull_affine_independent [OF assms], blast)
  1546     done
  1547 qed
  1549 lemma facet_of_convex_hull_affine_independent_alt:
  1550   fixes S :: "'a::euclidean_space set"
  1551   shows
  1552    "\<not>affine_dependent S
  1553         \<Longrightarrow> (T facet_of (convex hull S) \<longleftrightarrow>
  1554              2 \<le> card S \<and> (\<exists>u. u \<in> S \<and> T = convex hull (S - {u})))"
  1555 apply (simp add: facet_of_convex_hull_affine_independent)
  1556 apply (auto simp: Set.subset_singleton_iff)
  1557 apply (metis Diff_cancel Int_empty_right Int_insert_right_if1  aff_independent_finite card_eq_0_iff card_insert_if card_mono card_subset_eq convex_hull_eq_empty eq_iff equals0D finite_insert finite_subset inf.absorb_iff2 insert_absorb insert_not_empty  not_less_eq_eq numeral_2_eq_2)
  1558 done
  1560 lemma segment_face_of:
  1561   assumes "(closed_segment a b) face_of S"
  1562   shows "a extreme_point_of S" "b extreme_point_of S"
  1563 proof -
  1564   have as: "{a} face_of S"
  1565     by (metis (no_types) assms convex_hull_singleton empty_iff extreme_point_of_convex_hull_insert face_of_face face_of_singleton finite.emptyI finite.insertI insert_absorb insert_iff segment_convex_hull)
  1566   moreover have "{b} face_of S"
  1567   proof -
  1568     have "b \<in> convex hull {a} \<or> b extreme_point_of convex hull {b, a}"
  1569       by (meson extreme_point_of_convex_hull_insert finite.emptyI finite.insertI)
  1570     moreover have "closed_segment a b = convex hull {b, a}"
  1571       using closed_segment_commute segment_convex_hull by blast
  1572     ultimately show ?thesis
  1573       by (metis as assms face_of_face convex_hull_singleton empty_iff face_of_singleton insertE)
  1574     qed
  1575   ultimately show "a extreme_point_of S" "b extreme_point_of S"
  1576     using face_of_singleton by blast+
  1577 qed
  1580 proposition Krein_Milman_frontier:
  1581   fixes S :: "'a::euclidean_space set"
  1582   assumes "convex S" "compact S"
  1583     shows "S = convex hull (frontier S)"
  1584           (is "?lhs = ?rhs")
  1585 proof
  1586   have "?lhs \<subseteq> convex hull {x. x extreme_point_of S}"
  1587     using Krein_Milman_Minkowski assms by blast
  1588   also have "... \<subseteq> ?rhs"
  1589     apply (rule hull_mono)
  1590     apply (auto simp: frontier_def extreme_point_not_in_interior)
  1591     using closure_subset apply (force simp: extreme_point_of_def)
  1592     done
  1593   finally show "?lhs \<subseteq> ?rhs" .
  1594 next
  1595   have "?rhs \<subseteq> convex hull S"
  1596     by (metis Diff_subset \<open>compact S\<close> closure_closed compact_eq_bounded_closed frontier_def hull_mono)
  1597   also have "... \<subseteq> ?lhs"
  1598     by (simp add: \<open>convex S\<close> hull_same)
  1599   finally show "?rhs \<subseteq> ?lhs" .
  1600 qed
  1602 subsection\<open>Polytopes\<close>
  1604 definition%important polytope where
  1605  "polytope S \<equiv> \<exists>v. finite v \<and> S = convex hull v"
  1607 lemma polytope_translation_eq: "polytope (image (\<lambda>x. a + x) S) \<longleftrightarrow> polytope S"
  1608 apply (simp add: polytope_def, safe)
  1609 apply (metis convex_hull_translation finite_imageI translation_galois)
  1610 by (metis convex_hull_translation finite_imageI)
  1612 lemma polytope_linear_image: "\<lbrakk>linear f; polytope p\<rbrakk> \<Longrightarrow> polytope(image f p)"
  1613   unfolding polytope_def using convex_hull_linear_image by blast
  1615 lemma polytope_empty: "polytope {}"
  1616   using convex_hull_empty polytope_def by blast
  1618 lemma polytope_convex_hull: "finite S \<Longrightarrow> polytope(convex hull S)"
  1619   using polytope_def by auto
  1621 lemma polytope_Times: "\<lbrakk>polytope S; polytope T\<rbrakk> \<Longrightarrow> polytope(S \<times> T)"
  1622   unfolding polytope_def
  1623   by (metis finite_cartesian_product convex_hull_Times)
  1625 lemma face_of_polytope_polytope:
  1626   fixes S :: "'a::euclidean_space set"
  1627   shows "\<lbrakk>polytope S; F face_of S\<rbrakk> \<Longrightarrow> polytope F"
  1628 unfolding polytope_def
  1629 by (meson face_of_convex_hull_subset finite_imp_compact finite_subset)
  1631 lemma finite_polytope_faces:
  1632   fixes S :: "'a::euclidean_space set"
  1633   assumes "polytope S"
  1634   shows "finite {F. F face_of S}"
  1635 proof -
  1636   obtain v where "finite v" "S = convex hull v"
  1637     using assms polytope_def by auto
  1638   have "finite ((hull) convex ` {T. T \<subseteq> v})"
  1639     by (simp add: \<open>finite v\<close>)
  1640   moreover have "{F. F face_of S} \<subseteq> ((hull) convex ` {T. T \<subseteq> v})"
  1641     by (metis (no_types, lifting) \<open>finite v\<close> \<open>S = convex hull v\<close> face_of_convex_hull_subset finite_imp_compact image_eqI mem_Collect_eq subsetI)
  1642   ultimately show ?thesis
  1643     by (blast intro: finite_subset)
  1644 qed
  1646 lemma finite_polytope_facets:
  1647   assumes "polytope S"
  1648   shows "finite {T. T facet_of S}"
  1649 by (simp add: assms facet_of_def finite_polytope_faces)
  1651 lemma polytope_scaling:
  1652   assumes "polytope S"  shows "polytope (image (\<lambda>x. c *\<^sub>R x) S)"
  1653 by (simp add: assms polytope_linear_image)
  1655 lemma polytope_imp_compact:
  1656   fixes S :: "'a::real_normed_vector set"
  1657   shows "polytope S \<Longrightarrow> compact S"
  1658 by (metis finite_imp_compact_convex_hull polytope_def)
  1660 lemma polytope_imp_convex: "polytope S \<Longrightarrow> convex S"
  1661   by (metis convex_convex_hull polytope_def)
  1663 lemma polytope_imp_closed:
  1664   fixes S :: "'a::real_normed_vector set"
  1665   shows "polytope S \<Longrightarrow> closed S"
  1666 by (simp add: compact_imp_closed polytope_imp_compact)
  1668 lemma polytope_imp_bounded:
  1669   fixes S :: "'a::real_normed_vector set"
  1670   shows "polytope S \<Longrightarrow> bounded S"
  1671 by (simp add: compact_imp_bounded polytope_imp_compact)
  1673 lemma polytope_interval: "polytope(cbox a b)"
  1674   unfolding polytope_def by (meson closed_interval_as_convex_hull)
  1676 lemma polytope_sing: "polytope {a}"
  1677   using polytope_def by force
  1679 lemma face_of_polytope_insert:
  1680      "\<lbrakk>polytope S; a \<notin> affine hull S; F face_of S\<rbrakk> \<Longrightarrow> F face_of convex hull (insert a S)"
  1681   by (metis (no_types, lifting) affine_hull_convex_hull face_of_convex_hull_insert hull_insert polytope_def)
  1683 proposition face_of_polytope_insert2:
  1684   fixes a :: "'a :: euclidean_space"
  1685   assumes "polytope S" "a \<notin> affine hull S" "F face_of S"
  1686   shows "convex hull (insert a F) face_of convex hull (insert a S)"
  1687 proof -
  1688   obtain V where "finite V" "S = convex hull V"
  1689     using assms by (auto simp: polytope_def)
  1690   then have "convex hull (insert a F) face_of convex hull (insert a V)"
  1691     using affine_hull_convex_hull assms face_of_convex_hull_insert2 by blast
  1692   then show ?thesis
  1693     by (metis \<open>S = convex hull V\<close> hull_insert)
  1694 qed
  1697 subsection\<open>Polyhedra\<close>
  1699 definition%important polyhedron where
  1700  "polyhedron S \<equiv>
  1701         \<exists>F. finite F \<and>
  1702             S = \<Inter> F \<and>
  1703             (\<forall>h \<in> F. \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b})"
  1705 lemma polyhedron_Int [intro,simp]:
  1706    "\<lbrakk>polyhedron S; polyhedron T\<rbrakk> \<Longrightarrow> polyhedron (S \<inter> T)"
  1707   apply (simp add: polyhedron_def, clarify)
  1708   apply (rename_tac F G)
  1709   apply (rule_tac x="F \<union> G" in exI, auto)
  1710   done
  1712 lemma polyhedron_UNIV [iff]: "polyhedron UNIV"
  1713   unfolding polyhedron_def
  1714   by (rule_tac x="{}" in exI) auto
  1716 lemma polyhedron_Inter [intro,simp]:
  1717    "\<lbrakk>finite F; \<And>S. S \<in> F \<Longrightarrow> polyhedron S\<rbrakk> \<Longrightarrow> polyhedron(\<Inter>F)"
  1718 by (induction F rule: finite_induct) auto
  1721 lemma polyhedron_empty [iff]: "polyhedron ({} :: 'a :: euclidean_space set)"
  1722 proof -
  1723   have "\<exists>a. a \<noteq> 0 \<and>
  1724              (\<exists>b. {x. (SOME i. i \<in> Basis) \<bullet> x \<le> - 1} = {x. a \<bullet> x \<le> b})"
  1725     by (rule_tac x="(SOME i. i \<in> Basis)" in exI) (force simp: SOME_Basis nonzero_Basis)
  1726   moreover have "\<exists>a b. a \<noteq> 0 \<and>
  1727                        {x. - (SOME i. i \<in> Basis) \<bullet> x \<le> - 1} = {x. a \<bullet> x \<le> b}"
  1728       apply (rule_tac x="-(SOME i. i \<in> Basis)" in exI)
  1729       apply (rule_tac x="-1" in exI)
  1730       apply (simp add: SOME_Basis nonzero_Basis)
  1731       done
  1732   ultimately show ?thesis
  1733     unfolding polyhedron_def
  1734     apply (rule_tac x="{{x. (SOME i. i \<in> Basis) \<bullet> x \<le> -1},
  1735                         {x. -(SOME i. i \<in> Basis) \<bullet> x \<le> -1}}" in exI)
  1736     apply force
  1737     done
  1738 qed
  1740 lemma polyhedron_halfspace_le:
  1741   fixes a :: "'a :: euclidean_space"
  1742   shows "polyhedron {x. a \<bullet> x \<le> b}"
  1743 proof (cases "a = 0")
  1744   case True then show ?thesis by auto
  1745 next
  1746   case False
  1747   then show ?thesis
  1748     unfolding polyhedron_def
  1749     by (rule_tac x="{{x. a \<bullet> x \<le> b}}" in exI) auto
  1750 qed
  1752 lemma polyhedron_halfspace_ge:
  1753   fixes a :: "'a :: euclidean_space"
  1754   shows "polyhedron {x. a \<bullet> x \<ge> b}"
  1755 using polyhedron_halfspace_le [of "-a" "-b"] by simp
  1757 lemma polyhedron_hyperplane:
  1758   fixes a :: "'a :: euclidean_space"
  1759   shows "polyhedron {x. a \<bullet> x = b}"
  1760 proof -
  1761   have "{x. a \<bullet> x = b} = {x. a \<bullet> x \<le> b} \<inter> {x. a \<bullet> x \<ge> b}"
  1762     by force
  1763   then show ?thesis
  1764     by (simp add: polyhedron_halfspace_ge polyhedron_halfspace_le)
  1765 qed
  1767 lemma affine_imp_polyhedron:
  1768   fixes S :: "'a :: euclidean_space set"
  1769   shows "affine S \<Longrightarrow> polyhedron S"
  1770 by (metis affine_hull_eq polyhedron_Inter polyhedron_hyperplane affine_hull_finite_intersection_hyperplanes [of S])
  1772 lemma polyhedron_imp_closed:
  1773   fixes S :: "'a :: euclidean_space set"
  1774   shows "polyhedron S \<Longrightarrow> closed S"
  1775 apply (simp add: polyhedron_def)
  1776 using closed_halfspace_le by fastforce
  1778 lemma polyhedron_imp_convex:
  1779   fixes S :: "'a :: euclidean_space set"
  1780   shows "polyhedron S \<Longrightarrow> convex S"
  1781 apply (simp add: polyhedron_def)
  1782 using convex_Inter convex_halfspace_le by fastforce
  1784 lemma polyhedron_affine_hull:
  1785   fixes S :: "'a :: euclidean_space set"
  1786   shows "polyhedron(affine hull S)"
  1787 by (simp add: affine_imp_polyhedron)
  1790 subsection\<open>Canonical polyhedron representation making facial structure explicit\<close>
  1792 proposition polyhedron_Int_affine:
  1793   fixes S :: "'a :: euclidean_space set"
  1794   shows "polyhedron S \<longleftrightarrow>
  1795            (\<exists>F. finite F \<and> S = (affine hull S) \<inter> \<Inter>F \<and>
  1796                 (\<forall>h \<in> F. \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b}))"
  1797         (is "?lhs = ?rhs")
  1798 proof
  1799   assume ?lhs then show ?rhs
  1800     apply (simp add: polyhedron_def)
  1801     apply (erule ex_forward)
  1802     using hull_subset apply force
  1803     done
  1804 next
  1805   assume ?rhs then show ?lhs
  1806     apply clarify
  1807     apply (erule ssubst)
  1808     apply (force intro: polyhedron_affine_hull polyhedron_halfspace_le)
  1809     done
  1810 qed
  1812 proposition rel_interior_polyhedron_explicit:
  1813   assumes "finite F"
  1814       and seq: "S = affine hull S \<inter> \<Inter>F"
  1815       and faceq: "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> h = {x. a h \<bullet> x \<le> b h}"
  1816       and psub: "\<And>F'. F' \<subset> F \<Longrightarrow> S \<subset> affine hull S \<inter> \<Inter>F'"
  1817     shows "rel_interior S = {x \<in> S. \<forall>h \<in> F. a h \<bullet> x < b h}"
  1818 proof -
  1819   have rels: "\<And>x. x \<in> rel_interior S \<Longrightarrow> x \<in> S"
  1820     by (meson IntE mem_rel_interior)
  1821   moreover have "a i \<bullet> x < b i" if x: "x \<in> rel_interior S" and "i \<in> F" for x i
  1822   proof -
  1823     have fif: "F - {i} \<subset> F"
  1824       using \<open>i \<in> F\<close> Diff_insert_absorb Diff_subset set_insert psubsetI by blast
  1825     then have "S \<subset> affine hull S \<inter> \<Inter>(F - {i})"
  1826       by (rule psub)
  1827     then obtain z where ssub: "S \<subseteq> \<Inter>(F - {i})" and zint: "z \<in> \<Inter>(F - {i})"
  1828                     and "z \<notin> S" and zaff: "z \<in> affine hull S"
  1829       by auto
  1830     have "z \<noteq> x"
  1831       using \<open>z \<notin> S\<close> rels x by blast
  1832     have "z \<notin> affine hull S \<inter> \<Inter>F"
  1833       using \<open>z \<notin> S\<close> seq by auto
  1834     then have aiz: "a i \<bullet> z > b i"
  1835       using faceq zint zaff by fastforce
  1836     obtain e where "e > 0" "x \<in> S" and e: "ball x e \<inter> affine hull S \<subseteq> S"
  1837       using x by (auto simp: mem_rel_interior_ball)
  1838     then have ins: "\<And>y. \<lbrakk>norm (x - y) < e; y \<in> affine hull S\<rbrakk> \<Longrightarrow> y \<in> S"
  1839       by (metis IntI subsetD dist_norm mem_ball)
  1840     define \<xi> where "\<xi> = min (1/2) (e / 2 / norm(z - x))"
  1841     have "norm (\<xi> *\<^sub>R x - \<xi> *\<^sub>R z) = norm (\<xi> *\<^sub>R (x - z))"
  1842       by (simp add: \<xi>_def algebra_simps norm_mult)
  1843     also have "... = \<xi> * norm (x - z)"
  1844       using \<open>e > 0\<close> by (simp add: \<xi>_def)
  1845     also have "... < e"
  1846       using \<open>z \<noteq> x\<close> \<open>e > 0\<close> by (simp add: \<xi>_def min_def divide_simps norm_minus_commute)
  1847     finally have lte: "norm (\<xi> *\<^sub>R x - \<xi> *\<^sub>R z) < e" .
  1848     have \<xi>_aff: "\<xi> *\<^sub>R z + (1 - \<xi>) *\<^sub>R x \<in> affine hull S"
  1849       by (metis \<open>x \<in> S\<close> add.commute affine_affine_hull diff_add_cancel hull_inc mem_affine zaff)
  1850     have "\<xi> *\<^sub>R z + (1 - \<xi>) *\<^sub>R x \<in> S"
  1851       apply (rule ins [OF _ \<xi>_aff])
  1852       apply (simp add: algebra_simps lte)
  1853       done
  1854     then obtain l where l: "0 < l" "l < 1" and ls: "(l *\<^sub>R z + (1 - l) *\<^sub>R x) \<in> S"
  1855       apply (rule_tac l = \<xi> in that)
  1856       using \<open>e > 0\<close> \<open>z \<noteq> x\<close>  apply (auto simp: \<xi>_def)
  1857       done
  1858     then have i: "l *\<^sub>R z + (1 - l) *\<^sub>R x \<in> i"
  1859       using seq \<open>i \<in> F\<close> by auto
  1860     have "b i * l + (a i \<bullet> x) * (1 - l) < a i \<bullet> (l *\<^sub>R z + (1 - l) *\<^sub>R x)"
  1861       using l by (simp add: algebra_simps aiz)
  1862     also have "\<dots> \<le> b i" using i l
  1863       using faceq mem_Collect_eq \<open>i \<in> F\<close> by blast
  1864     finally have "(a i \<bullet> x) * (1 - l) < b i * (1 - l)"
  1865       by (simp add: algebra_simps)
  1866     with l show ?thesis
  1867       by simp
  1868   qed
  1869   moreover have "x \<in> rel_interior S"
  1870            if "x \<in> S" and less: "\<And>h. h \<in> F \<Longrightarrow> a h \<bullet> x < b h" for x
  1871   proof -
  1872     have 1: "\<And>h. h \<in> F \<Longrightarrow> x \<in> interior h"
  1873       by (metis interior_halfspace_le mem_Collect_eq less faceq)
  1874     have 2: "\<And>y. \<lbrakk>\<forall>h\<in>F. y \<in> interior h; y \<in> affine hull S\<rbrakk> \<Longrightarrow> y \<in> S"
  1875       by (metis IntI Inter_iff contra_subsetD interior_subset seq)
  1876     show ?thesis
  1877       apply (simp add: rel_interior \<open>x \<in> S\<close>)
  1878       apply (rule_tac x="\<Inter>h\<in>F. interior h" in exI)
  1879       apply (auto simp: \<open>finite F\<close> open_INT 1 2)
  1880       done
  1881   qed
  1882   ultimately show ?thesis by blast
  1883 qed
  1886 lemma polyhedron_Int_affine_parallel:
  1887   fixes S :: "'a :: euclidean_space set"
  1888   shows "polyhedron S \<longleftrightarrow>
  1889          (\<exists>F. finite F \<and>
  1890               S = (affine hull S) \<inter> (\<Inter>F) \<and>
  1891               (\<forall>h \<in> F. \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b} \<and>
  1892                              (\<forall>x \<in> affine hull S. (x + a) \<in> affine hull S)))"
  1893     (is "?lhs = ?rhs")
  1894 proof
  1895   assume ?lhs
  1896   then obtain F where "finite F" and seq: "S = (affine hull S) \<inter> \<Inter>F"
  1897                   and faces: "\<And>h. h \<in> F \<Longrightarrow> \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b}"
  1898     by (fastforce simp add: polyhedron_Int_affine)
  1899   then obtain a b where ab: "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> h = {x. a h \<bullet> x \<le> b h}"
  1900     by metis
  1901   show ?rhs
  1902   proof -
  1903     have "\<exists>a' b'. a' \<noteq> 0 \<and>
  1904                   affine hull S \<inter> {x. a' \<bullet> x \<le> b'} = affine hull S \<inter> h \<and>
  1905                   (\<forall>w \<in> affine hull S. (w + a') \<in> affine hull S)"
  1906         if "h \<in> F" "\<not>(affine hull S \<subseteq> h)" for h
  1907     proof -
  1908       have "a h \<noteq> 0" and "h = {x. a h \<bullet> x \<le> b h}" "h \<inter> \<Inter>F = \<Inter>F"
  1909         using \<open>h \<in> F\<close> ab by auto
  1910       then have "(affine hull S) \<inter> {x. a h \<bullet> x \<le> b h} \<noteq> {}"
  1911         by (metis (no_types) affine_hull_eq_empty inf.absorb_iff2 inf_assoc inf_bot_right inf_commute seq that(2))
  1912       moreover have "\<not> (affine hull S \<subseteq> {x. a h \<bullet> x \<le> b h})"
  1913         using \<open>h = {x. a h \<bullet> x \<le> b h}\<close> that(2) by blast
  1914       ultimately show ?thesis
  1915         using affine_parallel_slice [of "affine hull S"]
  1916         by (metis \<open>h = {x. a h \<bullet> x \<le> b h}\<close> affine_affine_hull)
  1917     qed
  1918     then obtain a b
  1919          where ab: "\<And>h. \<lbrakk>h \<in> F; \<not> (affine hull S \<subseteq> h)\<rbrakk>
  1920              \<Longrightarrow> a h \<noteq> 0 \<and>
  1921                   affine hull S \<inter> {x. a h \<bullet> x \<le> b h} = affine hull S \<inter> h \<and>
  1922                   (\<forall>w \<in> affine hull S. (w + a h) \<in> affine hull S)"
  1923       by metis
  1924     have seq2: "S = affine hull S \<inter> (\<Inter>h\<in>{h \<in> F. \<not> affine hull S \<subseteq> h}. {x. a h \<bullet> x \<le> b h})"
  1925       by (subst seq) (auto simp: ab INT_extend_simps)
  1926     show ?thesis
  1927       apply (rule_tac x="(\<lambda>h. {x. a h \<bullet> x \<le> b h}) ` {h. h \<in> F \<and> \<not>(affine hull S \<subseteq> h)}" in exI)
  1928       apply (intro conjI seq2)
  1929         using \<open>finite F\<close> apply force
  1930        using ab apply blast
  1931        done
  1932   qed
  1933 next
  1934   assume ?rhs then show ?lhs
  1935     apply (simp add: polyhedron_Int_affine)
  1936     by metis
  1937 qed
  1940 proposition polyhedron_Int_affine_parallel_minimal:
  1941   fixes S :: "'a :: euclidean_space set"
  1942   shows "polyhedron S \<longleftrightarrow>
  1943          (\<exists>F. finite F \<and>
  1944               S = (affine hull S) \<inter> (\<Inter>F) \<and>
  1945               (\<forall>h \<in> F. \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b} \<and>
  1946                              (\<forall>x \<in> affine hull S. (x + a) \<in> affine hull S)) \<and>
  1947               (\<forall>F'. F' \<subset> F \<longrightarrow> S \<subset> (affine hull S) \<inter> (\<Inter>F')))"
  1948     (is "?lhs = ?rhs")
  1949 proof
  1950   assume ?lhs
  1951   then obtain f0
  1952            where f0: "finite f0"
  1953                  "S = (affine hull S) \<inter> (\<Inter>f0)"
  1954                    (is "?P f0")
  1955                  "\<forall>h \<in> f0. \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b} \<and>
  1956                              (\<forall>x \<in> affine hull S. (x + a) \<in> affine hull S)"
  1957                    (is "?Q f0")
  1958     by (force simp: polyhedron_Int_affine_parallel)
  1959   define n where "n = (LEAST n. \<exists>F. card F = n \<and> finite F \<and> ?P F \<and> ?Q F)"
  1960   have nf: "\<exists>F. card F = n \<and> finite F \<and> ?P F \<and> ?Q F"
  1961     apply (simp add: n_def)
  1962     apply (rule LeastI [where k = "card f0"])
  1963     using f0 apply auto
  1964     done
  1965   then obtain F where F: "card F = n" "finite F" and seq: "?P F" and aff: "?Q F"
  1966     by blast
  1967   then have "\<not> (finite g \<and> ?P g \<and> ?Q g)" if "card g < n" for g
  1968     using that by (auto simp: n_def dest!: not_less_Least)
  1969   then have *: "\<not> (?P g \<and> ?Q g)" if "g \<subset> F" for g
  1970     using that \<open>finite F\<close> psubset_card_mono \<open>card F = n\<close>
  1971     by (metis finite_Int inf.strict_order_iff)
  1972   have 1: "\<And>F'. F' \<subset> F \<Longrightarrow> S \<subseteq> affine hull S \<inter> \<Inter>F'"
  1973     by (subst seq) blast
  1974   have 2: "\<And>F'. F' \<subset> F \<Longrightarrow> S \<noteq> affine hull S \<inter> \<Inter>F'"
  1975     apply (frule *)
  1976     by (metis aff subsetCE subset_iff_psubset_eq)
  1977   show ?rhs
  1978     by (metis \<open>finite F\<close> seq aff psubsetI 1 2)
  1979 next
  1980   assume ?rhs then show ?lhs
  1981     by (auto simp: polyhedron_Int_affine_parallel)
  1982 qed
  1985 lemma polyhedron_Int_affine_minimal:
  1986   fixes S :: "'a :: euclidean_space set"
  1987   shows "polyhedron S \<longleftrightarrow>
  1988          (\<exists>F. finite F \<and> S = (affine hull S) \<inter> \<Inter>F \<and>
  1989               (\<forall>h \<in> F. \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b}) \<and>
  1990               (\<forall>F'. F' \<subset> F \<longrightarrow> S \<subset> (affine hull S) \<inter> \<Inter>F'))"
  1991 apply (rule iffI)
  1992  apply (force simp: polyhedron_Int_affine_parallel_minimal elim!: ex_forward)
  1993 apply (auto simp: polyhedron_Int_affine elim!: ex_forward)
  1994 done
  1996 proposition facet_of_polyhedron_explicit:
  1997   assumes "finite F"
  1998       and seq: "S = affine hull S \<inter> \<Inter>F"
  1999       and faceq: "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> h = {x. a h \<bullet> x \<le> b h}"
  2000       and psub: "\<And>F'. F' \<subset> F \<Longrightarrow> S \<subset> affine hull S \<inter> \<Inter>F'"
  2001     shows "c facet_of S \<longleftrightarrow> (\<exists>h. h \<in> F \<and> c = S \<inter> {x. a h \<bullet> x = b h})"
  2002 proof (cases "S = {}")
  2003   case True with psub show ?thesis by force
  2004 next
  2005   case False
  2006   have "polyhedron S"
  2007     apply (simp add: polyhedron_Int_affine)
  2008     apply (rule_tac x=F in exI)
  2009     using assms  apply force
  2010     done
  2011   then have "convex S"
  2012     by (rule polyhedron_imp_convex)
  2013   with False rel_interior_eq_empty have "rel_interior S \<noteq> {}" by blast
  2014   then obtain x where "x \<in> rel_interior S" by auto
  2015   then obtain T where "open T" "x \<in> T" "x \<in> S" "T \<inter> affine hull S \<subseteq> S"
  2016     by (force simp: mem_rel_interior)
  2017   then have xaff: "x \<in> affine hull S" and xint: "x \<in> \<Inter>F"
  2018     using seq hull_inc by auto
  2019   have "rel_interior S = {x \<in> S. \<forall>h\<in>F. a h \<bullet> x < b h}"
  2020     by (rule rel_interior_polyhedron_explicit [OF \<open>finite F\<close> seq faceq psub])
  2021   with \<open>x \<in> rel_interior S\<close>
  2022   have [simp]: "\<And>h. h\<in>F \<Longrightarrow> a h \<bullet> x < b h" by blast
  2023   have *: "(S \<inter> {x. a h \<bullet> x = b h}) facet_of S" if "h \<in> F" for h
  2024   proof -
  2025     have "S \<subset> affine hull S \<inter> \<Inter>(F - {h})"
  2026       using psub that by (metis Diff_disjoint Diff_subset insert_disjoint(2) psubsetI)
  2027     then obtain z where zaff: "z \<in> affine hull S" and zint: "z \<in> \<Inter>(F - {h})" and "z \<notin> S"
  2028       by force
  2029     then have "z \<noteq> x" "z \<notin> h" using seq \<open>x \<in> S\<close> by auto
  2030     have "x \<in> h" using that xint by auto
  2031     then have able: "a h \<bullet> x \<le> b h"
  2032       using faceq that by blast
  2033     also have "... < a h \<bullet> z" using \<open>z \<notin> h\<close> faceq [OF that] xint by auto
  2034     finally have xltz: "a h \<bullet> x < a h \<bullet> z" .
  2035     define l where "l = (b h - a h \<bullet> x) / (a h \<bullet> z - a h \<bullet> x)"
  2036     define w where "w = (1 - l) *\<^sub>R x + l *\<^sub>R z"
  2037     have "0 < l" "l < 1"
  2038       using able xltz \<open>b h < a h \<bullet> z\<close> \<open>h \<in> F\<close>
  2039       by (auto simp: l_def divide_simps)
  2040     have awlt: "a i \<bullet> w < b i" if "i \<in> F" "i \<noteq> h" for i
  2041     proof -
  2042       have "(1 - l) * (a i \<bullet> x) < (1 - l) * b i"
  2043         by (simp add: \<open>l < 1\<close> \<open>i \<in> F\<close>)
  2044       moreover have "l * (a i \<bullet> z) \<le> l * b i"
  2045         apply (rule mult_left_mono)
  2046         apply (metis Diff_insert_absorb Inter_iff Set.set_insert \<open>h \<in> F\<close> faceq insertE mem_Collect_eq that zint)
  2047         using \<open>0 < l\<close>
  2048         apply simp
  2049         done
  2050       ultimately show ?thesis by (simp add: w_def algebra_simps)
  2051     qed
  2052     have weq: "a h \<bullet> w = b h"
  2053       using xltz unfolding w_def l_def
  2054       by (simp add: algebra_simps) (simp add: field_simps)
  2055     have "w \<in> affine hull S"
  2056       by (simp add: w_def mem_affine xaff zaff)
  2057     moreover have "w \<in> \<Inter>F"
  2058       using \<open>a h \<bullet> w = b h\<close> awlt faceq less_eq_real_def by blast
  2059     ultimately have "w \<in> S"
  2060       using seq by blast
  2061     with weq have "S \<inter> {x. a h \<bullet> x = b h} \<noteq> {}" by blast
  2062     moreover have "S \<inter> {x. a h \<bullet> x = b h} face_of S"
  2063       apply (rule face_of_Int_supporting_hyperplane_le)
  2064       apply (rule \<open>convex S\<close>)
  2065       apply (subst (asm) seq)
  2066       using faceq that apply fastforce
  2067       done
  2068     moreover have "affine hull (S \<inter> {x. a h \<bullet> x = b h}) =
  2069                    (affine hull S) \<inter> {x. a h \<bullet> x = b h}"
  2070     proof
  2071       show "affine hull (S \<inter> {x. a h \<bullet> x = b h}) \<subseteq> affine hull S \<inter> {x. a h \<bullet> x = b h}"
  2072         apply (intro Int_greatest hull_mono Int_lower1)
  2073         apply (metis affine_hull_eq affine_hyperplane hull_mono inf_le2)
  2074         done
  2075     next
  2076       show "affine hull S \<inter> {x. a h \<bullet> x = b h} \<subseteq> affine hull (S \<inter> {x. a h \<bullet> x = b h})"
  2077       proof
  2078         fix y
  2079         assume yaff: "y \<in> affine hull S \<inter> {y. a h \<bullet> y = b h}"
  2080         obtain T where "0 < T"
  2081                  and T: "\<And>j. \<lbrakk>j \<in> F; j \<noteq> h\<rbrakk> \<Longrightarrow> T * (a j \<bullet> y - a j \<bullet> w) \<le> b j - a j \<bullet> w"
  2082         proof (cases "F - {h} = {}")
  2083           case True then show ?thesis
  2084             by (rule_tac T=1 in that) auto
  2085         next
  2086           case False
  2087           then obtain h' where h': "h' \<in> F - {h}" by auto
  2088           let ?body = "(\<lambda>j. if 0 < a j \<bullet> y - a j \<bullet> w
  2089               then (b j - a j \<bullet> w) / (a j \<bullet> y - a j \<bullet> w)
  2090               else 1) ` (F - {h})"
  2091           define inff where "inff = Inf ?body"
  2092           from \<open>finite F\<close> have "finite ?body"
  2093             by blast
  2094           moreover from h' have "?body \<noteq> {}"
  2095             by blast
  2096           moreover have "j > 0" if "j \<in> ?body" for j
  2097           proof -
  2098             from that obtain x where "x \<in> F" and "x \<noteq> h" and *: "j =
  2099               (if 0 < a x \<bullet> y - a x \<bullet> w
  2100                 then (b x - a x \<bullet> w) / (a x \<bullet> y - a x \<bullet> w) else 1)"
  2101               by blast
  2102             with awlt [of x] have "a x \<bullet> w < b x"
  2103               by simp
  2104             with * show ?thesis
  2105               by simp
  2106           qed
  2107           ultimately have "0 < inff"
  2108             by (simp_all add: finite_less_Inf_iff inff_def)
  2109           moreover have "inff * (a j \<bullet> y - a j \<bullet> w) \<le> b j - a j \<bullet> w"
  2110                         if "j \<in> F" "j \<noteq> h" for j
  2111           proof (cases "a j \<bullet> w < a j \<bullet> y")
  2112             case True
  2113             then have "inff \<le> (b j - a j \<bullet> w) / (a j \<bullet> y - a j \<bullet> w)"
  2114               apply (simp add: inff_def)
  2115               apply (rule cInf_le_finite)
  2116               using \<open>finite F\<close> apply blast
  2117               apply (simp add: that split: if_split_asm)
  2118               done
  2119             then show ?thesis
  2120               using \<open>0 < inff\<close> awlt [OF that] mult_strict_left_mono
  2121               by (fastforce simp add: algebra_simps divide_simps split: if_split_asm)
  2122           next
  2123             case False
  2124             with \<open>0 < inff\<close> have "inff * (a j \<bullet> y - a j \<bullet> w) \<le> 0"
  2125               by (simp add: mult_le_0_iff)
  2126             also have "... < b j - a j \<bullet> w"
  2127               by (simp add: awlt that)
  2128             finally show ?thesis by simp
  2129           qed
  2130           ultimately show ?thesis
  2131             by (blast intro: that)
  2132         qed
  2133         define c where "c = (1 - T) *\<^sub>R w + T *\<^sub>R y"
  2134         have "(1 - T) *\<^sub>R w + T *\<^sub>R y \<in> j" if "j \<in> F" for j
  2135         proof (cases "j = h")
  2136           case True
  2137           have "(1 - T) *\<^sub>R w + T *\<^sub>R y \<in> {x. a h \<bullet> x \<le> b h}"
  2138             using weq yaff by (auto simp: algebra_simps)
  2139           with True faceq [OF that] show ?thesis by metis
  2140         next
  2141           case False
  2142           with T that have "(1 - T) *\<^sub>R w + T *\<^sub>R y \<in> {x. a j \<bullet> x \<le> b j}"
  2143             by (simp add: algebra_simps)
  2144           with faceq [OF that] show ?thesis by simp
  2145         qed
  2146         moreover have "(1 - T) *\<^sub>R w + T *\<^sub>R y \<in> affine hull S"
  2147           apply (rule affine_affine_hull [simplified affine_alt, rule_format])
  2148           apply (simp add: \<open>w \<in> affine hull S\<close>)
  2149           using yaff apply blast
  2150           done
  2151         ultimately have "c \<in> S"
  2152           using seq by (force simp: c_def)
  2153         moreover have "a h \<bullet> c = b h"
  2154           using yaff by (force simp: c_def algebra_simps weq)
  2155         ultimately have caff: "c \<in> affine hull (S \<inter> {y. a h \<bullet> y = b h})"
  2156           by (simp add: hull_inc)
  2157         have waff: "w \<in> affine hull (S \<inter> {y. a h \<bullet> y = b h})"
  2158           using \<open>w \<in> S\<close> weq by (blast intro: hull_inc)
  2159         have yeq: "y = (1 - inverse T) *\<^sub>R w + c /\<^sub>R T"
  2160           using \<open>0 < T\<close> by (simp add: c_def algebra_simps)
  2161         show "y \<in> affine hull (S \<inter> {y. a h \<bullet> y = b h})"
  2162           by (metis yeq affine_affine_hull [simplified affine_alt, rule_format, OF waff caff])
  2163       qed
  2164     qed
  2165     ultimately show ?thesis
  2166       apply (simp add: facet_of_def)
  2167       apply (subst aff_dim_affine_hull [symmetric])
  2168       using  \<open>b h < a h \<bullet> z\<close> zaff
  2169       apply (force simp: aff_dim_affine_Int_hyperplane)
  2170       done
  2171   qed
  2172   show ?thesis
  2173   proof
  2174     show "\<exists>h. h \<in> F \<and> c = S \<inter> {x. a h \<bullet> x = b h} \<Longrightarrow> c facet_of S"
  2175       using * by blast
  2176   next
  2177     assume "c facet_of S"
  2178     then have "c face_of S" "convex c" "c \<noteq> {}" and affc: "aff_dim c = aff_dim S - 1"
  2179       by (auto simp: facet_of_def face_of_imp_convex)
  2180     then obtain x where x: "x \<in> rel_interior c"
  2181       by (force simp: rel_interior_eq_empty)
  2182     then have "x \<in> c"
  2183       by (meson subsetD rel_interior_subset)
  2184     then have "x \<in> S"
  2185       using \<open>c facet_of S\<close> facet_of_imp_subset by blast
  2186     have rels: "rel_interior S = {x \<in> S. \<forall>h\<in>F. a h \<bullet> x < b h}"
  2187       by (rule rel_interior_polyhedron_explicit [OF assms])
  2188     have "c \<noteq> S"
  2189       using \<open>c facet_of S\<close> facet_of_irrefl by blast
  2190     then have "x \<notin> rel_interior S"
  2191       by (metis IntI empty_iff \<open>x \<in> c\<close> \<open>c \<noteq> S\<close> \<open>c face_of S\<close> face_of_disjoint_rel_interior)
  2192     with rels \<open>x \<in> S\<close> obtain i where "i \<in> F" and i: "a i \<bullet> x \<ge> b i"
  2193       by force
  2194     have "x \<in> {u. a i \<bullet> u \<le> b i}"
  2195       by (metis IntD2 InterE \<open>i \<in> F\<close> \<open>x \<in> S\<close> faceq seq)
  2196     then have "a i \<bullet> x \<le> b i" by simp
  2197     then have "a i \<bullet> x = b i" using i by auto
  2198     have "c \<subseteq> S \<inter> {x. a i \<bullet> x = b i}"
  2199       apply (rule subset_of_face_of [of _ S])
  2200         apply (simp add: "*" \<open>i \<in> F\<close> facet_of_imp_face_of)
  2201        apply (simp add: \<open>c face_of S\<close> face_of_imp_subset)
  2202       using \<open>a i \<bullet> x = b i\<close> \<open>x \<in> S\<close> x by blast
  2203     then have cface: "c face_of (S \<inter> {x. a i \<bullet> x = b i})"
  2204       by (meson \<open>c face_of S\<close> face_of_subset inf_le1)
  2205     have con: "convex (S \<inter> {x. a i \<bullet> x = b i})"
  2206       by (simp add: \<open>convex S\<close> convex_Int convex_hyperplane)
  2207     show "\<exists>h. h \<in> F \<and> c = S \<inter> {x. a h \<bullet> x = b h}"
  2208       apply (rule_tac x=i in exI)
  2209       apply (simp add: \<open>i \<in> F\<close>)
  2210       by (metis (no_types) * \<open>i \<in> F\<close> affc facet_of_def less_irrefl face_of_aff_dim_lt [OF con cface])
  2211   qed
  2212 qed
  2215 lemma face_of_polyhedron_subset_explicit:
  2216   fixes S :: "'a :: euclidean_space set"
  2217   assumes "finite F"
  2218       and seq: "S = affine hull S \<inter> \<Inter>F"
  2219       and faceq: "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> h = {x. a h \<bullet> x \<le> b h}"
  2220       and psub: "\<And>F'. F' \<subset> F \<Longrightarrow> S \<subset> affine hull S \<inter> \<Inter>F'"
  2221       and c: "c face_of S" and "c \<noteq> {}" "c \<noteq> S"
  2222    obtains h where "h \<in> F" "c \<subseteq> S \<inter> {x. a h \<bullet> x = b h}"
  2223 proof -
  2224   have "c \<subseteq> S" using \<open>c face_of S\<close>
  2225     by (simp add: face_of_imp_subset)
  2226   have "polyhedron S"
  2227     apply (simp add: polyhedron_Int_affine)
  2228     by (metis \<open>finite F\<close> faceq seq)
  2229   then have "convex S"
  2230     by (simp add: polyhedron_imp_convex)
  2231   then have *: "(S \<inter> {x. a h \<bullet> x = b h}) face_of S" if "h \<in> F" for h
  2232     apply (rule face_of_Int_supporting_hyperplane_le)
  2233     using faceq seq that by fastforce
  2234   have "rel_interior c \<noteq> {}"
  2235     using c \<open>c \<noteq> {}\<close> face_of_imp_convex rel_interior_eq_empty by blast
  2236   then obtain x where "x \<in> rel_interior c" by auto
  2237   have rels: "rel_interior S = {x \<in> S. \<forall>h\<in>F. a h \<bullet> x < b h}"
  2238     by (rule rel_interior_polyhedron_explicit [OF \<open>finite F\<close> seq faceq psub])
  2239   then have xnot: "x \<notin> rel_interior S"
  2240     by (metis IntI \<open>x \<in> rel_interior c\<close> c \<open>c \<noteq> S\<close> contra_subsetD empty_iff face_of_disjoint_rel_interior rel_interior_subset)
  2241   then have "x \<in> S"
  2242     using \<open>c \<subseteq> S\<close> \<open>x \<in> rel_interior c\<close> rel_interior_subset by auto
  2243   then have xint: "x \<in> \<Inter>F"
  2244     using seq by blast
  2245   have "F \<noteq> {}" using assms
  2246     by (metis affine_Int affine_Inter affine_affine_hull ex_in_conv face_of_affine_trivial)
  2247   then obtain i where "i \<in> F" "\<not> (a i \<bullet> x < b i)"
  2248     using \<open>x \<in> S\<close> rels xnot by auto
  2249   with xint have "a i \<bullet> x = b i"
  2250     by (metis eq_iff mem_Collect_eq not_le Inter_iff faceq)
  2251   have face: "S \<inter> {x. a i \<bullet> x = b i} face_of S"
  2252     by (simp add: "*" \<open>i \<in> F\<close>)
  2253   show ?thesis
  2254     apply (rule_tac h = i in that)
  2255      apply (rule \<open>i \<in> F\<close>)
  2256     apply (rule subset_of_face_of [OF face \<open>c \<subseteq> S\<close>])
  2257     using \<open>a i \<bullet> x = b i\<close> \<open>x \<in> rel_interior c\<close> \<open>x \<in> S\<close> apply blast
  2258     done
  2259 qed
  2261 text\<open>Initial part of proof duplicates that above\<close>
  2262 proposition face_of_polyhedron_explicit:
  2263   fixes S :: "'a :: euclidean_space set"
  2264   assumes "finite F"
  2265       and seq: "S = affine hull S \<inter> \<Inter>F"
  2266       and faceq: "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> h = {x. a h \<bullet> x \<le> b h}"
  2267       and psub: "\<And>F'. F' \<subset> F \<Longrightarrow> S \<subset> affine hull S \<inter> \<Inter>F'"
  2268       and c: "c face_of S" and "c \<noteq> {}" "c \<noteq> S"
  2269     shows "c = \<Inter>{S \<inter> {x. a h \<bullet> x = b h} | h. h \<in> F \<and> c \<subseteq> S \<inter> {x. a h \<bullet> x = b h}}"
  2270 proof -
  2271   let ?ab = "\<lambda>h. {x. a h \<bullet> x = b h}"
  2272   have "c \<subseteq> S" using \<open>c face_of S\<close>
  2273     by (simp add: face_of_imp_subset)
  2274   have "polyhedron S"
  2275     apply (simp add: polyhedron_Int_affine)
  2276     by (metis \<open>finite F\<close> faceq seq)
  2277   then have "convex S"
  2278     by (simp add: polyhedron_imp_convex)
  2279   then have *: "(S \<inter> ?ab h) face_of S" if "h \<in> F" for h
  2280     apply (rule face_of_Int_supporting_hyperplane_le)
  2281     using faceq seq that by fastforce
  2282   have "rel_interior c \<noteq> {}"
  2283     using c \<open>c \<noteq> {}\<close> face_of_imp_convex rel_interior_eq_empty by blast
  2284   then obtain z where z: "z \<in> rel_interior c" by auto
  2285   have rels: "rel_interior S = {z \<in> S. \<forall>h\<in>F. a h \<bullet> z < b h}"
  2286     by (rule rel_interior_polyhedron_explicit [OF \<open>finite F\<close> seq faceq psub])
  2287   then have xnot: "z \<notin> rel_interior S"
  2288     by (metis IntI \<open>z \<in> rel_interior c\<close> c \<open>c \<noteq> S\<close> contra_subsetD empty_iff face_of_disjoint_rel_interior rel_interior_subset)
  2289   then have "z \<in> S"
  2290     using \<open>c \<subseteq> S\<close> \<open>z \<in> rel_interior c\<close> rel_interior_subset by auto
  2291   with seq have xint: "z \<in> \<Inter>F" by blast
  2292   have "open (\<Inter>h\<in>{h \<in> F. a h \<bullet> z < b h}. {w. a h \<bullet> w < b h})"
  2293     by (auto simp: \<open>finite F\<close> open_halfspace_lt open_INT)
  2294   then obtain e where "0 < e"
  2295                  "ball z e \<subseteq> (\<Inter>h\<in>{h \<in> F. a h \<bullet> z < b h}. {w. a h \<bullet> w < b h})"
  2296     by (auto intro: openE [of _ z])
  2297   then have e: "\<And>h. \<lbrakk>h \<in> F; a h \<bullet> z < b h\<rbrakk> \<Longrightarrow> ball z e \<subseteq> {w. a h \<bullet> w < b h}"
  2298     by blast
  2299   have "c \<subseteq> (S \<inter> ?ab h) \<longleftrightarrow> z \<in> S \<inter> ?ab h" if "h \<in> F" for h
  2300   proof
  2301     show "z \<in> S \<inter> ?ab h \<Longrightarrow> c \<subseteq> S \<inter> ?ab h"
  2302       apply (rule subset_of_face_of [of _ S])
  2303       using that \<open>c \<subseteq> S\<close> \<open>z \<in> rel_interior c\<close>
  2304       using facet_of_polyhedron_explicit [OF \<open>finite F\<close> seq faceq psub]
  2305             unfolding facet_of_def
  2306       apply auto
  2307       done
  2308   next
  2309     show "c \<subseteq> S \<inter> ?ab h \<Longrightarrow> z \<in> S \<inter> ?ab h"
  2310       using \<open>z \<in> rel_interior c\<close> rel_interior_subset by force
  2311   qed
  2312   then have **: "{S \<inter> ?ab h | h. h \<in> F \<and> c \<subseteq> S \<and> c \<subseteq> ?ab h} =
  2313                  {S \<inter> ?ab h |h. h \<in> F \<and> z \<in> S \<inter> ?ab h}"
  2314     by blast
  2315   have bsub: "ball z e \<inter> affine hull \<Inter>{S \<inter> ?ab h |h. h \<in> F \<and> a h \<bullet> z = b h}
  2316              \<subseteq> affine hull S \<inter> \<Inter>F \<inter> \<Inter>{?ab h |h. h \<in> F \<and> a h \<bullet> z = b h}"
  2317             if "i \<in> F" and i: "a i \<bullet> z = b i" for i
  2318   proof -
  2319     have sub: "ball z e \<inter> \<Inter>{?ab h |h. h \<in> F \<and> a h \<bullet> z = b h} \<subseteq> j"
  2320              if "j \<in> F" for j
  2321     proof -
  2322       have "a j \<bullet> z \<le> b j" using faceq that xint by auto
  2323       then consider "a j \<bullet> z < b j" | "a j \<bullet> z = b j" by linarith
  2324       then have "\<exists>G. G \<in> {?ab h |h. h \<in> F \<and> a h \<bullet> z = b h} \<and> ball z e \<inter> G \<subseteq> j"
  2325       proof cases
  2326         assume "a j \<bullet> z < b j"
  2327         then have "ball z e \<inter> {x. a i \<bullet> x = b i} \<subseteq> j"
  2328           using e [OF \<open>j \<in> F\<close>] faceq that
  2329           by (fastforce simp: ball_def)
  2330         then show ?thesis
  2331           by (rule_tac x="{x. a i \<bullet> x = b i}" in exI) (force simp: \<open>i \<in> F\<close> i)
  2332       next
  2333         assume eq: "a j \<bullet> z = b j"
  2334         with faceq that show ?thesis
  2335           by (rule_tac x="{x. a j \<bullet> x = b j}" in exI) (fastforce simp add: \<open>j \<in> F\<close>)
  2336       qed
  2337       then show ?thesis  by blast
  2338     qed
  2339     have 1: "affine hull \<Inter>{S \<inter> ?ab h |h. h \<in> F \<and> a h \<bullet> z = b h} \<subseteq> affine hull S"
  2340       apply (rule hull_mono)
  2341       using that \<open>z \<in> S\<close> by auto
  2342     have 2: "affine hull \<Inter>{S \<inter> ?ab h |h. h \<in> F \<and> a h \<bullet> z = b h}
  2343           \<subseteq> \<Inter>{?ab h |h. h \<in> F \<and> a h \<bullet> z = b h}"
  2344       by (rule hull_minimal) (auto intro: affine_hyperplane)
  2345     have 3: "ball z e \<inter> \<Inter>{?ab h |h. h \<in> F \<and> a h \<bullet> z = b h} \<subseteq> \<Inter>F"
  2346       by (iprover intro: sub Inter_greatest)
  2347     have *: "\<lbrakk>A \<subseteq> (B :: 'a set); A \<subseteq> C; E \<inter> C \<subseteq> D\<rbrakk> \<Longrightarrow> E \<inter> A \<subseteq> (B \<inter> D) \<inter> C"
  2348              for A B C D E  by blast
  2349     show ?thesis by (intro * 1 2 3)
  2350   qed
  2351   have "\<exists>h. h \<in> F \<and> c \<subseteq> ?ab h"
  2352     apply (rule face_of_polyhedron_subset_explicit [OF \<open>finite F\<close> seq faceq psub])
  2353     using assms by auto
  2354   then have fac: "\<Inter>{S \<inter> ?ab h |h. h \<in> F \<and> c \<subseteq> S \<inter> ?ab h} face_of S"
  2355     using * by (force simp: \<open>c \<subseteq> S\<close> intro: face_of_Inter)
  2356   have red:
  2357      "(\<And>a. P a \<Longrightarrow> T \<subseteq> S \<inter> \<Inter>{F x |x. P x}) \<Longrightarrow> T \<subseteq> \<Inter>{S \<inter> F x |x. P x}"
  2358      for P T F   by blast
  2359   have "ball z e \<inter> affine hull \<Inter>{S \<inter> ?ab h |h. h \<in> F \<and> a h \<bullet> z = b h}
  2360         \<subseteq> \<Inter>{S \<inter> ?ab h |h. h \<in> F \<and> a h \<bullet> z = b h}"
  2361     apply (rule red)
  2362     apply (metis seq bsub)
  2363     done
  2364   with \<open>0 < e\<close> have zinrel: "z \<in> rel_interior
  2365                     (\<Inter>{S \<inter> ?ab h |h. h \<in> F \<and> z \<in> S \<and> a h \<bullet> z = b h})"
  2366     by (auto simp: mem_rel_interior_ball \<open>z \<in> S\<close>)
  2367   show ?thesis
  2368     apply (rule face_of_eq [OF c fac])
  2369     using z zinrel apply (force simp: **)
  2370     done
  2371 qed
  2374 subsection\<open>More general corollaries from the explicit representation\<close>
  2376 corollary facet_of_polyhedron:
  2377   assumes "polyhedron S" and "c facet_of S"
  2378   obtains a b where "a \<noteq> 0" "S \<subseteq> {x. a \<bullet> x \<le> b}" "c = S \<inter> {x. a \<bullet> x = b}"
  2379 proof -
  2380   obtain F where "finite F" and seq: "S = affine hull S \<inter> \<Inter>F"
  2381              and faces: "\<And>h. h \<in> F \<Longrightarrow> \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b}"
  2382              and min: "\<And>F'. F' \<subset> F \<Longrightarrow> S \<subset> (affine hull S) \<inter> \<Inter>F'"
  2383     using assms by (simp add: polyhedron_Int_affine_minimal) meson
  2384   then obtain a b where ab: "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> h = {x. a h \<bullet> x \<le> b h}"
  2385     by metis
  2386   obtain i where "i \<in> F" and c: "c = S \<inter> {x. a i \<bullet> x = b i}"
  2387     using facet_of_polyhedron_explicit [OF \<open>finite F\<close> seq ab min] assms
  2388     by force
  2389   moreover have ssub: "S \<subseteq> {x. a i \<bullet> x \<le> b i}"
  2390      apply (subst seq)
  2391      using \<open>i \<in> F\<close> ab by auto
  2392   ultimately show ?thesis
  2393     by (rule_tac a = "a i" and b = "b i" in that) (simp_all add: ab)
  2394 qed
  2396 corollary face_of_polyhedron:
  2397   assumes "polyhedron S" and "c face_of S" and "c \<noteq> {}" and "c \<noteq> S"
  2398     shows "c = \<Inter>{F. F facet_of S \<and> c \<subseteq> F}"
  2399 proof -
  2400   obtain F where "finite F" and seq: "S = affine hull S \<inter> \<Inter>F"
  2401              and faces: "\<And>h. h \<in> F \<Longrightarrow> \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b}"
  2402              and min: "\<And>F'. F' \<subset> F \<Longrightarrow> S \<subset> (affine hull S) \<inter> \<Inter>F'"
  2403     using assms by (simp add: polyhedron_Int_affine_minimal) meson
  2404   then obtain a b where ab: "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> h = {x. a h \<bullet> x \<le> b h}"
  2405     by metis
  2406   show ?thesis
  2407     apply (subst face_of_polyhedron_explicit [OF \<open>finite F\<close> seq ab min])
  2408     apply (auto simp: assms facet_of_polyhedron_explicit [OF \<open>finite F\<close> seq ab min] cong: Collect_cong)
  2409     done
  2410 qed
  2412 lemma face_of_polyhedron_subset_facet:
  2413   assumes "polyhedron S" and "c face_of S" and "c \<noteq> {}" and "c \<noteq> S"
  2414   obtains F where "F facet_of S" "c \<subseteq> F"
  2415 using face_of_polyhedron assms
  2416 by (metis (no_types, lifting) Inf_greatest antisym_conv face_of_imp_subset mem_Collect_eq)
  2419 lemma exposed_face_of_polyhedron:
  2420   assumes "polyhedron S"
  2421     shows "F exposed_face_of S \<longleftrightarrow> F face_of S"
  2422 proof
  2423   show "F exposed_face_of S \<Longrightarrow> F face_of S"
  2424     by (simp add: exposed_face_of_def)
  2425 next
  2426   assume "F face_of S"
  2427   show "F exposed_face_of S"
  2428   proof (cases "F = {} \<or> F = S")
  2429     case True then show ?thesis
  2430       using \<open>F face_of S\<close> exposed_face_of by blast
  2431   next
  2432     case False
  2433     then have "{g. g facet_of S \<and> F \<subseteq> g} \<noteq> {}"
  2434       by (metis Collect_empty_eq_bot \<open>F face_of S\<close> assms empty_def face_of_polyhedron_subset_facet)
  2435     moreover have "\<And>T. \<lbrakk>T facet_of S; F \<subseteq> T\<rbrakk> \<Longrightarrow> T exposed_face_of S"
  2436       by (metis assms exposed_face_of facet_of_imp_face_of facet_of_polyhedron)
  2437     ultimately have "\<Inter>{fa.
  2438        fa facet_of S \<and> F \<subseteq> fa} exposed_face_of S"
  2439       by (metis (no_types, lifting) mem_Collect_eq exposed_face_of_Inter)
  2440     then show ?thesis
  2441       using False
  2442       apply (subst face_of_polyhedron [OF assms \<open>F face_of S\<close>], auto)
  2443       done
  2444   qed
  2445 qed
  2447 lemma face_of_polyhedron_polyhedron:
  2448   fixes S :: "'a :: euclidean_space set"
  2449   assumes "polyhedron S" "c face_of S" shows "polyhedron c"
  2450 by (metis assms face_of_imp_eq_affine_Int polyhedron_Int polyhedron_affine_hull polyhedron_imp_convex)
  2452 lemma finite_polyhedron_faces:
  2453   fixes S :: "'a :: euclidean_space set"
  2454   assumes "polyhedron S"
  2455     shows "finite {F. F face_of S}"
  2456 proof -
  2457   obtain F where "finite F" and seq: "S = affine hull S \<inter> \<Inter>F"
  2458              and faces: "\<And>h. h \<in> F \<Longrightarrow> \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b}"
  2459              and min:   "\<And>F'. F' \<subset> F \<Longrightarrow> S \<subset> (affine hull S) \<inter> \<Inter>F'"
  2460     using assms by (simp add: polyhedron_Int_affine_minimal) meson
  2461   then obtain a b where ab: "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> h = {x. a h \<bullet> x \<le> b h}"
  2462     by metis
  2463   have "finite {\<Inter>{S \<inter> {x. a h \<bullet> x = b h} |h. h \<in> F'}| F'. F' \<in> Pow F}"
  2464     by (simp add: \<open>finite F\<close>)
  2465   moreover have "{F. F face_of S} - {{}, S} \<subseteq> {\<Inter>{S \<inter> {x. a h \<bullet> x = b h} |h. h \<in> F'}| F'. F' \<in> Pow F}"
  2466     apply clarify
  2467     apply (rename_tac c)
  2468     apply (drule face_of_polyhedron_explicit [OF \<open>finite F\<close> seq ab min, simplified], simp_all)
  2469     apply (erule ssubst)
  2470     apply (rule_tac x="{h \<in> F. c \<subseteq> S \<inter> {x. a h \<bullet> x = b h}}" in exI, auto)
  2471     done
  2472   ultimately show ?thesis
  2473     by (meson finite.emptyI finite.insertI finite_Diff2 finite_subset)
  2474 qed
  2476 lemma finite_polyhedron_exposed_faces:
  2477    "polyhedron S \<Longrightarrow> finite {F. F exposed_face_of S}"
  2478 using exposed_face_of_polyhedron finite_polyhedron_faces by fastforce
  2480 lemma finite_polyhedron_extreme_points:
  2481   fixes S :: "'a :: euclidean_space set"
  2482   shows "polyhedron S \<Longrightarrow> finite {v. v extreme_point_of S}"
  2483 apply (simp add: face_of_singleton [symmetric])
  2484 apply (rule finite_subset [OF _ finite_vimageI [OF finite_polyhedron_faces]], auto)
  2485 done
  2487 lemma finite_polyhedron_facets:
  2488   fixes S :: "'a :: euclidean_space set"
  2489   shows "polyhedron S \<Longrightarrow> finite {F. F facet_of S}"
  2490 unfolding facet_of_def
  2491 by (blast intro: finite_subset [OF _ finite_polyhedron_faces])
  2494 proposition rel_interior_of_polyhedron:
  2495   fixes S :: "'a :: euclidean_space set"
  2496   assumes "polyhedron S"
  2497     shows "rel_interior S = S - \<Union>{F. F facet_of S}"
  2498 proof -
  2499   obtain F where "finite F" and seq: "S = affine hull S \<inter> \<Inter>F"
  2500              and faces: "\<And>h. h \<in> F \<Longrightarrow> \<exists>a b. a \<noteq> 0 \<and> h = {x. a \<bullet> x \<le> b}"
  2501              and min: "\<And>F'. F' \<subset> F \<Longrightarrow> S \<subset> (affine hull S) \<inter> \<Inter>F'"
  2502     using assms by (simp add: polyhedron_Int_affine_minimal) meson
  2503   then obtain a b where ab: "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> h = {x. a h \<bullet> x \<le> b h}"
  2504     by metis
  2505   have facet: "(c facet_of S) \<longleftrightarrow> (\<exists>h. h \<in> F \<and> c = S \<inter> {x. a h \<bullet> x = b h})" for c
  2506     by (rule facet_of_polyhedron_explicit [OF \<open>finite F\<close> seq ab min])
  2507   have rel: "rel_interior S = {x \<in> S. \<forall>h\<in>F. a h \<bullet> x < b h}"
  2508     by (rule rel_interior_polyhedron_explicit [OF \<open>finite F\<close> seq ab min])
  2509   have "a h \<bullet> x < b h" if "x \<in> S" "h \<in> F" and xnot: "x \<notin> \<Union>{F. F facet_of S}" for x h
  2510   proof -
  2511     have "x \<in> \<Inter>F" using seq that by force
  2512     with \<open>h \<in> F\<close> ab have "a h \<bullet> x \<le> b h" by auto
  2513     then consider "a h \<bullet> x < b h" | "a h \<bullet> x = b h" by linarith
  2514     then show ?thesis
  2515     proof cases
  2516       case 1 then show ?thesis .
  2517     next
  2518       case 2
  2519       have "Collect ((\<in>) x) \<notin> Collect ((\<in>) (\<Union>{A. A facet_of S}))"
  2520         using xnot by fastforce
  2521       then have "F \<notin> Collect ((\<in>) h)"
  2522         using 2 \<open>x \<in> S\<close> facet by blast
  2523       with \<open>h \<in> F\<close> have "\<Inter>F \<subseteq> S \<inter> {x. a h \<bullet> x = b h}" by blast
  2524       with 2 that \<open>x \<in> \<Inter>F\<close> show ?thesis
  2525         apply simp
  2526         apply (drule_tac x="\<Inter>F" in spec)
  2527         apply (simp add: facet)
  2528         apply (drule_tac x=h in spec)
  2529         using seq by auto
  2530       qed
  2531   qed
  2532   moreover have "\<exists>h\<in>F. a h \<bullet> x \<ge> b h" if "x \<in> \<Union>{F. F facet_of S}" for x
  2533     using that by (force simp: facet)
  2534   ultimately show ?thesis
  2535     by (force simp: rel)
  2536 qed
  2538 lemma rel_boundary_of_polyhedron:
  2539   fixes S :: "'a :: euclidean_space set"
  2540   assumes "polyhedron S"
  2541     shows "S - rel_interior S = \<Union> {F. F facet_of S}"
  2542 using facet_of_imp_subset by (fastforce simp add: rel_interior_of_polyhedron assms)
  2544 lemma rel_frontier_of_polyhedron:
  2545   fixes S :: "'a :: euclidean_space set"
  2546   assumes "polyhedron S"
  2547     shows "rel_frontier S = \<Union> {F. F facet_of S}"
  2548 by (simp add: assms rel_frontier_def polyhedron_imp_closed rel_boundary_of_polyhedron)
  2550 lemma rel_frontier_of_polyhedron_alt:
  2551   fixes S :: "'a :: euclidean_space set"
  2552   assumes "polyhedron S"
  2553     shows "rel_frontier S = \<Union> {F. F face_of S \<and> (F \<noteq> S)}"
  2554 apply (rule subset_antisym)
  2555   apply (force simp: rel_frontier_of_polyhedron facet_of_def assms)
  2556 using face_of_subset_rel_frontier by fastforce
  2559 text\<open>A characterization of polyhedra as having finitely many faces\<close>
  2561 proposition polyhedron_eq_finite_exposed_faces:
  2562   fixes S :: "'a :: euclidean_space set"
  2563   shows "polyhedron S \<longleftrightarrow> closed S \<and> convex S \<and> finite {F. F exposed_face_of S}"
  2564          (is "?lhs = ?rhs")
  2565 proof
  2566   assume ?lhs
  2567   then show ?rhs
  2568     by (auto simp: polyhedron_imp_closed polyhedron_imp_convex finite_polyhedron_exposed_faces)
  2569 next
  2570   assume ?rhs
  2571   then have "closed S" "convex S" and fin: "finite {F. F exposed_face_of S}" by auto
  2572   show ?lhs
  2573   proof (cases "S = {}")
  2574     case True then show ?thesis by auto
  2575   next
  2576     case False
  2577     define F where "F = {h. h exposed_face_of S \<and> h \<noteq> {} \<and> h \<noteq> S}"
  2578     have "finite F" by (simp add: fin F_def)
  2579     have hface: "h face_of S"
  2580       and "\<exists>a b. a \<noteq> 0 \<and> S \<subseteq> {x. a \<bullet> x \<le> b} \<and> h = S \<inter> {x. a \<bullet> x = b}"
  2581       if "h \<in> F" for h
  2582       using exposed_face_of F_def that by simp_all auto
  2583     then obtain a b where ab:
  2584       "\<And>h. h \<in> F \<Longrightarrow> a h \<noteq> 0 \<and> S \<subseteq> {x. a h \<bullet> x \<le> b h} \<and> h = S \<inter> {x. a h \<bullet> x = b h}"
  2585       by metis
  2586     have *: "False"
  2587       if paff: "p \<in> affine hull S" and "p \<notin> S"
  2588       and pint: "p \<in> \<Inter>{{x. a h \<bullet> x \<le> b h} |h. h \<in> F}" for p
  2589     proof -
  2590       have "rel_interior S \<noteq> {}"
  2591         by (simp add: \<open>S \<noteq> {}\<close> \<open>convex S\<close> rel_interior_eq_empty)
  2592       then obtain c where c: "c \<in> rel_interior S" by auto
  2593       with rel_interior_subset have "c \<in> S"  by blast
  2594       have ccp: "closed_segment c p \<subseteq> affine hull S"
  2595         by (meson affine_affine_hull affine_imp_convex c closed_segment_subset hull_subset paff rel_interior_subset subsetCE)
  2596       obtain x where xcl: "x \<in> closed_segment c p" and "x \<in> S" and xnot: "x \<notin> rel_interior S"
  2597         using connected_openin [of "closed_segment c p"]
  2598         apply simp
  2599         apply (drule_tac x="closed_segment c p \<inter> rel_interior S" in spec)
  2600         apply (erule impE)
  2601          apply (force simp: openin_rel_interior openin_Int intro: openin_subtopology_Int_subset [OF _ ccp])
  2602         apply (drule_tac x="closed_segment c p \<inter> (- S)" in spec)
  2603         using rel_interior_subset \<open>closed S\<close> c \<open>p \<notin> S\<close> apply blast
  2604         done
  2605       then obtain \<mu> where "0 \<le> \<mu>" "\<mu> \<le> 1" and xeq: "x = (1 - \<mu>) *\<^sub>R c + \<mu> *\<^sub>R p"
  2606         by (auto simp: in_segment)
  2607       show False
  2608       proof (cases "\<mu>=0 \<or> \<mu>=1")
  2609         case True with xeq c xnot \<open>x \<in> S\<close> \<open>p \<notin> S\<close>
  2610         show False by auto
  2611       next
  2612         case False
  2613         then have xos: "x \<in> open_segment c p"
  2614           using \<open>x \<in> S\<close> c open_segment_def that(2) xcl xnot by auto
  2615         have xclo: "x \<in> closure S"
  2616           using \<open>x \<in> S\<close> closure_subset by blast
  2617         obtain d where "d \<noteq> 0"
  2618               and dle: "\<And>y. y \<in> closure S \<Longrightarrow> d \<bullet> x \<le> d \<bullet> y"
  2619               and dless: "\<And>y. y \<in> rel_interior S \<Longrightarrow> d \<bullet> x < d \<bullet> y"
  2620           by (metis supporting_hyperplane_relative_frontier [OF \<open>convex S\<close> xclo xnot])
  2621         have sex: "S \<inter> {y. d \<bullet> y = d \<bullet> x} exposed_face_of S"
  2622           by (simp add: \<open>closed S\<close> dle exposed_face_of_Int_supporting_hyperplane_ge [OF \<open>convex S\<close>])
  2623         have sne: "S \<inter> {y. d \<bullet> y = d \<bullet> x} \<noteq> {}"
  2624           using \<open>x \<in> S\<close> by blast
  2625         have sns: "S \<inter> {y. d \<bullet> y = d \<bullet> x} \<noteq> S"
  2626           by (metis (mono_tags) Int_Collect c subsetD dless not_le order_refl rel_interior_subset)
  2627         obtain h where "h \<in> F" "x \<in> h"
  2628           apply (rule_tac h="S \<inter> {y. d \<bullet> y = d \<bullet> x}" in that)
  2629           apply (simp_all add: F_def sex sne sns \<open>x \<in> S\<close>)
  2630           done
  2631         have abface: "{y. a h \<bullet> y = b h} face_of {y. a h \<bullet> y \<le> b h}"
  2632           using hyperplane_face_of_halfspace_le by blast
  2633         then have "c \<in> h"
  2634           using face_ofD [OF abface xos] \<open>c \<in> S\<close> \<open>h \<in> F\<close> ab pint \<open>x \<in> h\<close> by blast
  2635         with c have "h \<inter> rel_interior S \<noteq> {}" by blast
  2636         then show False
  2637           using \<open>h \<in> F\<close> F_def face_of_disjoint_rel_interior hface by auto
  2638       qed
  2639     qed
  2640     have "S \<subseteq> affine hull S \<inter> \<Inter>{{x. a h \<bullet> x \<le> b h} |h. h \<in> F}"
  2641       using ab by (auto simp: hull_subset)
  2642     moreover have "affine hull S \<inter> \<Inter>{{x. a h \<bullet> x \<le> b h} |h. h \<in> F} \<subseteq> S"
  2643       using * by blast
  2644     ultimately have "S = affine hull S \<inter> \<Inter> {{x. a h \<bullet> x \<le> b h} |h. h \<in> F}" ..
  2645     then show ?thesis
  2646       apply (rule ssubst)
  2647       apply (force intro: polyhedron_affine_hull polyhedron_halfspace_le simp: \<open>finite F\<close>)
  2648       done
  2649   qed
  2650 qed
  2652 corollary polyhedron_eq_finite_faces:
  2653   fixes S :: "'a :: euclidean_space set"
  2654   shows "polyhedron S \<longleftrightarrow> closed S \<and> convex S \<and> finite {F. F face_of S}"
  2655          (is "?lhs = ?rhs")
  2656 proof
  2657   assume ?lhs
  2658   then show ?rhs
  2659     by (simp add: finite_polyhedron_faces polyhedron_imp_closed polyhedron_imp_convex)
  2660 next
  2661   assume ?rhs
  2662   then show ?lhs
  2663     by (force simp: polyhedron_eq_finite_exposed_faces exposed_face_of intro: finite_subset)
  2664 qed
  2666 lemma polyhedron_linear_image_eq:
  2667   fixes h :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
  2668   assumes "linear h" "bij h"
  2669     shows "polyhedron (h ` S) \<longleftrightarrow> polyhedron S"
  2670 proof -
  2671   have *: "{f. P f} = (image h) ` {f. P (h ` f)}" for P
  2672     apply safe
  2673     apply (rule_tac x="inv h ` x" in image_eqI)
  2674     apply (auto simp: \<open>bij h\<close> bij_is_surj image_f_inv_f)
  2675     done
  2676   have "inj h" using bij_is_inj assms by blast
  2677   then have injim: "inj_on ((`) h) A" for A
  2678     by (simp add: inj_on_def inj_image_eq_iff)
  2679   show ?thesis
  2680     using \<open>linear h\<close> \<open>inj h\<close>
  2681     apply (simp add: polyhedron_eq_finite_faces closed_injective_linear_image_eq)
  2682     apply (simp add: * face_of_linear_image [of h _ S, symmetric] finite_image_iff injim)
  2683     done
  2684 qed
  2686 lemma polyhedron_negations:
  2687   fixes S :: "'a :: euclidean_space set"
  2688   shows   "polyhedron S \<Longrightarrow> polyhedron(image uminus S)"
  2689   by (subst polyhedron_linear_image_eq)
  2690     (auto simp: bij_uminus intro!: linear_uminus)
  2692 subsection\<open>Relation between polytopes and polyhedra\<close>
  2694 proposition polytope_eq_bounded_polyhedron:
  2695   fixes S :: "'a :: euclidean_space set"
  2696   shows "polytope S \<longleftrightarrow> polyhedron S \<and> bounded S"
  2697          (is "?lhs = ?rhs")
  2698 proof
  2699   assume ?lhs
  2700   then show ?rhs
  2701     by (simp add: finite_polytope_faces polyhedron_eq_finite_faces
  2702                   polytope_imp_closed polytope_imp_convex polytope_imp_bounded)
  2703 next
  2704   assume ?rhs then show ?lhs
  2705     unfolding polytope_def
  2706     apply (rule_tac x="{v. v extreme_point_of S}" in exI)
  2707     apply (simp add: finite_polyhedron_extreme_points Krein_Milman_Minkowski compact_eq_bounded_closed polyhedron_imp_closed polyhedron_imp_convex)
  2708     done
  2709 qed
  2711 lemma polytope_Int:
  2712   fixes S :: "'a :: euclidean_space set"
  2713   shows "\<lbrakk>polytope S; polytope T\<rbrakk> \<Longrightarrow> polytope(S \<inter> T)"
  2714 by (simp add: polytope_eq_bounded_polyhedron bounded_Int)
  2717 lemma polytope_Int_polyhedron:
  2718   fixes S :: "'a :: euclidean_space set"
  2719   shows "\<lbrakk>polytope S; polyhedron T\<rbrakk> \<Longrightarrow> polytope(S \<inter> T)"
  2720   by (simp add: bounded_Int polytope_eq_bounded_polyhedron)
  2722 lemma polyhedron_Int_polytope:
  2723   fixes S :: "'a :: euclidean_space set"
  2724   shows "\<lbrakk>polyhedron S; polytope T\<rbrakk> \<Longrightarrow> polytope(S \<inter> T)"
  2725   by (simp add: bounded_Int polytope_eq_bounded_polyhedron)
  2727 lemma polytope_imp_polyhedron:
  2728   fixes S :: "'a :: euclidean_space set"
  2729   shows "polytope S \<Longrightarrow> polyhedron S"
  2730   by (simp add: polytope_eq_bounded_polyhedron)
  2732 lemma polytope_facet_exists:
  2733   fixes p :: "'a :: euclidean_space set"
  2734   assumes "polytope p" "0 < aff_dim p"
  2735   obtains F where "F facet_of p"
  2736 proof (cases "p = {}")
  2737   case True with assms show ?thesis by auto
  2738 next
  2739   case False
  2740   then obtain v where "v extreme_point_of p"
  2741     using extreme_point_exists_convex
  2742     by (blast intro: \<open>polytope p\<close> polytope_imp_compact polytope_imp_convex)
  2743   then
  2744   show ?thesis
  2745     by (metis face_of_polyhedron_subset_facet polytope_imp_polyhedron aff_dim_sing
  2746        all_not_in_conv assms face_of_singleton less_irrefl singletonI that)
  2747 qed
  2749 lemma polyhedron_interval [iff]: "polyhedron(cbox a b)"
  2750 by (metis polytope_imp_polyhedron polytope_interval)
  2752 lemma polyhedron_convex_hull:
  2753   fixes S :: "'a :: euclidean_space set"
  2754   shows "finite S \<Longrightarrow> polyhedron(convex hull S)"
  2755 by (simp add: polytope_convex_hull polytope_imp_polyhedron)
  2758 subsection\<open>Relative and absolute frontier of a polytope\<close>
  2760 lemma rel_boundary_of_convex_hull:
  2761     fixes S :: "'a::euclidean_space set"
  2762     assumes "\<not> affine_dependent S"
  2763       shows "(convex hull S) - rel_interior(convex hull S) = (\<Union>a\<in>S. convex hull (S - {a}))"
  2764 proof -
  2765   have "finite S" by (metis assms aff_independent_finite)
  2766   then consider "card S = 0" | "card S = 1" | "2 \<le> card S" by arith
  2767   then show ?thesis
  2768   proof cases
  2769     case 1 then have "S = {}" by (simp add: \<open>finite S\<close>)
  2770     then show ?thesis by simp
  2771   next
  2772     case 2 show ?thesis
  2773       by (auto intro: card_1_singletonE [OF \<open>card S = 1\<close>])
  2774   next
  2775     case 3
  2776     with assms show ?thesis
  2777       by (auto simp: polyhedron_convex_hull rel_boundary_of_polyhedron facet_of_convex_hull_affine_independent_alt \<open>finite S\<close>)
  2778   qed
  2779 qed
  2781 proposition frontier_of_convex_hull:
  2782     fixes S :: "'a::euclidean_space set"
  2783     assumes "card S = Suc (DIM('a))"
  2784       shows "frontier(convex hull S) = \<Union> {convex hull (S - {a}) | a. a \<in> S}"
  2785 proof (cases "affine_dependent S")
  2786   case True
  2787     have [iff]: "finite S"
  2788       using assms using card_infinite by force
  2789     then have ccs: "closed (convex hull S)"
  2790       by (simp add: compact_imp_closed finite_imp_compact_convex_hull)
  2791     { fix x T
  2792       assume "finite T" "T \<subseteq> S" "int (card T) \<le> aff_dim S + 1" "x \<in> convex hull T"
  2793       then have "S \<noteq> T"
  2794         using True \<open>finite S\<close> aff_dim_le_card affine_independent_iff_card by fastforce
  2795       then obtain a where "a \<in> S" "a \<notin> T"
  2796         using \<open>T \<subseteq> S\<close> by blast
  2797       then have "x \<in> (\<Union>a\<in>S. convex hull (S - {a}))"
  2798         using True affine_independent_iff_card [of S]
  2799         apply simp
  2800         apply (metis (no_types, hide_lams) Diff_eq_empty_iff Diff_insert0 \<open>a \<notin> T\<close> \<open>T \<subseteq> S\<close> \<open>x \<in> convex hull T\<close>  hull_mono insert_Diff_single   subsetCE)
  2801         done
  2802     } note * = this
  2803     have 1: "convex hull S \<subseteq> (\<Union> a\<in>S. convex hull (S - {a}))"
  2804       apply (subst caratheodory_aff_dim)
  2805       apply (blast intro: *)
  2806       done
  2807     have 2: "\<Union>((\<lambda>a. convex hull (S - {a})) ` S) \<subseteq> convex hull S"
  2808       by (rule Union_least) (metis (no_types, lifting)  Diff_subset hull_mono imageE)
  2809     show ?thesis using True
  2810       apply (simp add: segment_convex_hull frontier_def)
  2811       using interior_convex_hull_eq_empty [OF assms]
  2812       apply (simp add: closure_closed [OF ccs])
  2813       apply (rule subset_antisym)
  2814       using 1 apply blast
  2815       using 2 apply blast
  2816       done
  2817 next
  2818   case False
  2819   then have "frontier (convex hull S) = (convex hull S) - rel_interior(convex hull S)"
  2820     apply (simp add: rel_boundary_of_convex_hull [symmetric] frontier_def)
  2821     by (metis aff_independent_finite assms closure_convex_hull finite_imp_compact_convex_hull hull_hull interior_convex_hull_eq_empty rel_interior_nonempty_interior)
  2822   also have "... = \<Union>{convex hull (S - {a}) |a. a \<in> S}"
  2823   proof -
  2824     have "convex hull S - rel_interior (convex hull S) = rel_frontier (convex hull S)"
  2825       by (simp add: False aff_independent_finite polyhedron_convex_hull rel_boundary_of_polyhedron rel_frontier_of_polyhedron)
  2826     then show ?thesis
  2827       by (simp add: False rel_frontier_convex_hull_cases)
  2828   qed
  2829   finally show ?thesis .
  2830 qed
  2832 subsection\<open>Special case of a triangle\<close>
  2834 proposition frontier_of_triangle:
  2835     fixes a :: "'a::euclidean_space"
  2836     assumes "DIM('a) = 2"
  2837     shows "frontier(convex hull {a,b,c}) = closed_segment a b \<union> closed_segment b c \<union> closed_segment c a"
  2838           (is "?lhs = ?rhs")
  2839 proof (cases "b = a \<or> c = a \<or> c = b")
  2840   case True then show ?thesis
  2841     by (auto simp: assms segment_convex_hull frontier_def empty_interior_convex_hull insert_commute card_insert_le_m1 hull_inc insert_absorb)
  2842 next
  2843   case False then have [simp]: "card {a, b, c} = Suc (DIM('a))"
  2844     by (simp add: card_insert Set.insert_Diff_if assms)
  2845   show ?thesis
  2846   proof
  2847     show "?lhs \<subseteq> ?rhs"
  2848       using False
  2849       by (force simp: segment_convex_hull frontier_of_convex_hull insert_Diff_if insert_commute split: if_split_asm)
  2850     show "?rhs \<subseteq> ?lhs"
  2851       using False
  2852       apply (simp add: frontier_of_convex_hull segment_convex_hull)
  2853       apply (intro conjI subsetI)
  2854         apply (rule_tac X="convex hull {a,b}" in UnionI; force simp: Set.insert_Diff_if)
  2855        apply (rule_tac X="convex hull {b,c}" in UnionI; force)
  2856       apply (rule_tac X="convex hull {a,c}" in UnionI; force simp: insert_commute Set.insert_Diff_if)
  2857       done
  2858   qed
  2859 qed
  2861 corollary inside_of_triangle:
  2862     fixes a :: "'a::euclidean_space"
  2863     assumes "DIM('a) = 2"
  2864     shows "inside (closed_segment a b \<union> closed_segment b c \<union> closed_segment c a) = interior(convex hull {a,b,c})"
  2865 by (metis assms frontier_of_triangle bounded_empty bounded_insert convex_convex_hull inside_frontier_eq_interior bounded_convex_hull)
  2867 corollary interior_of_triangle:
  2868     fixes a :: "'a::euclidean_space"
  2869     assumes "DIM('a) = 2"
  2870     shows "interior(convex hull {a,b,c}) =
  2871            convex hull {a,b,c} - (closed_segment a b \<union> closed_segment b c \<union> closed_segment c a)"
  2872   using interior_subset
  2873   by (force simp: frontier_of_triangle [OF assms, symmetric] frontier_def Diff_Diff_Int)
  2875 subsection\<open>Subdividing a cell complex\<close>
  2877 lemma subdivide_interval:
  2878   fixes x::real
  2879   assumes "a < \<bar>x - y\<bar>" "0 < a"
  2880   obtains n where "n \<in> \<int>" "x < n * a \<and> n * a < y \<or> y <  n * a \<and> n * a < x"
  2881 proof -
  2882   consider "a + x < y" | "a + y < x"
  2883     using assms by linarith
  2884   then show ?thesis
  2885   proof cases
  2886     case 1
  2887     let ?n = "of_int (floor (x/a)) + 1"
  2888     have x: "x < ?n * a"
  2889       by (meson \<open>0 < a\<close> divide_less_eq floor_eq_iff)
  2890     have "?n * a \<le> a + x"
  2891       apply (simp add: algebra_simps)
  2892       by (metis \<open>0 < a\<close> floor_correct less_irrefl nonzero_mult_div_cancel_left real_mult_le_cancel_iff2 times_divide_eq_right)
  2893     also have "... < y"
  2894       by (rule 1)
  2895     finally have "?n * a < y" .
  2896     with x show ?thesis
  2897       using Ints_1 Ints_add Ints_of_int that by blast
  2898   next
  2899     case 2
  2900     let ?n = "of_int (floor (y/a)) + 1"
  2901     have y: "y < ?n * a"
  2902       by (meson \<open>0 < a\<close> divide_less_eq floor_eq_iff)
  2903     have "?n * a \<le> a + y"
  2904       apply (simp add: algebra_simps)
  2905       by (metis \<open>0 < a\<close> floor_correct less_irrefl nonzero_mult_div_cancel_left real_mult_le_cancel_iff2 times_divide_eq_right)
  2906     also have "... < x"
  2907       by (rule 2)
  2908     finally have "?n * a < x" .
  2909     then show ?thesis
  2910       using Ints_1 Ints_add Ints_of_int that y by blast
  2911   qed
  2912 qed
  2914 lemma cell_subdivision_lemma:
  2915   assumes "finite \<F>"
  2916       and "\<And>X. X \<in> \<F> \<Longrightarrow> polytope X"
  2917       and "\<And>X. X \<in> \<F> \<Longrightarrow> aff_dim X \<le> d"
  2918       and "\<And>X Y. \<lbrakk>X \<in> \<F>; Y \<in> \<F>\<rbrakk> \<Longrightarrow> (X \<inter> Y) face_of X \<and> (X \<inter> Y) face_of Y"
  2919       and "finite I"
  2920     shows "\<exists>\<G>. \<Union>\<G> = \<Union>\<F> \<and>
  2921                  finite \<G> \<and>
  2922                  (\<forall>C \<in> \<G>. \<exists>D. D \<in> \<F> \<and> C \<subseteq> D) \<and>
  2923                  (\<forall>C \<in> \<F>. \<forall>x \<in> C. \<exists>D. D \<in> \<G> \<and> x \<in> D \<and> D \<subseteq> C) \<and>
  2924                  (\<forall>X \<in> \<G>. polytope X) \<and>
  2925                  (\<forall>X \<in> \<G>. aff_dim X \<le> d) \<and>
  2926                  (\<forall>X \<in> \<G>. \<forall>Y \<in> \<G>. X \<inter> Y face_of X \<and> X \<inter> Y face_of Y) \<and>
  2927                  (\<forall>X \<in> \<G>. \<forall>x \<in> X. \<forall>y \<in> X. \<forall>a b.
  2928                           (a,b) \<in> I \<longrightarrow> a \<bullet> x \<le> b \<and> a \<bullet> y \<le> b \<or>
  2929                                         a \<bullet> x \<ge> b \<and> a \<bullet> y \<ge> b)"
  2930   using \<open>finite I\<close>
  2931 proof induction
  2932   case empty
  2933   then show ?case
  2934     by (rule_tac x="\<F>" in exI) (auto simp: assms)
  2935 next
  2936   case (insert ab I)
  2937   then obtain \<G> where eq: "\<Union>\<G> = \<Union>\<F>" and "finite \<G>"
  2938                    and sub1: "\<And>C. C \<in> \<G> \<Longrightarrow> \<exists>D. D \<in> \<F> \<and> C \<subseteq> D"
  2939                    and sub2: "\<And>C x. C \<in> \<F> \<and> x \<in> C \<Longrightarrow> \<exists>D. D \<in> \<G> \<and> x \<in> D \<and> D \<subseteq> C"
  2940                    and poly: "\<And>X. X \<in> \<G> \<Longrightarrow> polytope X"
  2941                    and aff: "\<And>X. X \<in> \<G> \<Longrightarrow> aff_dim X \<le> d"
  2942                    and face: "\<And>X Y. \<lbrakk>X \<in> \<G>; Y \<in> \<G>\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X \<and> X \<inter> Y face_of Y"
  2943                    and I: "\<And>X x y a b.  \<lbrakk>X \<in> \<G>; x \<in> X; y \<in> X; (a,b) \<in> I\<rbrakk> \<Longrightarrow>
  2944                                     a \<bullet> x \<le> b \<and> a \<bullet> y \<le> b \<or> a \<bullet> x \<ge> b \<and> a \<bullet> y \<ge> b"
  2945     by (auto simp: that)
  2946   obtain a b where "ab = (a,b)"
  2947     by fastforce
  2948   let ?\<G> = "(\<lambda>X. X \<inter> {x. a \<bullet> x \<le> b}) ` \<G> \<union> (\<lambda>X. X \<inter> {x. a \<bullet> x \<ge> b}) ` \<G>"
  2949   have eqInt: "(S \<inter> Collect P) \<inter> (T \<inter> Collect Q) = (S \<inter> T) \<inter> (Collect P \<inter> Collect Q)" for S T::"'a set" and P Q
  2950     by blast
  2951   show ?case
  2952   proof (intro conjI exI)
  2953     show "\<Union>?\<G> = \<Union>\<F>"
  2954       by (force simp: eq [symmetric])
  2955     show "finite ?\<G>"
  2956       using \<open>finite \<G>\<close> by force
  2957     show "\<forall>X \<in> ?\<G>. polytope X"
  2958       by (force simp: poly polytope_Int_polyhedron polyhedron_halfspace_le polyhedron_halfspace_ge)
  2959     show "\<forall>X \<in> ?\<G>. aff_dim X \<le> d"
  2960       by (auto; metis order_trans aff aff_dim_subset inf_le1)
  2961     show "\<forall>X \<in> ?\<G>. \<forall>x \<in> X. \<forall>y \<in> X. \<forall>a b.
  2962                           (a,b) \<in> insert ab I \<longrightarrow> a \<bullet> x \<le> b \<and> a \<bullet> y \<le> b \<or>
  2963                                                   a \<bullet> x \<ge> b \<and> a \<bullet> y \<ge> b"
  2964       using \<open>ab = (a, b)\<close> I by fastforce
  2965     show "\<forall>X \<in> ?\<G>. \<forall>Y \<in> ?\<G>. X \<inter> Y face_of X \<and> X \<inter> Y face_of Y"
  2966       by (auto simp: eqInt halfspace_Int_eq face_of_Int_Int face face_of_halfspace_le face_of_halfspace_ge)
  2967     show "\<forall>C \<in> ?\<G>. \<exists>D. D \<in> \<F> \<and> C \<subseteq> D"
  2968       using sub1 by force
  2969     show "\<forall>C\<in>\<F>. \<forall>x\<in>C. \<exists>D. D \<in> ?\<G> \<and> x \<in> D \<and> D \<subseteq> C"
  2970     proof (intro ballI)
  2971       fix C z
  2972       assume "C \<in> \<F>" "z \<in> C"
  2973       with sub2 obtain D where D: "D \<in> \<G>" "z \<in> D" "D \<subseteq> C" by blast
  2974       have "D \<in> \<G> \<and> z \<in> D \<inter> {x. a \<bullet> x \<le> b} \<and> D \<inter> {x. a \<bullet> x \<le> b} \<subseteq> C \<or>
  2975             D \<in> \<G> \<and> z \<in> D \<inter> {x. a \<bullet> x \<ge> b} \<and> D \<inter> {x. a \<bullet> x \<ge> b} \<subseteq> C"
  2976         using linorder_class.linear [of "a \<bullet> z" b] D by blast
  2977       then show "\<exists>D. D \<in> ?\<G> \<and> z \<in> D \<and> D \<subseteq> C"
  2978         by blast
  2979     qed
  2980   qed
  2981 qed
  2984 proposition cell_complex_subdivision_exists:
  2985   fixes \<F> :: "'a::euclidean_space set set"
  2986   assumes "0 < e" "finite \<F>"
  2987       and poly: "\<And>X. X \<in> \<F> \<Longrightarrow> polytope X"
  2988       and aff: "\<And>X. X \<in> \<F> \<Longrightarrow> aff_dim X \<le> d"
  2989       and face: "\<And>X Y. \<lbrakk>X \<in> \<F>; Y \<in> \<F>\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X \<and> X \<inter> Y face_of Y"
  2990   obtains "\<F>'" where "finite \<F>'" "\<Union>\<F>' = \<Union>\<F>" "\<And>X. X \<in> \<F>' \<Longrightarrow> diameter X < e"
  2991                 "\<And>X. X \<in> \<F>' \<Longrightarrow> polytope X" "\<And>X. X \<in> \<F>' \<Longrightarrow> aff_dim X \<le> d"
  2992                 "\<And>X Y. \<lbrakk>X \<in> \<F>'; Y \<in> \<F>'\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X \<and> X \<inter> Y face_of Y"
  2993                 "\<And>C. C \<in> \<F>' \<Longrightarrow> \<exists>D. D \<in> \<F> \<and> C \<subseteq> D"
  2994                 "\<And>C x. C \<in> \<F> \<and> x \<in> C \<Longrightarrow> \<exists>D. D \<in> \<F>' \<and> x \<in> D \<and> D \<subseteq> C"
  2995 proof -
  2996   have "bounded(\<Union>\<F>)"
  2997     by (simp add: \<open>finite \<F>\<close> poly bounded_Union polytope_imp_bounded)
  2998   then obtain B where "B > 0" and B: "\<And>x. x \<in> \<Union>\<F> \<Longrightarrow> norm x < B"
  2999     by (meson bounded_pos_less)
  3000   define C where "C \<equiv> {z \<in> \<int>. \<bar>z * e / 2 / real DIM('a)\<bar> \<le> B}"
  3001   define I where "I \<equiv> \<Union>i \<in> Basis. \<Union>j \<in> C. { (i::'a, j * e / 2 / DIM('a)) }"
  3002   have "finite C"
  3003     using finite_int_segment [of "-B / (e / 2 / DIM('a))" "B / (e / 2 / DIM('a))"]
  3004     apply (simp add: C_def)
  3005     apply (erule rev_finite_subset)
  3006     using \<open>0 < e\<close>
  3007     apply (auto simp: divide_simps)
  3008     done
  3009   then have "finite I"
  3010     by (simp add: I_def)
  3011   obtain \<F>' where eq: "\<Union>\<F>' = \<Union>\<F>" and "finite \<F>'"
  3012               and poly: "\<And>X. X \<in> \<F>' \<Longrightarrow> polytope X"
  3013               and aff: "\<And>X. X \<in> \<F>' \<Longrightarrow> aff_dim X \<le> d"
  3014               and face: "\<And>X Y. \<lbrakk>X \<in> \<F>'; Y \<in> \<F>'\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X \<and> X \<inter> Y face_of Y"
  3015               and I: "\<And>X x y a b.  \<lbrakk>X \<in> \<F>'; x \<in> X; y \<in> X; (a,b) \<in> I\<rbrakk> \<Longrightarrow>
  3016                                      a \<bullet> x \<le> b \<and> a \<bullet> y \<le> b \<or> a \<bullet> x \<ge> b \<and> a \<bullet> y \<ge> b"
  3017               and sub1: "\<And>C. C \<in> \<F>' \<Longrightarrow> \<exists>D. D \<in> \<F> \<and> C \<subseteq> D"
  3018               and sub2: "\<And>C x. C \<in> \<F> \<and> x \<in> C \<Longrightarrow> \<exists>D. D \<in> \<F>' \<and> x \<in> D \<and> D \<subseteq> C"
  3019     apply (rule exE [OF cell_subdivision_lemma])
  3020     using assms \<open>finite I\<close> apply auto
  3021     done
  3022   show ?thesis
  3023   proof (rule_tac \<F>'="\<F>'" in that)
  3024     show "diameter X < e" if "X \<in> \<F>'" for X
  3025     proof -
  3026       have "diameter X \<le> e/2"
  3027       proof (rule diameter_le)
  3028         show "norm (x - y) \<le> e / 2" if "x \<in> X" "y \<in> X" for x y
  3029         proof -
  3030           have "norm x < B" "norm y < B"
  3031             using B \<open>X \<in> \<F>'\<close> eq that by fastforce+
  3032           have "norm (x - y) \<le> (\<Sum>b\<in>Basis. \<bar>(x-y) \<bullet> b\<bar>)"
  3033             by (rule norm_le_l1)
  3034           also have "... \<le> of_nat (DIM('a)) * (e / 2 / DIM('a))"
  3035           proof (rule sum_bounded_above)
  3036             fix i::'a
  3037             assume "i \<in> Basis"
  3038             then have I': "\<And>z b. \<lbrakk>z \<in> C; b = z * e / (2 * real DIM('a))\<rbrakk> \<Longrightarrow> i \<bullet> x \<le> b \<and> i \<bullet> y \<le> b \<or> i \<bullet> x \<ge> b \<and> i \<bullet> y \<ge> b"
  3039               using I \<open>X \<in> \<F>'\<close> that
  3040               by (fastforce simp: I_def)
  3041             show "\<bar>(x - y) \<bullet> i\<bar> \<le> e / 2 / real DIM('a)"
  3042             proof (rule ccontr)
  3043               assume "\<not> \<bar>(x - y) \<bullet> i\<bar> \<le> e / 2 / real DIM('a)"
  3044               then have xyi: "\<bar>i \<bullet> x - i \<bullet> y\<bar> > e / 2 / real DIM('a)"
  3045                 by (simp add: inner_commute inner_diff_right)
  3046               obtain n where "n \<in> \<int>" and n: "i \<bullet> x < n * (e / 2 / real DIM('a)) \<and> n * (e / 2 / real DIM('a)) < i \<bullet> y \<or> i \<bullet> y < n * (e / 2 / real DIM('a)) \<and> n * (e / 2 / real DIM('a)) < i \<bullet> x"
  3047                 using subdivide_interval [OF xyi] DIM_positive \<open>0 < e\<close>
  3048                 by (auto simp: zero_less_divide_iff)
  3049               have "\<bar>i \<bullet> x\<bar> < B"
  3050                 by (metis \<open>i \<in> Basis\<close> \<open>norm x < B\<close> inner_commute norm_bound_Basis_lt)
  3051               have "\<bar>i \<bullet> y\<bar> < B"
  3052                 by (metis \<open>i \<in> Basis\<close> \<open>norm y < B\<close> inner_commute norm_bound_Basis_lt)
  3053               have *: "\<bar>n * e\<bar> \<le> B * (2 * real DIM('a))"
  3054                       if "\<bar>ix\<bar> < B" "\<bar>iy\<bar> < B"
  3055                          and ix: "ix * (2 * real DIM('a)) < n * e"
  3056                          and iy: "n * e < iy * (2 * real DIM('a))" for ix iy
  3057               proof (rule abs_leI)
  3058                 have "iy * (2 * real DIM('a)) \<le> B * (2 * real DIM('a))"
  3059                   by (rule mult_right_mono) (use \<open>\<bar>iy\<bar> < B\<close> in linarith)+
  3060                 then show "n * e \<le> B * (2 * real DIM('a))"
  3061                   using iy by linarith
  3062               next
  3063                 have "- ix * (2 * real DIM('a)) \<le> B * (2 * real DIM('a))"
  3064                   by (rule mult_right_mono) (use \<open>\<bar>ix\<bar> < B\<close> in linarith)+
  3065                 then show "- (n * e) \<le> B * (2 * real DIM('a))"
  3066                   using ix by linarith
  3067               qed
  3068               have "n \<in> C"
  3069                 using \<open>n \<in> \<int>\<close> n  by (auto simp: C_def divide_simps intro: * \<open>\<bar>i \<bullet> x\<bar> < B\<close> \<open>\<bar>i \<bullet> y\<bar> < B\<close>)
  3070               show False
  3071                 using  I' [OF \<open>n \<in> C\<close> refl] n  by auto
  3072             qed
  3073           qed
  3074           also have "... = e / 2"
  3075             by simp
  3076           finally show ?thesis .
  3077         qed
  3078       qed (use \<open>0 < e\<close> in force)
  3079       also have "... < e"
  3080         by (simp add: \<open>0 < e\<close>)
  3081       finally show ?thesis .
  3082     qed
  3083   qed (auto simp: eq poly aff face sub1 sub2 \<open>finite \<F>'\<close>)
  3084 qed
  3087 subsection\<open>Simplexes\<close>
  3089 text\<open>The notion of n-simplex for integer \<^term>\<open>n \<ge> -1\<close>\<close>
  3091 definition%important simplex :: "int \<Rightarrow> 'a::euclidean_space set \<Rightarrow> bool" (infix "simplex" 50)
  3092   where "n simplex S \<equiv> \<exists>C. \<not> affine_dependent C \<and> int(card C) = n + 1 \<and> S = convex hull C"
  3094 lemma simplex:
  3095     "n simplex S \<longleftrightarrow> (\<exists>C. finite C \<and>
  3096                        \<not> affine_dependent C \<and>
  3097                        int(card C) = n + 1 \<and>
  3098                        S = convex hull C)"
  3099   by (auto simp add: simplex_def intro: aff_independent_finite)
  3101 lemma simplex_convex_hull:
  3102    "\<not> affine_dependent C \<and> int(card C) = n + 1 \<Longrightarrow> n simplex (convex hull C)"
  3103   by (auto simp add: simplex_def)
  3105 lemma convex_simplex: "n simplex S \<Longrightarrow> convex S"
  3106   by (metis convex_convex_hull simplex_def)
  3108 lemma compact_simplex: "n simplex S \<Longrightarrow> compact S"
  3109   unfolding simplex
  3110   using finite_imp_compact_convex_hull by blast
  3112 lemma closed_simplex: "n simplex S \<Longrightarrow> closed S"
  3113   by (simp add: compact_imp_closed compact_simplex)
  3115 lemma simplex_imp_polytope:
  3116    "n simplex S \<Longrightarrow> polytope S"
  3117   unfolding simplex_def polytope_def
  3118   using aff_independent_finite by blast
  3120 lemma simplex_imp_polyhedron:
  3121    "n simplex S \<Longrightarrow> polyhedron S"
  3122   by (simp add: polytope_imp_polyhedron simplex_imp_polytope)
  3124 lemma simplex_dim_ge: "n simplex S \<Longrightarrow> -1 \<le> n"
  3125   by (metis (no_types, hide_lams) aff_dim_geq affine_independent_iff_card diff_add_cancel diff_diff_eq2 simplex_def)
  3127 lemma simplex_empty [simp]: "n simplex {} \<longleftrightarrow> n = -1"
  3128 proof
  3129   assume "n simplex {}"
  3130   then show "n = -1"
  3131     unfolding simplex by (metis card_empty convex_hull_eq_empty diff_0 diff_eq_eq of_nat_0)
  3132 next
  3133   assume "n = -1" then show "n simplex {}"
  3134     by (fastforce simp: simplex)
  3135 qed
  3137 lemma simplex_minus_1 [simp]: "-1 simplex S \<longleftrightarrow> S = {}"
  3138   by (metis simplex cancel_comm_monoid_add_class.diff_cancel card_0_eq diff_minus_eq_add of_nat_eq_0_iff simplex_empty)
  3141 lemma aff_dim_simplex:
  3142    "n simplex S \<Longrightarrow> aff_dim S = n"
  3143   by (metis simplex add.commute add_diff_cancel_left' aff_dim_convex_hull affine_independent_iff_card)
  3145 lemma zero_simplex_sing: "0 simplex {a}"
  3146   apply (simp add: simplex_def)
  3147   by (metis affine_independent_1 card_empty card_insert_disjoint convex_hull_singleton empty_iff finite.emptyI)
  3149 lemma simplex_sing [simp]: "n simplex {a} \<longleftrightarrow> n = 0"
  3150   using aff_dim_simplex aff_dim_sing zero_simplex_sing by blast
  3152 lemma simplex_zero: "0 simplex S \<longleftrightarrow> (\<exists>a. S = {a})"
  3153 apply (auto simp: )
  3154   using aff_dim_eq_0 aff_dim_simplex by blast
  3156 lemma one_simplex_segment: "a \<noteq> b \<Longrightarrow> 1 simplex closed_segment a b"
  3157   apply (simp add: simplex_def)
  3158   apply (rule_tac x="{a,b}" in exI)
  3159   apply (auto simp: segment_convex_hull)
  3160   done
  3162 lemma simplex_segment_cases:
  3163    "(if a = b then 0 else 1) simplex closed_segment a b"
  3164   by (auto simp: one_simplex_segment)
  3166 lemma simplex_segment:
  3167    "\<exists>n. n simplex closed_segment a b"
  3168   using simplex_segment_cases by metis
  3170 lemma polytope_lowdim_imp_simplex:
  3171   assumes "polytope P" "aff_dim P \<le> 1"
  3172   obtains n where "n simplex P"
  3173 proof (cases "P = {}")
  3174   case True
  3175   then show ?thesis
  3176     by (simp add: that)
  3177 next
  3178   case False
  3179   then show ?thesis
  3180     by (metis assms compact_convex_collinear_segment collinear_aff_dim polytope_imp_compact polytope_imp_convex simplex_segment_cases that)
  3181 qed
  3183 lemma simplex_insert_dimplus1:
  3184   fixes n::int
  3185   assumes "n simplex S" and a: "a \<notin> affine hull S"
  3186   shows "(n+1) simplex (convex hull (insert a S))"
  3187 proof -
  3188   obtain C where C: "finite C" "\<not> affine_dependent C" "int(card C) = n+1" and S: "S = convex hull C"
  3189     using assms unfolding simplex by force
  3190   show ?thesis
  3191     unfolding simplex
  3192   proof (intro exI conjI)
  3193       have "aff_dim S = n"
  3194         using aff_dim_simplex assms(1) by blast
  3195       moreover have "a \<notin> affine hull C"
  3196         using S a affine_hull_convex_hull by blast
  3197       moreover have "a \<notin> C"
  3198           using S a hull_inc by fastforce
  3199       ultimately show "\<not> affine_dependent (insert a C)"
  3200         by (simp add: C S aff_dim_convex_hull aff_dim_insert affine_independent_iff_card)
  3201   next
  3202     have "a \<notin> C"
  3203       using S a hull_inc by fastforce
  3204     then show "int (card (insert a C)) = n + 1 + 1"
  3205       by (simp add: C)
  3206   next
  3207     show "convex hull insert a S = convex hull (insert a C)"
  3208       by (simp add: S convex_hull_insert_segments)
  3209   qed (use C in auto)
  3210 qed
  3212 subsection \<open>Simplicial complexes and triangulations\<close>
  3214 definition%important simplicial_complex where
  3215  "simplicial_complex \<C> \<equiv>
  3216         finite \<C> \<and>
  3217         (\<forall>S \<in> \<C>. \<exists>n. n simplex S) \<and>
  3218         (\<forall>F S. S \<in> \<C> \<and> F face_of S \<longrightarrow> F \<in> \<C>) \<and>
  3219         (\<forall>S S'. S \<in> \<C> \<and> S' \<in> \<C>
  3220                 \<longrightarrow> (S \<inter> S') face_of S \<and> (S \<inter> S') face_of S')"
  3222 definition%important triangulation where
  3223  "triangulation \<T> \<equiv>
  3224         finite \<T> \<and>
  3225         (\<forall>T \<in> \<T>. \<exists>n. n simplex T) \<and>
  3226         (\<forall>T T'. T \<in> \<T> \<and> T' \<in> \<T>
  3227                 \<longrightarrow> (T \<inter> T') face_of T \<and> (T \<inter> T') face_of T')"
  3230 subsection\<open>Refining a cell complex to a simplicial complex\<close>
  3232 proposition convex_hull_insert_Int_eq:
  3233   fixes z :: "'a :: euclidean_space"
  3234   assumes z: "z \<in> rel_interior S"
  3235       and T: "T \<subseteq> rel_frontier S"
  3236       and U: "U \<subseteq> rel_frontier S"
  3237       and "convex S" "convex T" "convex U"
  3238   shows "convex hull (insert z T) \<inter> convex hull (insert z U) = convex hull (insert z (T \<inter> U))"
  3239     (is "?lhs = ?rhs")
  3240 proof
  3241   show "?lhs \<subseteq> ?rhs"
  3242   proof (cases "T={} \<or> U={}")
  3243     case True then show ?thesis by auto
  3244   next
  3245     case False
  3246     then have "T \<noteq> {}" "U \<noteq> {}" by auto
  3247     have TU: "convex (T \<inter> U)"
  3248       by (simp add: \<open>convex T\<close> \<open>convex U\<close> convex_Int)
  3249     have "(\<Union>x\<in>T. closed_segment z x) \<inter> (\<Union>x\<in>U. closed_segment z x)
  3250           \<subseteq> (if T \<inter> U = {} then {z} else \<Union>((closed_segment z) ` (T \<inter> U)))" (is "_ \<subseteq> ?IF")
  3251     proof clarify
  3252       fix x t u
  3253       assume xt: "x \<in> closed_segment z t"
  3254         and xu: "x \<in> closed_segment z u"
  3255         and "t \<in> T" "u \<in> U"
  3256       then have ne: "t \<noteq> z" "u \<noteq> z"
  3257         using T U z unfolding rel_frontier_def by blast+
  3258       show "x \<in> ?IF"
  3259       proof (cases "x = z")
  3260         case True then show ?thesis by auto
  3261       next
  3262         case False
  3263         have t: "t \<in> closure S"
  3264           using T \<open>t \<in> T\<close> rel_frontier_def by auto
  3265         have u: "u \<in> closure S"
  3266           using U \<open>u \<in> U\<close> rel_frontier_def by auto
  3267         show ?thesis
  3268         proof (cases "t = u")
  3269           case True
  3270           then show ?thesis
  3271             using \<open>t \<in> T\<close> \<open>u \<in> U\<close> xt by auto
  3272         next
  3273           case False
  3274           have tnot: "t \<notin> closed_segment u z"
  3275           proof -
  3276             have "t \<in> closure S - rel_interior S"
  3277               using T \<open>t \<in> T\<close> rel_frontier_def by blast
  3278             then have "t \<notin> open_segment z u"
  3279               by (meson DiffD2 rel_interior_closure_convex_segment [OF \<open>convex S\<close> z u] subsetD)
  3280             then show ?thesis
  3281               by (simp add: \<open>t \<noteq> u\<close> \<open>t \<noteq> z\<close> open_segment_commute open_segment_def)
  3282           qed
  3283           moreover have "u \<notin> closed_segment z t"
  3284             using rel_interior_closure_convex_segment [OF \<open>convex S\<close> z t] \<open>u \<in> U\<close> \<open>u \<noteq> z\<close>
  3285               U [unfolded rel_frontier_def] tnot
  3286             by (auto simp: closed_segment_eq_open)
  3287           ultimately
  3288           have "\<not>(between (t,u) z | between (u,z) t | between (z,t) u)" if "x \<noteq> z"
  3289             using that xt xu
  3290             apply (simp add: between_mem_segment [symmetric])
  3291             by (metis between_commute between_trans_2 between_antisym)
  3292           then have "\<not> collinear {t, z, u}" if "x \<noteq> z"
  3293             by (auto simp: that collinear_between_cases between_commute)
  3294           moreover have "collinear {t, z, x}"
  3295             by (metis closed_segment_commute collinear_2 collinear_closed_segment collinear_triples ends_in_segment(1) insert_absorb insert_absorb2 xt)
  3296           moreover have "collinear {z, x, u}"
  3297             by (metis closed_segment_commute collinear_2 collinear_closed_segment collinear_triples ends_in_segment(1) insert_absorb insert_absorb2 xu)
  3298           ultimately have False
  3299             using collinear_3_trans [of t z x u] \<open>x \<noteq> z\<close> by blast
  3300           then show ?thesis by metis
  3301         qed
  3302       qed
  3303     qed
  3304     then show ?thesis
  3305       using False \<open>convex T\<close> \<open>convex U\<close> TU
  3306       by (simp add: convex_hull_insert_segments hull_same split: if_split_asm)
  3307   qed
  3308   show "?rhs \<subseteq> ?lhs"
  3309     by (metis inf_greatest hull_mono inf.cobounded1 inf.cobounded2 insert_mono)
  3310 qed
  3312 lemma simplicial_subdivision_aux:
  3313   assumes "finite \<M>"
  3314       and "\<And>C. C \<in> \<M> \<Longrightarrow> polytope C"
  3315       and "\<And>C. C \<in> \<M> \<Longrightarrow> aff_dim C \<le> of_nat n"
  3316       and "\<And>C F. \<lbrakk>C \<in> \<M>; F face_of C\<rbrakk> \<Longrightarrow> F \<in> \<M>"
  3317       and "\<And>C1 C2. \<lbrakk>C1 \<in> \<M>; C2 \<in> \<M>\<rbrakk> \<Longrightarrow> C1 \<inter> C2 face_of C1 \<and> C1 \<inter> C2 face_of C2"
  3318     shows "\<exists>\<T>. simplicial_complex \<T> \<and>
  3319                 (\<forall>K \<in> \<T>. aff_dim K \<le> of_nat n) \<and>
  3320                 \<Union>\<T> = \<Union>\<M> \<and>
  3321                 (\<forall>C \<in> \<M>. \<exists>F. finite F \<and> F \<subseteq> \<T> \<and> C = \<Union>F) \<and>
  3322                 (\<forall>K \<in> \<T>. \<exists>C. C \<in> \<M> \<and> K \<subseteq> C)"
  3323   using assms
  3324 proof (induction n arbitrary: \<M> rule: less_induct)
  3325   case (less n)
  3326   then have poly\<M>: "\<And>C. C \<in> \<M> \<Longrightarrow> polytope C"
  3327       and aff\<M>:    "\<And>C. C \<in> \<M> \<Longrightarrow> aff_dim C \<le> of_nat n"
  3328       and face\<M>:   "\<And>C F. \<lbrakk>C \<in> \<M>; F face_of C\<rbrakk> \<Longrightarrow> F \<in> \<M>"
  3329       and intface\<M>: "\<And>C1 C2. \<lbrakk>C1 \<in> \<M>; C2 \<in> \<M>\<rbrakk> \<Longrightarrow> C1 \<inter> C2 face_of C1 \<and> C1 \<inter> C2 face_of C2"
  3330     by metis+
  3331   show ?case
  3332   proof (cases "n \<le> 1")
  3333     case True
  3334     have "\<And>s. \<lbrakk>n \<le> 1; s \<in> \<M>\<rbrakk> \<Longrightarrow> \<exists>m. m simplex s"
  3335       using poly\<M> aff\<M> by (force intro: polytope_lowdim_imp_simplex)
  3336     then show ?thesis
  3337       unfolding simplicial_complex_def
  3338       apply (rule_tac x="\<M>" in exI)
  3339       using True by (auto simp: less.prems)
  3340   next
  3341     case False
  3342     define \<S> where "\<S> \<equiv> {C \<in> \<M>. aff_dim C < n}"
  3343     have "finite \<S>" "\<And>C. C \<in> \<S> \<Longrightarrow> polytope C" "\<And>C. C \<in> \<S> \<Longrightarrow> aff_dim C \<le> int (n - 1)"
  3344          "\<And>C F. \<lbrakk>C \<in> \<S>; F face_of C\<rbrakk> \<Longrightarrow> F \<in> \<S>"
  3345          "\<And>C1 C2. \<lbrakk>C1 \<in> \<S>; C2 \<in> \<S>\<rbrakk>  \<Longrightarrow> C1 \<inter> C2 face_of C1 \<and> C1 \<inter> C2 face_of C2"
  3346       using less.prems
  3347       apply (auto simp: \<S>_def)
  3348       by (metis aff_dim_subset face_of_imp_subset less_le not_le)
  3349     with less.IH [of "n-1" \<S>] False
  3350     obtain \<U> where "simplicial_complex \<U>"
  3351            and aff_dim\<U>: "\<And>K. K \<in> \<U> \<Longrightarrow> aff_dim K \<le> int (n - 1)"
  3352            and        "\<Union>\<U> = \<Union>\<S>"
  3353            and fin\<U>:  "\<And>C. C \<in> \<S> \<Longrightarrow> \<exists>F. finite F \<and> F \<subseteq> \<U> \<and> C = \<Union>F"
  3354            and C\<U>:    "\<And>K. K \<in> \<U> \<Longrightarrow> \<exists>C. C \<in> \<S> \<and> K \<subseteq> C"
  3355       by auto
  3356     then have "finite \<U>"
  3357          and simpl\<U>: "\<And>S. S \<in> \<U> \<Longrightarrow> \<exists>n. n simplex S"
  3358          and face\<U>:  "\<And>F S. \<lbrakk>S \<in> \<U>; F face_of S\<rbrakk> \<Longrightarrow> F \<in> \<U>"
  3359          and faceI\<U>: "\<And>S S'. \<lbrakk>S \<in> \<U>; S' \<in> \<U>\<rbrakk> \<Longrightarrow> (S \<inter> S') face_of S \<and> (S \<inter> S') face_of S'"
  3360       by (auto simp: simplicial_complex_def)
  3361     define \<N> where "\<N> \<equiv> {C \<in> \<M>. aff_dim C = n}"
  3362     have "finite \<N>"
  3363       by (simp add: \<N>_def less.prems(1))
  3364     have poly\<N>: "\<And>C. C \<in> \<N> \<Longrightarrow> polytope C"
  3365       and convex\<N>: "\<And>C. C \<in> \<N> \<Longrightarrow> convex C"
  3366       and closed\<N>: "\<And>C. C \<in> \<N> \<Longrightarrow> closed C"
  3367       by (auto simp: \<N>_def poly\<M> polytope_imp_convex polytope_imp_closed)
  3368     have in_rel_interior: "(SOME z. z \<in> rel_interior C) \<in> rel_interior C" if "C \<in> \<N>" for C
  3369         using that poly\<M> polytope_imp_convex rel_interior_aff_dim some_in_eq by (fastforce simp: \<N>_def)
  3370     have *: "\<exists>T. \<not> affine_dependent T \<and> card T \<le> n \<and> aff_dim K < n \<and> K = convex hull T"
  3371       if "K \<in> \<U>" for K
  3372     proof -
  3373       obtain r where r: "r simplex K"
  3374         using \<open>K \<in> \<U>\<close> simpl\<U> by blast
  3375       have "r = aff_dim K"
  3376         using \<open>r simplex K\<close> aff_dim_simplex by blast
  3377       with r
  3378       show ?thesis
  3379         unfolding simplex_def
  3380         using False \<open>\<And>K. K \<in> \<U> \<Longrightarrow> aff_dim K \<le> int (n - 1)\<close> that by fastforce
  3381     qed
  3382     have ahK_C_disjoint: "affine hull K \<inter> rel_interior C = {}"
  3383       if "C \<in> \<N>" "K \<in> \<U>" "K \<subseteq> rel_frontier C" for C K
  3384     proof -
  3385       have "convex C" "closed C"
  3386         by (auto simp: convex\<N> closed\<N> \<open>C \<in> \<N>\<close>)
  3387       obtain F where F: "F face_of C" and "F \<noteq> C" "K \<subseteq> F"
  3388       proof -
  3389         obtain L where "L \<in> \<S>" "K \<subseteq> L"
  3390           using \<open>K \<in> \<U>\<close> C\<U> by blast
  3391         have "K \<le> rel_frontier C"
  3392           by (simp add: \<open>K \<subseteq> rel_frontier C\<close>)
  3393         also have "... \<le> C"
  3394           by (simp add: \<open>closed C\<close> rel_frontier_def subset_iff)
  3395         finally have "K \<subseteq> C" .
  3396         have "L \<inter> C face_of C"
  3397           using \<N>_def \<S>_def \<open>C \<in> \<N>\<close> \<open>L \<in> \<S>\<close> intface\<M> by auto
  3398         moreover have "L \<inter> C \<noteq> C"
  3399           using \<open>C \<in> \<N>\<close> \<open>L \<in> \<S>\<close>
  3400           apply (clarsimp simp: \<N>_def \<S>_def)
  3401           by (metis aff_dim_subset inf_le1 not_le)
  3402         moreover have "K \<subseteq> L \<inter> C"
  3403           using \<open>C \<in> \<N>\<close> \<open>L \<in> \<S>\<close> \<open>K \<subseteq> C\<close> \<open>K \<subseteq> L\<close>
  3404           by (auto simp: \<N>_def \<S>_def)
  3405         ultimately show ?thesis using that by metis
  3406       qed
  3407       have "affine hull F \<inter> rel_interior C = {}"
  3408         by (rule affine_hull_face_of_disjoint_rel_interior [OF \<open>convex C\<close> F \<open>F \<noteq> C\<close>])
  3409       with hull_mono [OF \<open>K \<subseteq> F\<close>]
  3410       show "affine hull K \<inter> rel_interior C = {}"
  3411         by fastforce
  3412     qed
  3413     let ?\<T> = "(\<Union>C \<in> \<N>. \<Union>K \<in> \<U> \<inter> Pow (rel_frontier C).
  3414                      {convex hull (insert (SOME z. z \<in> rel_interior C) K)})"
  3415     have "\<exists>\<T>. simplicial_complex \<T> \<and>
  3416               (\<forall>K \<in> \<T>. aff_dim K \<le> of_nat n) \<and>
  3417               (\<forall>C \<in> \<M>. \<exists>F. F \<subseteq> \<T> \<and> C = \<Union>F) \<and>
  3418               (\<forall>K \<in> \<T>. \<exists>C. C \<in> \<M> \<and> K \<subseteq> C)"
  3419     proof (rule exI, intro conjI ballI)
  3420       show "simplicial_complex (\<U> \<union> ?\<T>)"
  3421         unfolding simplicial_complex_def
  3422       proof (intro conjI impI ballI allI)
  3423         show "finite (\<U> \<union> ?\<T>)"
  3424           using \<open>finite \<U>\<close> \<open>finite \<N>\<close> by simp
  3425         show "\<exists>n. n simplex S" if "S \<in> \<U> \<union> ?\<T>" for S
  3426           using that ahK_C_disjoint in_rel_interior simpl\<U> simplex_insert_dimplus1 by fastforce
  3427         show "F \<in> \<U> \<union> ?\<T>" if S: "S \<in> \<U> \<union> ?\<T> \<and> F face_of S" for F S
  3428         proof -
  3429           have "F \<in> \<U>" if "S \<in> \<U>"
  3430             using S face\<U> that by blast
  3431           moreover have "F \<in> \<U> \<union> ?\<T>"
  3432             if "F face_of S" "C \<in> \<N>" "K \<in> \<U>" and "K \<subseteq> rel_frontier C"
  3433               and S: "S = convex hull insert (SOME z. z \<in> rel_interior C) K" for C K
  3434           proof -
  3435             let ?z = "SOME z. z \<in> rel_interior C"
  3436             have "?z \<in> rel_interior C"
  3437               by (simp add: in_rel_interior \<open>C \<in> \<N>\<close>)
  3438             moreover
  3439             obtain I where "\<not> affine_dependent I" "card I \<le> n" "aff_dim K < int n" "K = convex hull I"
  3440               using * [OF \<open>K \<in> \<U>\<close>] by auto
  3441             ultimately have "?z \<notin> affine hull I"
  3442               using ahK_C_disjoint affine_hull_convex_hull that by blast
  3443             have "compact I" "finite I"
  3444               by (auto simp: \<open>\<not> affine_dependent I\<close> aff_independent_finite finite_imp_compact)
  3445             moreover have "F face_of convex hull insert ?z I"
  3446               by (metis S \<open>F face_of S\<close> \<open>K = convex hull I\<close> convex_hull_eq_empty convex_hull_insert_segments hull_hull)
  3447             ultimately obtain J where "J \<subseteq> insert ?z I" "F = convex hull J"
  3448               using face_of_convex_hull_subset [of "insert ?z I" F] by auto
  3449             show ?thesis
  3450             proof (cases "?z \<in> J")
  3451               case True
  3452               have "F \<in> (\<Union>K\<in>\<U> \<inter> Pow (rel_frontier C). {convex hull insert ?z K})"
  3453               proof
  3454                 have "convex hull (J - {?z}) face_of K"
  3455                   by (metis True \<open>J \<subseteq> insert ?z I\<close> \<open>K = convex hull I\<close> \<open>\<not> affine_dependent I\<close> face_of_convex_hull_affine_independent subset_insert_iff)
  3456                 then have "convex hull (J - {?z}) \<in> \<U>"
  3457                   by (rule face\<U> [OF \<open>K \<in> \<U>\<close>])
  3458                 moreover
  3459                 have "\<And>x. x \<in> convex hull (J - {?z}) \<Longrightarrow> x \<in> rel_frontier C"
  3460                   by (metis True \<open>J \<subseteq> insert ?z I\<close> \<open>K = convex hull I\<close> subsetD hull_mono subset_insert_iff that(4))
  3461                 ultimately show "convex hull (J - {?z}) \<in> \<U> \<inter> Pow (rel_frontier C)" by auto
  3462                 let ?F = "convex hull insert ?z (convex hull (J - {?z}))"
  3463                 have "F \<subseteq> ?F"
  3464                   apply (clarsimp simp: \<open>F = convex hull J\<close>)
  3465                   by (metis True subsetD hull_mono hull_subset subset_insert_iff)
  3466                 moreover have "?F \<subseteq> F"
  3467                   apply (clarsimp simp: \<open>F = convex hull J\<close>)
  3468                   by (metis (no_types, lifting) True convex_hull_eq_empty convex_hull_insert_segments hull_hull insert_Diff)
  3469                 ultimately
  3470                 show "F \<in> {?F}" by auto
  3471               qed
  3472               with \<open>C\<in>\<N>\<close> show ?thesis by auto
  3473             next
  3474               case False
  3475               then have "F \<in> \<U>"
  3476                 using face_of_convex_hull_affine_independent [OF \<open>\<not> affine_dependent I\<close>]
  3477                 by (metis Int_absorb2 Int_insert_right_if0 \<open>F = convex hull J\<close> \<open>J \<subseteq> insert ?z I\<close> \<open>K = convex hull I\<close> face\<U> inf_le2 \<open>K \<in> \<U>\<close>)
  3478               then show "F \<in> \<U> \<union> ?\<T>"
  3479                 by blast
  3480             qed
  3481           qed
  3482           ultimately show ?thesis
  3483             using that by auto
  3484         qed
  3485         have "(S \<inter> S' face_of S) \<and> (S \<inter> S' face_of S')"
  3486           if "S \<in> \<U> \<union> ?\<T>" "S' \<in> \<U> \<union> ?\<T>" for S S'
  3487         proof -
  3488           have symmy: "\<lbrakk>\<And>X Y. R X Y \<Longrightarrow> R Y X;
  3489                         \<And>X Y. \<lbrakk>X \<in> \<U>; Y \<in> \<U>\<rbrakk> \<Longrightarrow> R X Y;
  3490                         \<And>X Y. \<lbrakk>X \<in> \<U>; Y \<in> ?\<T>\<rbrakk> \<Longrightarrow> R X Y;
  3491                         \<And>X Y. \<lbrakk>X \<in> ?\<T>; Y \<in> ?\<T>\<rbrakk> \<Longrightarrow> R X Y\<rbrakk> \<Longrightarrow> R S S'" for R
  3492             using that by (metis (no_types, lifting) Un_iff)
  3493           show ?thesis
  3494           proof (rule symmy)
  3495             show "Y \<inter> X face_of Y \<and> Y \<inter> X face_of X"
  3496               if "X \<inter> Y face_of X \<and> X \<inter> Y face_of Y" for X Y :: "'a set"
  3497               by (simp add: inf_commute that)
  3498           next
  3499             show "X \<inter> Y face_of X \<and> X \<inter> Y face_of Y"
  3500               if "X \<in> \<U>" and "Y \<in> \<U>" for X Y
  3501               by (simp add: faceI\<U> that)
  3502           next
  3503             show "X \<inter> Y face_of X \<and> X \<inter> Y face_of Y"
  3504               if XY: "X \<in> \<U>" "Y \<in> ?\<T>" for X Y
  3505             proof -
  3506               obtain C K
  3507                 where "C \<in> \<N>" "K \<in> \<U>" "K \<subseteq> rel_frontier C"
  3508                 and Y: "Y = convex hull insert (SOME z. z \<in> rel_interior C) K"
  3509                 using XY by blast
  3510               have "convex C"
  3511                 by (simp add: \<open>C \<in> \<N>\<close> convex\<N>)
  3512               have "K \<subseteq> C"
  3513                 by (metis DiffE \<open>C \<in> \<N>\<close> \<open>K \<subseteq> rel_frontier C\<close> closed\<N> closure_closed rel_frontier_def subset_iff)
  3514               let ?z = "(SOME z. z \<in> rel_interior C)"
  3515               have z: "?z \<in> rel_interior C"
  3516                 using \<open>C \<in> \<N>\<close> in_rel_interior by blast
  3517               obtain D where "D \<in> \<S>" "X \<subseteq> D"
  3518                 using C\<U> \<open>X \<in> \<U>\<close> by blast
  3519               have "D \<inter> rel_interior C = (C \<inter> D) \<inter> rel_interior C"
  3520                 using rel_interior_subset by blast
  3521               also have "(C \<inter> D) \<inter> rel_interior C = {}"
  3522               proof (rule face_of_disjoint_rel_interior)
  3523                 show "C \<inter> D face_of C"
  3524                   using \<N>_def \<S>_def \<open>C \<in> \<N>\<close> \<open>D \<in> \<S>\<close> intface\<M> by blast
  3525                 show "C \<inter> D \<noteq> C"
  3526                   by (metis (mono_tags, lifting) Int_lower2 \<N>_def \<S>_def \<open>C \<in> \<N>\<close> \<open>D \<in> \<S>\<close> aff_dim_subset mem_Collect_eq not_le)
  3527               qed
  3528               finally have DC: "D \<inter> rel_interior C = {}" .
  3529               have eq: "X \<inter> convex hull (insert ?z K) = X \<inter> convex hull K"
  3530                 apply (rule Int_convex_hull_insert_rel_exterior [OF \<open>convex C\<close> \<open>K \<subseteq> C\<close> z])
  3531                 using DC by (meson \<open>X \<subseteq> D\<close> disjnt_def disjnt_subset1)
  3532               obtain I where I: "\<not> affine_dependent I"
  3533                          and Keq: "K = convex hull I" and [simp]: "convex hull K = K"
  3534                 using "*" \<open>K \<in> \<U>\<close> by force
  3535               then have "?z \<notin> affine hull I"
  3536                 using ahK_C_disjoint \<open>C \<in> \<N>\<close> \<open>K \<in> \<U>\<close> \<open>K \<subseteq> rel_frontier C\<close> affine_hull_convex_hull z by blast
  3537               have "X \<inter> K face_of K"
  3538                 by (simp add: \<open>K \<in> \<U>\<close> faceI\<U> \<open>X \<in> \<U>\<close>)
  3539               also have "... face_of convex hull insert ?z K"
  3540                 by (metis I Keq \<open>?z \<notin> affine hull I\<close> aff_independent_finite convex_convex_hull face_of_convex_hull_insert face_of_refl hull_insert)
  3541               finally have "X \<inter> K face_of convex hull insert ?z K" .
  3542               then show ?thesis
  3543                 using "*" \<open>K \<in> \<U>\<close> faceI\<U> that(1) by (fastforce simp add: Y eq)
  3544             qed
  3545           next
  3546             show "X \<inter> Y face_of X \<and> X \<inter> Y face_of Y"
  3547               if XY: "X \<in> ?\<T>" "Y \<in> ?\<T>" for X Y
  3548             proof -
  3549               obtain C K D L
  3550                 where "C \<in> \<N>" "K \<in> \<U>" "K \<subseteq> rel_frontier C"
  3551                 and X: "X = convex hull insert (SOME z. z \<in> rel_interior C) K"
  3552                 and "D \<in> \<N>" "L \<in> \<U>" "L \<subseteq> rel_frontier D"
  3553                 and Y: "Y = convex hull insert (SOME z. z \<in> rel_interior D) L"
  3554                 using XY by blast
  3555               let ?z = "(SOME z. z \<in> rel_interior C)"
  3556               have z: "?z \<in> rel_interior C"
  3557                 using \<open>C \<in> \<N>\<close> in_rel_interior by blast
  3558               have "convex C"
  3559                 by (simp add: \<open>C \<in> \<N>\<close> convex\<N>)
  3560               have "convex K"
  3561                 using "*" \<open>K \<in> \<U>\<close> by blast
  3562               have "convex L"
  3563                 by (meson \<open>L \<in> \<U>\<close> convex_simplex simpl\<U>)
  3564               show ?thesis
  3565               proof (cases "D=C")
  3566                 case True
  3567                 then have "L \<subseteq> rel_frontier C"
  3568                   using \<open>L \<subseteq> rel_frontier D\<close> by auto
  3569                 show ?thesis
  3570                   apply (simp add: X Y True)
  3571                   apply (simp add: convex_hull_insert_Int_eq [OF z] \<open>K \<subseteq> rel_frontier C\<close> \<open>L \<subseteq> rel_frontier C\<close> \<open>convex C\<close> \<open>convex K\<close> \<open>convex L\<close>)
  3572                   using face_of_polytope_insert2
  3573                   by (metis "*" IntI \<open>C \<in> \<N>\<close> \<open>K \<in> \<U>\<close> \<open>L \<in> \<U>\<close>\<open>K \<subseteq> rel_frontier C\<close> \<open>L \<subseteq> rel_frontier C\<close> aff_independent_finite ahK_C_disjoint empty_iff faceI\<U> polytope_convex_hull z)
  3574               next
  3575                 case False
  3576                 have "convex D"
  3577                   by (simp add: \<open>D \<in> \<N>\<close> convex\<N>)
  3578                 have "K \<subseteq> C"
  3579                   by (metis DiffE \<open>C \<in> \<N>\<close> \<open>K \<subseteq> rel_frontier C\<close> closed\<N> closure_closed rel_frontier_def subset_eq)
  3580                 have "L \<subseteq> D"
  3581                   by (metis DiffE \<open>D \<in> \<N>\<close> \<open>L \<subseteq> rel_frontier D\<close> closed\<N> closure_closed rel_frontier_def subset_eq)
  3582                 let ?w = "(SOME w. w \<in> rel_interior D)"
  3583                 have w: "?w \<in> rel_interior D"
  3584                   using \<open>D \<in> \<N>\<close> in_rel_interior by blast
  3585                 have "C \<inter> rel_interior D = (D \<inter> C) \<inter> rel_interior D"
  3586                   using rel_interior_subset by blast
  3587                 also have "(D \<inter> C) \<inter> rel_interior D = {}"
  3588                 proof (rule face_of_disjoint_rel_interior)
  3589                   show "D \<inter> C face_of D"
  3590                     using \<N>_def \<open>C \<in> \<N>\<close> \<open>D \<in> \<N>\<close> intface\<M> by blast
  3591                   have "D \<in> \<M> \<and> aff_dim D = int n"
  3592                     using \<N>_def \<open>D \<in> \<N>\<close> by blast
  3593                   moreover have "C \<in> \<M> \<and> aff_dim C = int n"
  3594                     using \<N>_def \<open>C \<in> \<N>\<close> by blast
  3595                   ultimately show "D \<inter> C \<noteq> D"
  3596                     by (metis False face_of_aff_dim_lt inf.idem inf_le1 intface\<M> not_le poly\<M> polytope_imp_convex)
  3597                 qed
  3598                 finally have CD: "C \<inter> (rel_interior D) = {}" .
  3599                 have zKC: "(convex hull insert ?z K) \<subseteq> C"
  3600                   by (metis DiffE \<open>C \<in> \<N>\<close> \<open>K \<subseteq> rel_frontier C\<close> closed\<N> closure_closed convex\<N> hull_minimal insert_subset rel_frontier_def rel_interior_subset subset_iff z)
  3601                 have eq: "convex hull (insert ?z K) \<inter> convex hull (insert ?w L) =
  3602                           convex hull (insert ?z K) \<inter> convex hull L"
  3603                   apply (rule Int_convex_hull_insert_rel_exterior [OF \<open>convex D\<close> \<open>L \<subseteq> D\<close> w])
  3604                   using zKC CD apply (force simp: disjnt_def)
  3605                   done
  3606                 have ch_id: "convex hull K = K" "convex hull L = L"
  3607                   using "*" \<open>K \<in> \<U>\<close> \<open>L \<in> \<U>\<close> hull_same by auto
  3608                 have "convex C"
  3609                   by (simp add: \<open>C \<in> \<N>\<close> convex\<N>)
  3610                 have "convex hull (insert ?z K) \<inter> L = L \<inter> convex hull (insert ?z K)"
  3611                   by blast
  3612                 also have "... = convex hull K \<inter> L"
  3613                 proof (subst Int_convex_hull_insert_rel_exterior [OF \<open>convex C\<close> \<open>K \<subseteq> C\<close> z])
  3614                   have "(C \<inter> D) \<inter> rel_interior C = {}"
  3615                   proof (rule face_of_disjoint_rel_interior)
  3616                     show "C \<inter> D face_of C"
  3617                       using \<N>_def \<open>C \<in> \<N>\<close> \<open>D \<in> \<N>\<close> intface\<M> by blast
  3618                     have "D \<in> \<M>" "aff_dim D = int n"
  3619                       using \<N>_def \<open>D \<in> \<N>\<close> by fastforce+
  3620                     moreover have "C \<in> \<M>" "aff_dim C = int n"
  3621                       using \<N>_def \<open>C \<in> \<N>\<close> by fastforce+
  3622                     ultimately have "aff_dim D + - 1 * aff_dim C \<le> 0"
  3623                       by fastforce
  3624                     then have "\<not> C face_of D"
  3625                       using False \<open>convex D\<close> face_of_aff_dim_lt by fastforce
  3626                     show "C \<inter> D \<noteq> C"
  3627                       using \<open>C \<in> \<M>\<close> \<open>D \<in> \<M>\<close> \<open>\<not> C face_of D\<close> intface\<M> by fastforce
  3628                   qed
  3629                   then have "D \<inter> rel_interior C = {}"
  3630                     by (metis inf.absorb_iff2 inf_assoc inf_sup_aci(1) rel_interior_subset)
  3631                   then show "disjnt L (rel_interior C)"
  3632                     by (meson \<open>L \<subseteq> D\<close> disjnt_def disjnt_subset1)
  3633                 next
  3634                   show "L \<inter> convex hull K = convex hull K \<inter> L"
  3635                     by force
  3636                 qed
  3637                 finally have chKL: "convex hull (insert ?z K) \<inter> L = convex hull K \<inter> L" .
  3638                 have "convex hull insert ?z K \<inter> convex hull L face_of K"
  3639                   by (simp add: \<open>K \<in> \<U>\<close> \<open>L \<in> \<U>\<close> ch_id chKL faceI\<U>)
  3640                 also have "... face_of convex hull insert ?z K"
  3641                 proof -
  3642                   obtain I where I: "\<not> affine_dependent I" "K = convex hull I"
  3643                     using * [OF \<open>K \<in> \<U>\<close>] by auto
  3644                   then have "\<And>a. a \<notin> rel_interior C \<or> a \<notin> affine hull I"
  3645                     using ahK_C_disjoint \<open>C \<in> \<N>\<close> \<open>K \<in> \<U>\<close> \<open>K \<subseteq> rel_frontier C\<close> affine_hull_convex_hull by blast
  3646                   then show ?thesis
  3647                     by (metis I affine_independent_insert face_of_convex_hull_affine_independent hull_insert subset_insertI z)
  3648                 qed
  3649                 finally have 1: "convex hull insert ?z K \<inter> convex hull L face_of convex hull insert ?z K" .
  3650                 have "convex hull insert ?z K \<inter> convex hull L face_of L"
  3651                   by (simp add: \<open>K \<in> \<U>\<close> \<open>L \<in> \<U>\<close> ch_id chKL faceI\<U>)
  3652                 also have "... face_of convex hull insert ?w L"
  3653                 proof -
  3654                   obtain I where I: "\<not> affine_dependent I" "L = convex hull I"
  3655                     using * [OF \<open>L \<in> \<U>\<close>] by auto
  3656                   then have "\<And>a. a \<notin> rel_interior D \<or> a \<notin> affine hull I"
  3657                     using \<open>D \<in> \<N>\<close> \<open>L \<in> \<U>\<close> \<open>L \<subseteq> rel_frontier D\<close> affine_hull_convex_hull ahK_C_disjoint by blast
  3658                   then show ?thesis
  3659                     by (metis I aff_independent_finite convex_convex_hull face_of_convex_hull_insert face_of_refl hull_insert w)
  3660                 qed
  3661                 finally have 2: "convex hull insert ?z K \<inter> convex hull L face_of convex hull insert ?w L" .
  3662                 show ?thesis
  3663                   by (simp add: X Y eq 1 2)
  3664               qed
  3665             qed
  3666           qed
  3667         qed
  3668         then
  3669         show "S \<inter> S' face_of S" "S \<inter> S' face_of S'" if "S \<in> \<U> \<union> ?\<T> \<and> S' \<in> \<U> \<union> ?\<T>" for S S'
  3670           using that by auto
  3671       qed
  3672       show "\<exists>F \<subseteq> \<U> \<union> ?\<T>. C = \<Union>F" if "C \<in> \<M>" for C
  3673       proof (cases "C \<in> \<S>")
  3674         case True
  3675         then show ?thesis
  3676           by (meson UnCI fin\<U> subsetD subsetI)
  3677       next
  3678         case False
  3679         then have "C \<in> \<N>"
  3680           by (simp add: \<N>_def \<S>_def aff\<M> less_le that)
  3681         let ?z = "SOME z. z \<in> rel_interior C"
  3682         have z: "?z \<in> rel_interior C"
  3683           using \<open>C \<in> \<N>\<close> in_rel_interior by blast
  3684         let ?F = "\<Union>K \<in> \<U> \<inter> Pow (rel_frontier C). {convex hull (insert ?z K)}"
  3685         have "?F \<subseteq> ?\<T>"
  3686           using \<open>C \<in> \<N>\<close> by blast
  3687         moreover have "C \<subseteq> \<Union>?F"
  3688         proof
  3689           fix x
  3690           assume "x \<in> C"
  3691           have "convex C"
  3692             using \<open>C \<in> \<N>\<close> convex\<N> by blast
  3693           have "bounded C"
  3694             using \<open>C \<in> \<N>\<close> by (simp add: poly\<M> polytope_imp_bounded that)
  3695           have "polytope C"
  3696             using \<open>C \<in> \<N>\<close> poly\<N> by auto
  3697           have "\<not> (?z = x \<and> C = {?z})"
  3698             using \<open>C \<in> \<N>\<close> aff_dim_sing [of ?z] \<open>\<not> n \<le> 1\<close> by (force simp: \<N>_def)
  3699           then obtain y where y: "y \<in> rel_frontier C" and xzy: "x \<in> closed_segment ?z y"
  3700             and sub: "open_segment ?z y \<subseteq> rel_interior C"
  3701             by (blast intro: segment_to_rel_frontier [OF \<open>convex C\<close> \<open>bounded C\<close> z \<open>x \<in> C\<close>])
  3702           then obtain F where "y \<in> F" "F face_of C" "F \<noteq> C"
  3703             by (auto simp: rel_frontier_of_polyhedron_alt [OF polytope_imp_polyhedron [OF \<open>polytope C\<close>]])
  3704           then obtain \<G> where "finite \<G>" "\<G> \<subseteq> \<U>" "F = \<Union>\<G>"
  3705             by (metis (mono_tags, lifting) \<S>_def \<open>C \<in> \<M>\<close> \<open>convex C\<close> aff\<M> face\<M> face_of_aff_dim_lt fin\<U> le_less_trans mem_Collect_eq not_less)
  3706           then obtain K where "y \<in> K" "K \<in> \<G>"
  3707             using \<open>y \<in> F\<close> by blast
  3708           moreover have x: "x \<in> convex hull {?z,y}"
  3709             using segment_convex_hull xzy by auto
  3710           moreover have "convex hull {?z,y} \<subseteq> convex hull insert ?z K"
  3711             by (metis (full_types) \<open>y \<in> K\<close> hull_mono empty_subsetI insertCI insert_subset)
  3712           moreover have "K \<in> \<U>"
  3713             using \<open>K \<in> \<G>\<close> \<open>\<G> \<subseteq> \<U>\<close> by blast
  3714           moreover have "K \<subseteq> rel_frontier C"
  3715             using \<open>F = \<Union>\<G>\<close> \<open>F \<noteq> C\<close> \<open>F face_of C\<close> \<open>K \<in> \<G>\<close> face_of_subset_rel_frontier by fastforce
  3716           ultimately show "x \<in> \<Union>?F"
  3717             by force
  3718         qed
  3719         moreover
  3720         have "convex hull insert (SOME z. z \<in> rel_interior C) K \<subseteq> C"
  3721           if "K \<in> \<U>" "K \<subseteq> rel_frontier C" for K
  3722         proof (rule hull_minimal)
  3723           show "insert (SOME z. z \<in> rel_interior C) K \<subseteq> C"
  3724             using that \<open>C \<in> \<N>\<close> in_rel_interior rel_interior_subset
  3725             by (force simp: closure_eq rel_frontier_def closed\<N>)
  3726           show "convex C"
  3727             by (simp add: \<open>C \<in> \<N>\<close> convex\<N>)
  3728         qed
  3729         then have "\<Union>?F \<subseteq> C"
  3730           by auto
  3731         ultimately show ?thesis
  3732           by blast
  3733       qed
  3735       have "(\<exists>C. C \<in> \<M> \<and> L \<subseteq> C) \<and> aff_dim L \<le> int n"  if "L \<in> \<U> \<union> ?\<T>" for L
  3736         using that
  3737       proof
  3738         assume "L \<in> \<U>"
  3739         then show ?thesis
  3740           using C\<U> \<S>_def "*" by fastforce
  3741       next
  3742         assume "L \<in> ?\<T>"
  3743         then obtain C K where "C \<in> \<N>"
  3744           and L: "L = convex hull insert (SOME z. z \<in> rel_interior C) K"
  3745           and K: "K \<in> \<U>" "K \<subseteq> rel_frontier C"
  3746           by auto
  3747         then have "convex hull C = C"
  3748           by (meson convex\<N> convex_hull_eq)
  3749         then have "convex C"
  3750           by (metis (no_types) convex_convex_hull)
  3751         have "rel_frontier C \<subseteq> C"
  3752           by (metis DiffE closed\<N> \<open>C \<in> \<N>\<close> closure_closed rel_frontier_def subsetI)
  3753         have "K \<subseteq> C"
  3754           using K \<open>rel_frontier C \<subseteq> C\<close> by blast
  3755         have "C \<in> \<M>"
  3756           using \<N>_def \<open>C \<in> \<N>\<close> by auto
  3757         moreover have "L \<subseteq> C"
  3758           using K L \<open>C \<in> \<N>\<close>
  3759           by (metis \<open>K \<subseteq> C\<close> \<open>convex hull C = C\<close> contra_subsetD hull_mono in_rel_interior insert_subset rel_interior_subset)
  3760         ultimately show ?thesis
  3761           using \<open>rel_frontier C \<subseteq> C\<close> \<open>L \<subseteq> C\<close> aff\<M> aff_dim_subset \<open>C \<in> \<M>\<close> dual_order.trans by blast
  3762       qed
  3763       then show "\<exists>C. C \<in> \<M> \<and> L \<subseteq> C" "aff_dim L \<le> int n" if "L \<in> \<U> \<union> ?\<T>" for L
  3764         using that by auto
  3765     qed
  3766     then show ?thesis
  3767       apply (rule ex_forward, safe)
  3768         apply (meson Union_iff subsetCE, fastforce)
  3769       by (meson infinite_super simplicial_complex_def)
  3770   qed
  3771 qed
  3774 lemma simplicial_subdivision_of_cell_complex_lowdim:
  3775   assumes "finite \<M>"
  3776       and poly: "\<And>C. C \<in> \<M> \<Longrightarrow> polytope C"
  3777       and face: "\<And>C1 C2. \<lbrakk>C1 \<in> \<M>; C2 \<in> \<M>\<rbrakk> \<Longrightarrow> C1 \<inter> C2 face_of C1 \<and> C1 \<inter> C2 face_of C2"
  3778       and aff: "\<And>C. C \<in> \<M> \<Longrightarrow> aff_dim C \<le> d"
  3779   obtains \<T> where "simplicial_complex \<T>" "\<And>K. K \<in> \<T> \<Longrightarrow> aff_dim K \<le> d"
  3780                   "\<Union>\<T> = \<Union>\<M>"
  3781                   "\<And>C. C \<in> \<M> \<Longrightarrow> \<exists>F. finite F \<and> F \<subseteq> \<T> \<and> C = \<Union>F"
  3782                   "\<And>K. K \<in> \<T> \<Longrightarrow> \<exists>C. C \<in> \<M> \<and> K \<subseteq> C"
  3783 proof (cases "d \<ge> 0")
  3784   case True
  3785   then obtain n where n: "d = of_nat n"
  3786     using zero_le_imp_eq_int by blast
  3787   have "\<exists>\<T>. simplicial_complex \<T> \<and>
  3788             (\<forall>K\<in>\<T>. aff_dim K \<le> int n) \<and>
  3789             \<Union>\<T> = \<Union>(\<Union>C\<in>\<M>. {F. F face_of C}) \<and>
  3790             (\<forall>C\<in>\<Union>C\<in>\<M>. {F. F face_of C}.
  3791                 \<exists>F. finite F \<and> F \<subseteq> \<T> \<and> C = \<Union>F) \<and>
  3792             (\<forall>K\<in>\<T>. \<exists>C. C \<in> (\<Union>C\<in>\<M>. {F. F face_of C}) \<and> K \<subseteq> C)"
  3793   proof (rule simplicial_subdivision_aux)
  3794     show "finite (\<Union>C\<in>\<M>. {F. F face_of C})"
  3795       using \<open>finite \<M>\<close> poly polyhedron_eq_finite_faces polytope_imp_polyhedron by fastforce
  3796     show "polytope F" if "F \<in> (\<Union>C\<in>\<M>. {F. F face_of C})" for F
  3797       using poly that face_of_polytope_polytope by blast
  3798     show "aff_dim F \<le> int n" if "F \<in> (\<Union>C\<in>\<M>. {F. F face_of C})" for F
  3799       using that
  3800       by clarify (metis n aff_dim_subset aff face_of_imp_subset order_trans)
  3801     show "F \<in> (\<Union>C\<in>\<M>. {F. F face_of C})"
  3802       if "G \<in> (\<Union>C\<in>\<M>. {F. F face_of C})" and "F face_of G" for F G
  3803       using that face_of_trans by blast
  3804   next
  3805     show "F1 \<inter> F2 face_of F1 \<and> F1 \<inter> F2 face_of F2"
  3806       if "F1 \<in> (\<Union>C\<in>\<M>. {F. F face_of C})" and "F2 \<in> (\<Union>C\<in>\<M>. {F. F face_of C})" for F1 F2
  3807       using that
  3808       by safe (meson face face_of_Int_subface)+
  3809   qed
  3810   moreover
  3811   have "\<Union>(\<Union>C\<in>\<M>. {F. F face_of C}) = \<Union>\<M>"
  3812     using face_of_imp_subset face by blast
  3813   ultimately show ?thesis
  3814     apply clarify
  3815     apply (rule that, assumption+)
  3816        using n apply blast
  3817       apply (simp_all add: poly face_of_refl polytope_imp_convex)
  3818     using face_of_imp_subset by fastforce
  3819 next
  3820   case False
  3821   then have m1: "\<And>C. C \<in> \<M> \<Longrightarrow> aff_dim C = -1"
  3822     by (metis aff aff_dim_empty_eq aff_dim_negative_iff dual_order.trans not_less)
  3823   then have face\<M>: "\<And>F S. \<lbrakk>S \<in> \<M>; F face_of S\<rbrakk> \<Longrightarrow> F \<in> \<M>"
  3824     by (metis aff_dim_empty face_of_empty)
  3825   show ?thesis
  3826   proof
  3827     have "\<And>S. S \<in> \<M> \<Longrightarrow> \<exists>n. n simplex S"
  3828       by (metis (no_types) m1 aff_dim_empty simplex_minus_1)
  3829     then show "simplicial_complex \<M>"
  3830       by (auto simp: simplicial_complex_def \<open>finite \<M>\<close> face intro: face\<M>)
  3831     show "aff_dim K \<le> d" if "K \<in> \<M>" for K
  3832       by (simp add: that aff)
  3833     show "\<exists>F. finite F \<and> F \<subseteq> \<M> \<and> C = \<Union>F" if "C \<in> \<M>" for C
  3834       using \<open>C \<in> \<M>\<close> equals0I by auto
  3835     show "\<exists>C. C \<in> \<M> \<and> K \<subseteq> C" if "K \<in> \<M>" for K
  3836       using \<open>K \<in> \<M>\<close> by blast
  3837   qed auto
  3838 qed
  3840 proposition simplicial_subdivision_of_cell_complex:
  3841   assumes "finite \<M>"
  3842       and poly: "\<And>C. C \<in> \<M> \<Longrightarrow> polytope C"
  3843       and face: "\<And>C1 C2. \<lbrakk>C1 \<in> \<M>; C2 \<in> \<M>\<rbrakk> \<Longrightarrow> C1 \<inter> C2 face_of C1 \<and> C1 \<inter> C2 face_of C2"
  3844   obtains \<T> where "simplicial_complex \<T>"
  3845                   "\<Union>\<T> = \<Union>\<M>"
  3846                   "\<And>C. C \<in> \<M> \<Longrightarrow> \<exists>F. finite F \<and> F \<subseteq> \<T> \<and> C = \<Union>F"
  3847                   "\<And>K. K \<in> \<T> \<Longrightarrow> \<exists>C. C \<in> \<M> \<and> K \<subseteq> C"
  3848   by (blast intro: simplicial_subdivision_of_cell_complex_lowdim [OF assms aff_dim_le_DIM])
  3850 corollary fine_simplicial_subdivision_of_cell_complex:
  3851   assumes "0 < e" "finite \<M>"
  3852       and poly: "\<And>C. C \<in> \<M> \<Longrightarrow> polytope C"
  3853       and face: "\<And>C1 C2. \<lbrakk>C1 \<in> \<M>; C2 \<in> \<M>\<rbrakk> \<Longrightarrow> C1 \<inter> C2 face_of C1 \<and> C1 \<inter> C2 face_of C2"
  3854   obtains \<T> where "simplicial_complex \<T>"
  3855                   "\<And>K. K \<in> \<T> \<Longrightarrow> diameter K < e"
  3856                   "\<Union>\<T> = \<Union>\<M>"
  3857                   "\<And>C. C \<in> \<M> \<Longrightarrow> \<exists>F. finite F \<and> F \<subseteq> \<T> \<and> C = \<Union>F"
  3858                   "\<And>K. K \<in> \<T> \<Longrightarrow> \<exists>C. C \<in> \<M> \<and> K \<subseteq> C"
  3859 proof -
  3860   obtain \<N> where \<N>: "finite \<N>" "\<Union>\<N> = \<Union>\<M>" 
  3861               and diapoly: "\<And>X. X \<in> \<N> \<Longrightarrow> diameter X < e" "\<And>X. X \<in> \<N> \<Longrightarrow> polytope X"
  3862                and      "\<And>X Y. \<lbrakk>X \<in> \<N>; Y \<in> \<N>\<rbrakk> \<Longrightarrow> X \<inter> Y face_of X \<and> X \<inter> Y face_of Y"
  3863                and \<N>covers: "\<And>C x. C \<in> \<M> \<and> x \<in> C \<Longrightarrow> \<exists>D. D \<in> \<N> \<and> x \<in> D \<and> D \<subseteq> C"
  3864                and \<N>covered: "\<And>C. C \<in> \<N> \<Longrightarrow> \<exists>D. D \<in> \<M> \<and> C \<subseteq> D"
  3865     by (blast intro: cell_complex_subdivision_exists [OF \<open>0 < e\<close> \<open>finite \<M>\<close> poly aff_dim_le_DIM face])
  3866   then obtain \<T> where \<T>: "simplicial_complex \<T>" "\<Union>\<T> = \<Union>\<N>"
  3867                    and \<T>covers: "\<And>C. C \<in> \<N> \<Longrightarrow> \<exists>F. finite F \<and> F \<subseteq> \<T> \<and> C = \<Union>F"
  3868                    and \<T>covered: "\<And>K. K \<in> \<T> \<Longrightarrow> \<exists>C. C \<in> \<N> \<and> K \<subseteq> C"
  3869     using simplicial_subdivision_of_cell_complex [OF \<open>finite \<N>\<close>] by metis
  3870   show ?thesis
  3871   proof
  3872     show "simplicial_complex \<T>"
  3873       by (rule \<T>)
  3874     show "diameter K < e" if "K \<in> \<T>" for K
  3875       by (metis le_less_trans diapoly \<T>covered diameter_subset polytope_imp_bounded that)
  3876     show "\<Union>\<T> = \<Union>\<M>"
  3877       by (simp add: \<N>(2) \<open>\<Union>\<T> = \<Union>\<N>\<close>)
  3878     show "\<exists>F. finite F \<and> F \<subseteq> \<T> \<and> C = \<Union>F" if "C \<in> \<M>" for C
  3879     proof -
  3880       { fix x
  3881         assume "x \<in> C"
  3882         then obtain D where "D \<in> \<T>" "x \<in> D" "D \<subseteq> C"
  3883           using \<N>covers \<open>C \<in> \<M>\<close> \<T>covers by force
  3884         then have "\<exists>X\<in>\<T> \<inter> Pow C. x \<in> X"
  3885           using \<open>D \<in> \<T>\<close> \<open>D \<subseteq> C\<close> \<open>x \<in> D\<close> by blast
  3886       }
  3887       moreover
  3888       have "finite (\<T> \<inter> Pow C)"
  3889         using \<open>simplicial_complex \<T>\<close> simplicial_complex_def by auto
  3890       ultimately show ?thesis
  3891         by (rule_tac x="(\<T> \<inter> Pow C)" in exI) auto
  3892     qed
  3893     show "\<exists>C. C \<in> \<M> \<and> K \<subseteq> C" if "K \<in> \<T>" for K
  3894       by (meson \<N>covered \<T>covered order_trans that)
  3895   qed
  3896 qed
  3898 subsection\<open>Some results on cell division with full-dimensional cells only\<close>
  3900 lemma convex_Union_fulldim_cells:
  3901   assumes "finite \<S>" and clo: "\<And>C. C \<in> \<S> \<Longrightarrow> closed C" and con: "\<And>C. C \<in> \<S> \<Longrightarrow> convex C"
  3902       and eq: "\<Union>\<S> = U"and  "convex U"
  3903  shows "\<Union>{C \<in> \<S>. aff_dim C = aff_dim U} = U"  (is "?lhs = U")
  3904 proof -
  3905   have "closed U"
  3906     using \<open>finite \<S>\<close> clo eq by blast
  3907   have "?lhs \<subseteq> U"
  3908     using eq by blast
  3909   moreover have "U \<subseteq> ?lhs"
  3910   proof (cases "\<forall>C \<in> \<S>. aff_dim C = aff_dim U")
  3911     case True
  3912     then show ?thesis
  3913       using eq by blast
  3914   next
  3915     case False
  3916     have "closed ?lhs"
  3917       by (simp add: \<open>finite \<S>\<close> clo closed_Union)
  3918     moreover have "U \<subseteq> closure ?lhs"
  3919     proof -
  3920       have "U \<subseteq> closure(\<Inter>{U - C |C. C \<in> \<S> \<and> aff_dim C < aff_dim U})"
  3921       proof (rule Baire [OF \<open>closed U\<close>])
  3922         show "countable {U - C |C. C \<in> \<S> \<and> aff_dim C < aff_dim U}"
  3923           using \<open>finite \<S>\<close> uncountable_infinite by fastforce
  3924         have "\<And>C. C \<in> \<S> \<Longrightarrow> openin (top_of_set U) (U-C)"
  3925           by (metis Sup_upper clo closed_limpt closedin_limpt eq openin_diff openin_subtopology_self)
  3926         then show "openin (top_of_set U) T \<and> U \<subseteq> closure T"
  3927           if "T \<in> {U - C |C. C \<in> \<S> \<and> aff_dim C < aff_dim U}" for T
  3928           using that dense_complement_convex_closed \<open>closed U\<close> \<open>convex U\<close> by auto
  3929       qed
  3930       also have "... \<subseteq> closure ?lhs"
  3931       proof -
  3932         obtain C where "C \<in> \<S>" "aff_dim C < aff_dim U"
  3933           by (metis False Sup_upper aff_dim_subset eq eq_iff not_le)
  3934         have "\<exists>X. X \<in> \<S> \<and> aff_dim X = aff_dim U \<and> x \<in> X"
  3935           if "\<And>V. (\<exists>C. V = U - C \<and> C \<in> \<S> \<and> aff_dim C < aff_dim U) \<Longrightarrow> x \<in> V" for x
  3936         proof -
  3937           have "x \<in> U \<and> x \<in> \<Union>\<S>"
  3938             using \<open>C \<in> \<S>\<close> \<open>aff_dim C < aff_dim U\<close> eq that by blast
  3939           then show ?thesis
  3940             by (metis Diff_iff Sup_upper Union_iff aff_dim_subset dual_order.order_iff_strict eq that)
  3941         qed
  3942         then show ?thesis
  3943           by (auto intro!: closure_mono)
  3944       qed
  3945       finally show ?thesis .
  3946     qed
  3947     ultimately show ?thesis
  3948       using closure_subset_eq by blast
  3949   qed
  3950   ultimately show ?thesis by blast
  3951 qed
  3953 proposition fine_triangular_subdivision_of_cell_complex:
  3954   assumes "0 < e" "finite \<M>"
  3955       and poly: "\<And>C. C \<in> \<M> \<Longrightarrow> polytope C"
  3956       and aff: "\<And>C. C \<in> \<M> \<Longrightarrow> aff_dim C = d"
  3957       and face: "\<And>C1 C2. \<lbrakk>C1 \<in> \<M>; C2 \<in> \<M>\<rbrakk> \<Longrightarrow> C1 \<inter> C2 face_of C1 \<and> C1 \<inter> C2 face_of C2"
  3958   obtains \<T> where "triangulation \<T>" "\<And>k. k \<in> \<T> \<Longrightarrow> diameter k < e"
  3959                  "\<And>k. k \<in> \<T> \<Longrightarrow> aff_dim k = d" "\<Union>\<T> = \<Union>\<M>"
  3960                  "\<And>C. C \<in> \<M> \<Longrightarrow> \<exists>f. finite f \<and> f \<subseteq> \<T> \<and> C = \<Union>f"
  3961                  "\<And>k. k \<in> \<T> \<Longrightarrow> \<exists>C. C \<in> \<M> \<and> k \<subseteq> C"
  3962 proof -
  3963   obtain \<T> where "simplicial_complex \<T>"
  3964              and dia\<T>: "\<And>K. K \<in> \<T> \<Longrightarrow> diameter K < e"
  3965              and "\<Union>\<T> = \<Union>\<M>"
  3966              and in\<M>: "\<And>C. C \<in> \<M> \<Longrightarrow> \<exists>F. finite F \<and> F \<subseteq> \<T> \<and> C = \<Union>F"
  3967              and in\<T>: "\<And>K. K \<in> \<T> \<Longrightarrow> \<exists>C. C \<in> \<M> \<and> K \<subseteq> C"
  3968     by (blast intro: fine_simplicial_subdivision_of_cell_complex [OF \<open>e > 0\<close> \<open>finite \<M>\<close> poly face])
  3969   let ?\<T> = "{K \<in> \<T>. aff_dim K = d}"
  3970   show thesis
  3971   proof
  3972     show "triangulation ?\<T>"
  3973       using \<open>simplicial_complex \<T>\<close> by (auto simp: triangulation_def simplicial_complex_def)
  3974     show "diameter L < e" if "L \<in> {K \<in> \<T>. aff_dim K = d}" for L
  3975       using that by (auto simp: dia\<T>)
  3976     show "aff_dim L = d" if "L \<in> {K \<in> \<T>. aff_dim K = d}" for L
  3977       using that by auto
  3978     show "\<exists>F. finite F \<and> F \<subseteq> {K \<in> \<T>. aff_dim K = d} \<and> C = \<Union>F" if "C \<in> \<M>" for C
  3979     proof -
  3980       obtain F where "finite F" "F \<subseteq> \<T>" "C = \<Union>F"
  3981         using in\<M> [OF \<open>C \<in> \<M>\<close>] by auto
  3982       show ?thesis
  3983       proof (intro exI conjI)
  3984         show "finite {K \<in> F. aff_dim K = d}"
  3985           by (simp add: \<open>finite F\<close>)
  3986         show "{K \<in> F. aff_dim K = d} \<subseteq> {K \<in> \<T>. aff_dim K = d}"
  3987           using \<open>F \<subseteq> \<T>\<close> by blast
  3988         have "d = aff_dim C"
  3989           by (simp add: aff that)
  3990         moreover have "\<And>K. K \<in> F \<Longrightarrow> closed K \<and> convex K"
  3991           using \<open>simplicial_complex \<T>\<close> \<open>F \<subseteq> \<T>\<close>
  3992           unfolding simplicial_complex_def by (metis subsetCE \<open>F \<subseteq> \<T>\<close> closed_simplex convex_simplex)
  3993         moreover have "convex (\<Union>F)"
  3994           using \<open>C = \<Union>F\<close> poly polytope_imp_convex that by blast
  3995         ultimately show "C = \<Union>{K \<in> F. aff_dim K = d}"
  3996           by (simp add: convex_Union_fulldim_cells \<open>C = \<Union>F\<close> \<open>finite F\<close>)
  3997       qed
  3998     qed
  3999     then show "\<Union>{K \<in> \<T>. aff_dim K = d} = \<Union>\<M>"
  4000       by auto (meson in\<T> subsetCE)
  4001     show "\<exists>C. C \<in> \<M> \<and> L \<subseteq> C"
  4002       if "L \<in> {K \<in> \<T>. aff_dim K = d}" for L
  4003       using that by (auto simp: in\<T>)
  4004   qed
  4005 qed
  4007 end