Multivariate/polytope.ml

   1 (* ========================================================================= *)
   2 (* Faces, extreme points, polytopes, polyhedra etc.                          *)
   3 (* ========================================================================= *)
   4
   5 needs "Multivariate/paths.ml";;
   6
   7 (* ------------------------------------------------------------------------- *)
   8 (* Faces of a (usually convex) set.                                          *)
   9 (* ------------------------------------------------------------------------- *)
  10
  11 parse_as_infix("face_of",(12,"right"));;
  12
  13 let face_of = new_definition
  14  `t face_of s <=>
  15         t SUBSET s /\ convex t /\
  16         !a b x. a IN s /\ b IN s /\ x IN t /\ x IN segment(a,b)
  17                 ==> a IN t /\ b IN t`;;
  18
  19 let FACE_OF_TRANSLATION_EQ = prove
  20  (`!a f s:real^N->bool.
  21         (IMAGE (\x. a + x) f) face_of (IMAGE (\x. a + x) s) <=> f face_of s`,
  22   REWRITE_TAC[face_of] THEN GEOM_TRANSLATE_TAC[]);;
  23
  24 add_translation_invariants [FACE_OF_TRANSLATION_EQ];;
  25
  26 let FACE_OF_LINEAR_IMAGE = prove
  27  (`!f:real^M->real^N c s.
  28       linear f /\ (!x y. f x = f y ==> x = y)
  29       ==> ((IMAGE f c) face_of (IMAGE f s) <=> c face_of s)`,
  30   REWRITE_TAC[face_of; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
  31   REPEAT STRIP_TAC THEN MP_TAC(end_itlist CONJ
  32    (mapfilter (ISPEC `f:real^M->real^N`) (!invariant_under_linear))) THEN
  33   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);;
  34
  35 add_linear_invariants [FACE_OF_LINEAR_IMAGE];;
  36
  37 let FACE_OF_REFL = prove
  38  (`!s. convex s ==> s face_of s`,
  39   SIMP_TAC[face_of] THEN SET_TAC[]);;
  40
  41 let FACE_OF_REFL_EQ = prove
  42  (`!s. s face_of s <=> convex s`,
  43   SIMP_TAC[face_of] THEN SET_TAC[]);;
  44
  45 let EMPTY_FACE_OF = prove
  46  (`!s. {} face_of s`,
  47   REWRITE_TAC[face_of; CONVEX_EMPTY] THEN SET_TAC[]);;
  48
  49 let FACE_OF_EMPTY = prove
  50  (`!s. s face_of {} <=> s = {}`,
  51   REWRITE_TAC[face_of; SUBSET_EMPTY; NOT_IN_EMPTY] THEN
  52   MESON_TAC[CONVEX_EMPTY]);;
  53
  54 let FACE_OF_TRANS = prove
  55  (`!s t u. s face_of t /\ t face_of u
  56            ==> s face_of u`,
  57   REWRITE_TAC[face_of] THEN SET_TAC[]);;
  58
  59 let FACE_OF_FACE = prove
  60  (`!f s t.
  61         t face_of s
  62         ==> (f face_of t <=> f face_of s /\ f SUBSET t)`,
  63   REWRITE_TAC[face_of] THEN SET_TAC[]);;
  64
  65 let FACE_OF_SUBSET = prove
  66  (`!f s t. f face_of s /\ f SUBSET t /\ t SUBSET s ==> f face_of t`,
  67   REWRITE_TAC[face_of] THEN SET_TAC[]);;
  68
  69 let FACE_OF_SLICE = prove
  70  (`!f s t.
  71         f face_of s /\ convex t
  72         ==> (f INTER t) face_of (s INTER t)`,
  73   REPEAT GEN_TAC THEN REWRITE_TAC[face_of; IN_INTER] THEN STRIP_TAC THEN
  74   REPEAT CONJ_TAC THENL
  75    [ASM SET_TAC[];
  76     ASM_MESON_TAC[CONVEX_INTER];
  77     ASM_MESON_TAC[]]);;
  78
  79 let FACE_OF_INTER = prove
  80  (`!s t1 t2. t1 face_of s /\ t2 face_of s
  81              ==> (t1 INTER t2) face_of s`,
  82   SIMP_TAC[face_of; CONVEX_INTER] THEN SET_TAC[]);;
  83
  84 let FACE_OF_INTERS = prove
  85  (`!P s. ~(P = {}) /\ (!t. t IN P ==> t face_of s)
  86          ==> (INTERS P) face_of s`,
  87   REWRITE_TAC[face_of] THEN REPEAT STRIP_TAC THENL
  88    [ASM SET_TAC[]; ASM_SIMP_TAC[CONVEX_INTERS]; ASM SET_TAC[]; ASM SET_TAC[]]);;
  89
  90 let FACE_OF_INTER_INTER = prove
  91  (`!f t f' t'.
  92      f face_of t /\ f' face_of t' ==> (f INTER f') face_of (t INTER t')`,
  93   REWRITE_TAC[face_of; SUBSET; IN_INTER] THEN MESON_TAC[CONVEX_INTER]);;
  94
  95 let FACE_OF_STILLCONVEX = prove
  96  (`!s t:real^N->bool.
  97         convex s
  98         ==> (t face_of s <=>
  99              t SUBSET s /\
 100              convex(s DIFF t) /\
 101              t = (affine hull t) INTER s)`,
 102   REPEAT STRIP_TAC THEN REWRITE_TAC[face_of] THEN
 103   ASM_CASES_TAC `(t:real^N->bool) SUBSET s` THEN ASM_REWRITE_TAC[] THEN
 104   EQ_TAC THEN STRIP_TAC THENL
 105    [CONJ_TAC THENL
 106      [REPEAT(POP_ASSUM MP_TAC) THEN
 107       REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; open_segment; IN_DIFF] THEN
 108       REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; SUBSET_DIFF] THEN SET_TAC[];
 109       ALL_TAC] THEN
 110     REWRITE_TAC[EXTENSION] THEN X_GEN_TAC `x:real^N` THEN EQ_TAC THENL
 111      [ASM MESON_TAC[HULL_INC; SUBSET; IN_INTER]; ALL_TAC] THEN
 112     ASM_CASES_TAC `t:real^N -> bool = {}` THEN
 113     ASM_REWRITE_TAC[IN_INTER; AFFINE_HULL_EMPTY; NOT_IN_EMPTY] THEN
 114     MP_TAC(ISPEC `t:real^N->bool` RELATIVE_INTERIOR_EQ_EMPTY) THEN
 115     ASM_REWRITE_TAC[] THEN
 116     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN
 117     X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_RELATIVE_INTERIOR_CBALL] THEN
 118     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
 119     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
 120     STRIP_TAC THEN ASM_CASES_TAC `x:real^N = y` THEN ASM_REWRITE_TAC[] THEN
 121     FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN
 122     REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN
 123     ASM_SIMP_TAC[LEFT_FORALL_IMP_THM; OPEN_SEGMENT_ALT] THEN
 124     ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN
 125     RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[] THEN
 126     ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
 127     REWRITE_TAC[EXISTS_IN_GSPEC] THEN
 128     EXISTS_TAC `min (&1 / &2) (e / norm(x - y:real^N))` THEN
 129     REWRITE_TAC[REAL_LT_MIN; REAL_MIN_LT] THEN
 130     CONV_TAC REAL_RAT_REDUCE_CONV THEN
 131     ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ] THEN
 132     FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTER; IN_CBALL; dist] THEN
 133     CONJ_TAC THENL
 134      [REWRITE_TAC[NORM_MUL; VECTOR_ARITH
 135        `y - ((&1 - u) % y + u % x):real^N = u % (y - x)`] THEN
 136       ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN
 137       REWRITE_TAC[NORM_SUB] THEN
 138       MATCH_MP_TAC(REAL_ARITH `&0 < e ==> abs(min (&1 / &2) e) <= e`) THEN
 139       ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ];
 140       MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN
 141       ASM_SIMP_TAC[HULL_INC]];
 142     CONJ_TAC THENL
 143      [ONCE_ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONVEX_INTER THEN
 144       ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL];
 145       ALL_TAC] THEN
 146     MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN
 147     SUBGOAL_THEN
 148      `!a b x:real^N. a IN s /\ b IN s /\ x IN t /\ x IN segment(a,b) /\
 149                      (a IN affine hull t ==> b IN affine hull t)
 150                      ==> a IN t /\ b IN t`
 151      (fun th -> MESON_TAC[th; SEGMENT_SYM]) THEN
 152     REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN affine hull t` THEN
 153     ASM_REWRITE_TAC[] THENL [ASM SET_TAC[]; STRIP_TAC] THEN
 154     ASM_CASES_TAC `a:real^N = b` THENL
 155      [ASM_MESON_TAC[SEGMENT_REFL; NOT_IN_EMPTY]; ALL_TAC] THEN
 156     SUBGOAL_THEN `(a:real^N) IN (s DIFF t) /\ b IN  (s DIFF t)`
 157     STRIP_ASSUME_TAC THENL
 158      [ASM_REWRITE_TAC[IN_DIFF] THEN ONCE_ASM_REWRITE_TAC[] THEN
 159       ASM_REWRITE_TAC[IN_INTER] THEN
 160       UNDISCH_TAC `~((a:real^N) IN affine hull t)` THEN
 161       UNDISCH_TAC `(x:real^N) IN segment(a,b)` THEN
 162       ASM_SIMP_TAC[OPEN_SEGMENT_ALT; CONTRAPOS_THM; IN_ELIM_THM] THEN
 163       DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN
 164       FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv(&1 - u)) :real^N->real^N`) THEN
 165       REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN
 166       ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `x < &1 ==> ~(&1 - x = &0)`] THEN
 167       REWRITE_TAC[VECTOR_ARITH
 168        `x:real^N = &1 % a + u % b <=> a = x + --u %  b`] THEN
 169       DISCH_THEN SUBST1_TAC THEN DISCH_TAC THEN
 170       MATCH_MP_TAC(REWRITE_RULE[affine] AFFINE_AFFINE_HULL) THEN
 171       ASM_SIMP_TAC[HULL_INC] THEN
 172       UNDISCH_TAC `u < &1` THEN CONV_TAC REAL_FIELD;
 173       MP_TAC(ISPEC `s DIFF t:real^N->bool` CONVEX_CONTAINS_SEGMENT) THEN
 174       ASM_REWRITE_TAC[] THEN
 175       DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
 176       ASM_REWRITE_TAC[SUBSET; IN_DIFF] THEN
 177       DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
 178       ASM_MESON_TAC[segment; IN_DIFF]]]);;
 179
 180 let FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG = prove
 181  (`!s a:real^N b.
 182         convex(s INTER {x | a dot x = b}) /\ (!x. x IN s ==> a dot x <= b)
 183         ==> (s INTER {x | a dot x = b}) face_of s`,
 184   MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `c:real^N`; `d:real`] THEN
 185   SIMP_TAC[face_of; INTER_SUBSET] THEN
 186   STRIP_TAC THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
 187   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN
 188   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
 189   MATCH_MP_TAC(REAL_ARITH
 190    `a <= x /\ b <= x /\ ~(a < x) /\ ~(b < x) ==> a = x /\ b = x`) THEN
 191   ASM_SIMP_TAC[] THEN UNDISCH_TAC `(x:real^N) IN segment(a,b)` THEN
 192   ASM_CASES_TAC `a:real^N = b` THEN
 193   ASM_REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY] THEN
 194   ASM_SIMP_TAC[OPEN_SEGMENT_ALT; IN_ELIM_THM] THEN
 195   DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN
 196   CONJ_TAC THEN DISCH_TAC THEN UNDISCH_TAC `(c:real^N) dot x = d` THEN
 197   MATCH_MP_TAC(REAL_ARITH `x < a ==> x = a ==> F`) THEN
 198   SUBST1_TAC(REAL_ARITH `d = (&1 - u) * d + u * d`) THEN
 199   ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THENL
 200    [MATCH_MP_TAC REAL_LTE_ADD2; MATCH_MP_TAC REAL_LET_ADD2] THEN
 201   ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_LMUL_EQ; REAL_SUB_LT]);;
 202
 203 let FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE_STRONG = prove
 204  (`!s a:real^N b.
 205         convex(s INTER {x | a dot x = b}) /\ (!x. x IN s ==> a dot x >= b)
 206         ==> (s INTER {x | a dot x = b}) face_of s`,
 207   REWRITE_TAC[real_ge] THEN REPEAT STRIP_TAC THEN
 208   MP_TAC(ISPECL [`s:real^N->bool`; `--a:real^N`; `--b:real`]
 209     FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG) THEN
 210   ASM_REWRITE_TAC[DOT_LNEG; REAL_EQ_NEG2; REAL_LE_NEG2]);;
 211
 212 let FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE = prove
 213  (`!s a:real^N b.
 214         convex s /\ (!x. x IN s ==> a dot x <= b)
 215         ==> (s INTER {x | a dot x = b}) face_of s`,
 216   SIMP_TAC[FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG;
 217            CONVEX_INTER; CONVEX_HYPERPLANE]);;
 218
 219 let FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE = prove
 220  (`!s a:real^N b.
 221         convex s /\ (!x. x IN s ==> a dot x >= b)
 222         ==> (s INTER {x | a dot x = b}) face_of s`,
 223   SIMP_TAC[FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE_STRONG;
 224            CONVEX_INTER; CONVEX_HYPERPLANE]);;
 225
 226 let FACE_OF_IMP_SUBSET = prove
 227  (`!s t. t face_of s ==> t SUBSET s`,
 228   SIMP_TAC[face_of]);;
 229
 230 let FACE_OF_IMP_CONVEX = prove
 231  (`!s t. t face_of s ==> convex t`,
 232   SIMP_TAC[face_of]);;
 233
 234 let FACE_OF_IMP_CLOSED = prove
 235  (`!s t. convex s /\ closed s /\ t face_of s ==> closed t`,
 236   REPEAT GEN_TAC THEN
 237   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
 238   ASM_SIMP_TAC[FACE_OF_STILLCONVEX] THEN
 239   STRIP_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN
 240   ASM_SIMP_TAC[CLOSED_AFFINE; AFFINE_AFFINE_HULL; CLOSED_INTER]);;
 241
 242 let FACE_OF_IMP_COMPACT = prove
 243  (`!s t. convex s /\ compact s /\ t face_of s ==> compact t`,
 244   SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
 245   ASM_MESON_TAC[BOUNDED_SUBSET; FACE_OF_IMP_SUBSET; FACE_OF_IMP_CLOSED]);;
 246
 247 let FACE_OF_INTER_SUBFACE = prove
 248  (`!c1 c2 d1 d2:real^N->bool.
 249         (c1 INTER c2) face_of c1 /\ (c1 INTER c2) face_of c2 /\
 250         d1 face_of c1 /\ d2 face_of c2
 251         ==> (d1 INTER d2) face_of d1 /\ (d1 INTER d2) face_of d2`,
 252  REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_SUBSET THENL
 253    [EXISTS_TAC `c1:real^N->bool`; EXISTS_TAC `c2:real^N->bool`] THEN
 254   ASM_SIMP_TAC[FACE_OF_IMP_SUBSET; INTER_SUBSET] THEN
 255   TRANS_TAC FACE_OF_TRANS `c1 INTER c2:real^N->bool` THEN
 256   ASM_SIMP_TAC[FACE_OF_INTER_INTER]);;
 257
 258 let SUBSET_OF_FACE_OF = prove
 259  (`!s t u:real^N->bool.
 260       t face_of s /\ u SUBSET s /\
 261       ~(DISJOINT t (relative_interior u))
 262       ==> u SUBSET t`,
 263   REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN
 264   REWRITE_TAC[SUBSET] THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN
 265   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
 266   REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN
 267   REWRITE_TAC[IN_RELATIVE_INTERIOR_CBALL] THEN
 268   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
 269   DISCH_THEN(X_CHOOSE_THEN `e:real` MP_TAC) THEN
 270   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
 271   REWRITE_TAC[SUBSET; IN_CBALL; IN_INTER] THEN
 272   ASM_CASES_TAC `c:real^N = b` THEN ASM_REWRITE_TAC[] THEN
 273   ABBREV_TAC `d:real^N = b + e / norm(b - c) % (b - c)` THEN
 274   DISCH_THEN(MP_TAC o SPEC `d:real^N`) THEN ANTS_TAC THENL
 275    [EXPAND_TAC "d" THEN CONJ_TAC THENL
 276      [REWRITE_TAC[NORM_ARITH `dist(b:real^N,b + e) = norm e`] THEN
 277       REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
 278       ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
 279       ASM_REAL_ARITH_TAC;
 280       REWRITE_TAC[VECTOR_ARITH
 281        `b + u % (b - c):real^N = (&1 - --u) % b + --u % c`] THEN
 282       MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN
 283       ASM_SIMP_TAC[HULL_INC]];
 284     STRIP_TAC THEN
 285     SUBGOAL_THEN `(d:real^N) IN t /\ c IN t` (fun th -> MESON_TAC[th]) THEN
 286     FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [face_of]) THEN
 287     FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `b:real^N` THEN
 288     REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
 289     SUBGOAL_THEN `~(b:real^N = d)` ASSUME_TAC THENL
 290      [EXPAND_TAC "d" THEN
 291       REWRITE_TAC[VECTOR_ARITH `b:real^N = b + e <=> e = vec 0`] THEN
 292       ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ;
 293                    VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ];
 294       ASM_REWRITE_TAC[segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN
 295       REWRITE_TAC[IN_ELIM_THM] THEN
 296       EXISTS_TAC `(e / norm(b - c:real^N)) / (&1 + e / norm(b - c))` THEN
 297       ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ;
 298                    REAL_ARITH `&0 < x ==> &0 < &1 + x`;
 299                    REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_MUL_LID] THEN
 300       REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN
 301       ASM_SIMP_TAC[REAL_FIELD `&0 < n ==> (&1 + e / n) * n = n + e`;
 302                    NORM_POS_LT; VECTOR_SUB_EQ; REAL_LE_ADDL] THEN
 303       ASM_SIMP_TAC[NORM_POS_LT; REAL_LT_IMP_LE; VECTOR_SUB_EQ] THEN
 304       EXPAND_TAC "d" THEN REWRITE_TAC[VECTOR_ARITH
 305        `b:real^N = (&1 - u) % (b + e % (b - c)) + u % c <=>
 306         (u - e * (&1 - u)) % (b - c) = vec 0`] THEN
 307       ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN
 308       MATCH_MP_TAC(REAL_FIELD
 309        `&0 < e ==> e / (&1 + e) - e * (&1 - e / (&1 + e)) = &0`) THEN
 310       ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]]]);;
 311
 312 let FACE_OF_EQ = prove
 313  (`!s t u:real^N->bool.
 314         t face_of s /\ u face_of s /\
 315         ~(DISJOINT (relative_interior t) (relative_interior u))
 316         ==> t = u`,
 317   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
 318   CONJ_TAC THEN MATCH_MP_TAC SUBSET_OF_FACE_OF THEN
 319   EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_IMP_SUBSET] THENL
 320    [MP_TAC(ISPEC `u:real^N->bool` RELATIVE_INTERIOR_SUBSET);
 321     MP_TAC(ISPEC `t:real^N->bool` RELATIVE_INTERIOR_SUBSET)] THEN
 322   ASM SET_TAC[]);;
 323
 324 let FACE_OF_DISJOINT_RELATIVE_INTERIOR = prove
 325  (`!f s:real^N->bool.
 326         f face_of s /\ ~(f = s) ==> f INTER relative_interior s = {}`,
 327   REPEAT STRIP_TAC THEN
 328   MP_TAC(ISPECL [`s:real^N->bool`; `f:real^N->bool`; `s:real^N->bool`]
 329         SUBSET_OF_FACE_OF) THEN
 330   FIRST_ASSUM(MP_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN
 331   ASM SET_TAC[]);;
 332
 333 let FACE_OF_DISJOINT_INTERIOR = prove
 334  (`!f s:real^N->bool.
 335         f face_of s /\ ~(f = s) ==> f INTER interior s = {}`,
 336   REPEAT GEN_TAC THEN
 337   DISCH_THEN(MP_TAC o MATCH_MP FACE_OF_DISJOINT_RELATIVE_INTERIOR) THEN
 338   MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET_RELATIVE_INTERIOR) THEN
 339   SET_TAC[]);;
 340
 341 let AFFINE_HULL_FACE_OF_DISJOINT_RELATIVE_INTERIOR = prove
 342  (`!s f:real^N->bool.
 343         convex s /\ f face_of s /\ ~(f = s)
 344         ==> affine hull f INTER relative_interior s = {}`,
 345   REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE
 346    `!s f. a INTER s = f /\ r SUBSET s /\ f INTER r = {}
 347           ==> a INTER r = {}`) THEN
 348   MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `f:real^N->bool`] THEN
 349   ASM_SIMP_TAC[FACE_OF_DISJOINT_RELATIVE_INTERIOR;
 350                RELATIVE_INTERIOR_SUBSET] THEN
 351   UNDISCH_TAC `(f:real^N->bool) face_of s` THEN
 352   ASM_SIMP_TAC[FACE_OF_STILLCONVEX] THEN MESON_TAC[]);;
 353
 354 let FACE_OF_SUBSET_RELATIVE_BOUNDARY = prove
 355  (`!s f:real^N->bool.
 356         f face_of s /\ ~(f = s) ==> f SUBSET (s DIFF relative_interior s)`,
 357   ASM_SIMP_TAC[SET_RULE `s SUBSET u DIFF t <=> s SUBSET u /\ s INTER t = {}`;
 358                FACE_OF_DISJOINT_RELATIVE_INTERIOR; FACE_OF_IMP_SUBSET]);;
 359
 360 let FACE_OF_SUBSET_RELATIVE_FRONTIER = prove
 361  (`!s f:real^N->bool.
 362         f face_of s /\ ~(f = s) ==> f SUBSET relative_frontier s`,
 363   REPEAT GEN_TAC THEN
 364   DISCH_THEN(MP_TAC o MATCH_MP FACE_OF_SUBSET_RELATIVE_BOUNDARY) THEN
 365   REWRITE_TAC[relative_frontier] THEN
 366   MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]);;
 367
 368 let FACE_OF_AFF_DIM_LT = prove
 369  (`!f s:real^N->bool.
 370         convex s /\ f face_of s /\ ~(f = s) ==> aff_dim f < aff_dim s`,
 371   REPEAT GEN_TAC THEN
 372   SIMP_TAC[INT_LT_LE; FACE_OF_IMP_SUBSET; AFF_DIM_SUBSET] THEN
 373   REWRITE_TAC[IMP_CONJ; CONTRAPOS_THM] THEN
 374   ASM_CASES_TAC `f:real^N->bool = {}` THENL
 375    [CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN
 376     ASM_REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_EMPTY];
 377     REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_EQ THEN
 378     EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_REFL] THEN
 379     MATCH_MP_TAC(SET_RULE `~(f = {}) /\ f SUBSET s ==> ~DISJOINT f s`) THEN
 380     FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_CONVEX) THEN
 381     ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY] THEN
 382     MATCH_MP_TAC SUBSET_RELATIVE_INTERIOR THEN
 383     ASM_MESON_TAC[FACE_OF_IMP_SUBSET; AFF_DIM_EQ_AFFINE_HULL; INT_LE_REFL]]);;
 384
 385 let FACE_OF_CONVEX_HULLS = prove
 386  (`!f s:real^N->bool.
 387         FINITE s /\ f SUBSET s /\
 388         DISJOINT (affine hull f) (convex hull (s DIFF f))
 389         ==> (convex hull f) face_of (convex hull s)`,
 390   let lemma = prove
 391    (`!s x y:real^N.
 392           affine s /\ ~(k = &0) /\ ~(k = &1) /\ x IN s /\ inv(&1 - k) % y IN s
 393           ==> inv(k) % (x - y) IN s`,
 394     REWRITE_TAC[AFFINE_ALT] THEN REPEAT STRIP_TAC THEN
 395     SUBGOAL_THEN
 396      `inv(k) % (x - y):real^N = (&1 - inv k) % inv(&1 - k) % y + inv(k) % x`
 397      (fun th -> ASM_SIMP_TAC[th]) THEN
 398     REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_ARITH
 399      `k % (x - y):real^N = a % b % y + k % x <=> (a * b + k) % y = vec 0`] THEN
 400     DISJ1_TAC THEN MAP_EVERY UNDISCH_TAC [`~(k = &0)`; `~(k = &1)`] THEN
 401     CONV_TAC REAL_FIELD) in
 402   REPEAT STRIP_TAC THEN REWRITE_TAC[face_of] THEN
 403   SUBGOAL_THEN `FINITE(f:real^N->bool)` ASSUME_TAC THENL
 404    [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN
 405   FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
 406   ASM_SIMP_TAC[HULL_MONO; CONVEX_CONVEX_HULL] THEN
 407   MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `w:real^N`] THEN
 408   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN
 409   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
 410    (X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC)) THEN
 411   SUBGOAL_THEN `(w:real^N) IN affine hull f` ASSUME_TAC THENL
 412    [ASM_MESON_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL; SUBSET]; ALL_TAC] THEN
 413   MAP_EVERY UNDISCH_TAC
 414    [`(y:real^N) IN convex hull s`; `(x:real^N) IN convex hull s`] THEN
 415   REWRITE_TAC[CONVEX_HULL_FINITE; IN_ELIM_THM] THEN
 416   DISCH_THEN(X_CHOOSE_THEN `a:real^N->real` STRIP_ASSUME_TAC) THEN
 417   DISCH_THEN(X_CHOOSE_THEN `b:real^N->real` STRIP_ASSUME_TAC) THEN
 418   ABBREV_TAC `(c:real^N->real) = \x. (&1 - u) * a x + u * b x` THEN
 419   SUBGOAL_THEN `!x:real^N. x IN s ==> &0 <= c x` ASSUME_TAC THENL
 420    [REPEAT STRIP_TAC THEN EXPAND_TAC "c" THEN REWRITE_TAC[] THEN
 421     MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN
 422     ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC;
 423     ALL_TAC] THEN
 424   ASM_CASES_TAC `sum (s DIFF f:real^N->bool) c = &0` THENL
 425    [SUBGOAL_THEN `!x:real^N. x IN (s DIFF f) ==> c x = &0` MP_TAC THENL
 426      [MATCH_MP_TAC SUM_POS_EQ_0 THEN ASM_MESON_TAC[FINITE_DIFF; IN_DIFF];
 427       ALL_TAC] THEN
 428     EXPAND_TAC "c" THEN
 429     ASM_SIMP_TAC[IN_DIFF; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LT;
 430      REAL_ARITH `&0 <= x /\ &0 <= y ==> (x + y = &0 <=> x = &0 /\ y = &0)`;
 431      REAL_ENTIRE; REAL_SUB_0; REAL_LT_IMP_NE] THEN
 432     STRIP_TAC THEN CONJ_TAC THENL
 433      [EXISTS_TAC `a:real^N->real`; EXISTS_TAC `b:real^N->real`] THEN
 434     ASM_SIMP_TAC[] THEN CONJ_TAC THEN FIRST_X_ASSUM(fun th g ->
 435       (GEN_REWRITE_TAC RAND_CONV [GSYM th] THEN CONV_TAC SYM_CONV THEN
 436        (MATCH_MP_TAC SUM_SUPERSET ORELSE MATCH_MP_TAC VSUM_SUPERSET)) g) THEN
 437     ASM_SIMP_TAC[VECTOR_MUL_LZERO];
 438     ALL_TAC] THEN
 439   ABBREV_TAC `k = sum (s DIFF f:real^N->bool) c` THEN
 440   SUBGOAL_THEN `&0 < k` ASSUME_TAC THENL
 441    [ASM_REWRITE_TAC[REAL_LT_LE] THEN EXPAND_TAC "k" THEN
 442     MATCH_MP_TAC SUM_POS_LE THEN ASM_SIMP_TAC[FINITE_DIFF; IN_DIFF];
 443     ALL_TAC] THEN
 444   ASM_CASES_TAC `k = &1` THENL
 445    [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_DISJOINT]) THEN
 446     MATCH_MP_TAC(TAUT `b ==> ~b ==> c`) THEN
 447     EXISTS_TAC `w:real^N` THEN
 448     ASM_REWRITE_TAC[CONVEX_HULL_FINITE; IN_ELIM_THM] THEN
 449     EXISTS_TAC `c:real^N->real` THEN
 450     ASM_SIMP_TAC[IN_DIFF; SUM_DIFF; VSUM_DIFF] THEN
 451     SUBGOAL_THEN `vsum f (\x:real^N. c x % x) = vec 0` SUBST1_TAC THENL
 452      [ALL_TAC;
 453       EXPAND_TAC "c" THEN REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN
 454       ASM_SIMP_TAC[VSUM_ADD; GSYM VECTOR_MUL_ASSOC; VSUM_LMUL] THEN
 455       REWRITE_TAC[VECTOR_SUB_RZERO]] THEN
 456     SUBGOAL_THEN `sum(s DIFF f) c = sum s c - sum f (c:real^N->real)`
 457     MP_TAC THENL [ASM_MESON_TAC[SUM_DIFF]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN
 458     SUBGOAL_THEN `sum s (c:real^N->real) = &1` SUBST1_TAC THENL
 459      [EXPAND_TAC "c" THEN REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN
 460       ASM_SIMP_TAC[SUM_ADD; GSYM REAL_MUL_ASSOC; SUM_LMUL] THEN
 461       REAL_ARITH_TAC;
 462       ALL_TAC] THEN
 463     REWRITE_TAC[REAL_ARITH `&1 = &1 - x <=> x = &0`] THEN DISCH_TAC THEN
 464     MP_TAC(ISPECL [`c:real^N->real`;`f:real^N->bool`] SUM_POS_EQ_0) THEN
 465     ANTS_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET; SUBSET]; ALL_TAC] THEN
 466     SIMP_TAC[VECTOR_MUL_LZERO; VSUM_0];
 467     ALL_TAC] THEN
 468   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_DISJOINT]) THEN
 469   MATCH_MP_TAC(TAUT `b ==> ~b ==> c`) THEN
 470   EXISTS_TAC `inv(k) % (w - vsum f (\x:real^N. c x % x))` THEN CONJ_TAC THENL
 471    [ALL_TAC;
 472     SUBGOAL_THEN `w = vsum f (\x:real^N. c x % x) +
 473                       vsum (s DIFF f) (\x:real^N. c x % x)`
 474     SUBST1_TAC THENL
 475      [ASM_SIMP_TAC[VSUM_DIFF; VECTOR_ARITH `a + b - a:real^N = b`] THEN
 476       EXPAND_TAC "c" THEN REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN
 477       ASM_SIMP_TAC[VSUM_ADD; GSYM VECTOR_MUL_ASSOC; VSUM_LMUL];
 478       REWRITE_TAC[VECTOR_ADD_SUB]] THEN
 479     ASM_SIMP_TAC[GSYM VSUM_LMUL; FINITE_DIFF] THEN
 480     REWRITE_TAC[CONVEX_HULL_FINITE; IN_ELIM_THM] THEN
 481     EXISTS_TAC `\x. inv k * (c:real^N->real) x` THEN
 482     ASM_REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
 483     ASM_SIMP_TAC[IN_DIFF; REAL_LE_MUL; REAL_LE_INV_EQ; REAL_LT_IMP_LE] THEN
 484     ASM_SIMP_TAC[SUM_LMUL; ETA_AX; REAL_MUL_LINV]] THEN
 485   MATCH_MP_TAC lemma THEN REPEAT CONJ_TAC THENL
 486    [REWRITE_TAC[AFFINE_AFFINE_HULL];
 487     ASM_REWRITE_TAC[];
 488     ASM_REWRITE_TAC[];
 489     ASM_MESON_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL; SUBSET];
 490     ALL_TAC] THEN
 491   ASM_SIMP_TAC[GSYM VSUM_LMUL; AFFINE_HULL_FINITE; IN_ELIM_THM] THEN
 492   EXISTS_TAC `(\x. inv(&1 - k) * c x):real^N->real` THEN
 493   REWRITE_TAC[VECTOR_MUL_ASSOC; SUM_LMUL] THEN
 494   MATCH_MP_TAC(REAL_FIELD
 495    `~(k = &1) /\ f = &1 - k ==> inv(&1 - k) * f = &1`) THEN
 496   ASM_REWRITE_TAC[] THEN
 497   SUBGOAL_THEN `sum(s DIFF f) c = sum s c - sum f (c:real^N->real)`
 498   MP_TAC THENL [ASM_MESON_TAC[SUM_DIFF]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN
 499   SUBGOAL_THEN `sum s (c:real^N->real) = &1` SUBST1_TAC THENL
 500    [EXPAND_TAC "c" THEN REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN
 501     ASM_SIMP_TAC[SUM_ADD; GSYM REAL_MUL_ASSOC; SUM_LMUL];
 502     ALL_TAC] THEN
 503   REAL_ARITH_TAC);;
 504
 505 let FACE_OF_CONVEX_HULL_INSERT = prove
 506  (`!f s a:real^N.
 507         FINITE s /\ ~(a IN affine hull s) /\ f face_of (convex hull s)
 508         ==> f face_of (convex hull (a INSERT s))`,
 509   REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_TRANS THEN
 510   EXISTS_TAC `convex hull s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
 511   MATCH_MP_TAC FACE_OF_CONVEX_HULLS THEN
 512   ASM_REWRITE_TAC[FINITE_INSERT; SET_RULE `s SUBSET a INSERT s`] THEN
 513   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
 514    `~(a IN s) ==> t SUBSET {a} ==> DISJOINT s t`)) THEN
 515   MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_SING] THEN SET_TAC[]);;
 516
 517 let FACE_OF_AFFINE_TRIVIAL = prove
 518  (`!s f:real^N->bool.
 519         affine s /\ f face_of s ==> f = {} \/ f = s`,
 520   REPEAT STRIP_TAC THEN
 521   ASM_CASES_TAC `f:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN
 522   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
 523   DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN
 524   FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN
 525   MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN
 526   REWRITE_TAC[SUBSET] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN
 527   ASM_CASES_TAC `(b:real^N) IN f` THEN ASM_REWRITE_TAC[] THEN
 528   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [face_of]) THEN
 529   DISCH_THEN(MP_TAC o SPECL [`&2 % a - b:real^N`; `b:real^N`; `a:real^N`] o
 530              CONJUNCT2 o CONJUNCT2) THEN
 531   SUBGOAL_THEN `~(a:real^N = b)` ASSUME_TAC THENL
 532    [ASM_MESON_TAC[]; ALL_TAC] THEN
 533   ASM_SIMP_TAC[IN_SEGMENT; VECTOR_ARITH `&2 % a - b:real^N = b <=> a = b`] THEN
 534   CONJ_TAC THENL
 535    [REWRITE_TAC[VECTOR_ARITH `&2 % a - b:real^N = a + &1 % (a - b)`] THEN
 536     MATCH_MP_TAC IN_AFFINE_ADD_MUL_DIFF THEN ASM SET_TAC[];
 537     EXISTS_TAC `&1 / &2` THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
 538     VECTOR_ARITH_TAC]);;
 539
 540 let FACE_OF_AFFINE_EQ = prove
 541  (`!s:real^N->bool f. affine s ==> (f face_of s <=> f = {} \/ f = s)`,
 542   MESON_TAC[FACE_OF_AFFINE_TRIVIAL; EMPTY_FACE_OF; FACE_OF_REFL;
 543             AFFINE_IMP_CONVEX]);;
 544
 545 let INTERS_FACES_FINITE_BOUND = prove
 546  (`!s f:(real^N->bool)->bool.
 547         convex s /\ (!c. c IN f ==> c face_of s)
 548         ==> ?f'. FINITE f' /\ f' SUBSET f /\ CARD f' <= dimindex(:N) + 1 /\
 549                  INTERS f' = INTERS f`,
 550   SUBGOAL_THEN
 551    `!s f:(real^N->bool)->bool.
 552         convex s /\ (!c. c IN f ==> c face_of s /\ ~(c = s))
 553         ==> ?f'. FINITE f' /\ f' SUBSET f /\ CARD f' <= dimindex(:N) + 1 /\
 554                  INTERS f' = INTERS f`
 555   ASSUME_TAC THENL
 556    [ALL_TAC;
 557     REPEAT STRIP_TAC THEN
 558     ASM_CASES_TAC `(s:real^N->bool) IN f` THENL
 559      [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]] THEN
 560     FIRST_ASSUM(DISJ_CASES_THEN2 SUBST1_TAC MP_TAC o MATCH_MP (SET_RULE
 561      `s IN f ==> f = {s} \/ ?t. ~(t = s) /\ t IN f`)) THENL
 562      [EXISTS_TAC `{s:real^N->bool}` THEN
 563       SIMP_TAC[FINITE_INSERT; FINITE_EMPTY; SUBSET_REFL; CARD_CLAUSES] THEN
 564       ARITH_TAC;
 565       DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC)] THEN
 566     FIRST_X_ASSUM(MP_TAC o SPECL [`s:real^N->bool`; `f DELETE
 567       (s:real^N->bool)`]) THEN
 568     ASM_SIMP_TAC[IN_DELETE; SUBSET_DELETE] THEN
 569     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f':(real^N->bool)->bool` THEN
 570     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
 571     SUBGOAL_THEN `f = (s:real^N->bool) INSERT (f DELETE s)` MP_TAC THENL
 572      [ASM SET_TAC[];
 573       DISCH_THEN(fun th -> GEN_REWRITE_TAC (funpow 2 RAND_CONV) [th])] THEN
 574     REWRITE_TAC[INTERS_INSERT] THEN
 575     MATCH_MP_TAC(SET_RULE `t SUBSET s ==> t = s INTER t`) THEN
 576     FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN
 577     ASM_REWRITE_TAC[] THEN
 578     DISCH_THEN(ASSUME_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN
 579     MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `t:real^N->bool` THEN
 580     ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_INTERS; IN_DELETE] THEN
 581     ASM SET_TAC[]] THEN
 582   REPEAT STRIP_TAC THEN ASM_CASES_TAC
 583    `!f':(real^N->bool)->bool.
 584         FINITE f' /\ f' SUBSET f /\ CARD f' <= dimindex(:N) + 1
 585         ==> ?c. c IN f /\ c INTER (INTERS f') PSUBSET (INTERS f')`
 586   THENL
 587    [ALL_TAC;
 588     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN
 589     MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
 590     SIMP_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN
 591     REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
 592     ASM_REWRITE_TAC[PSUBSET; INTER_SUBSET] THEN ASM SET_TAC[]] THEN
 593   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV
 594    [RIGHT_IMP_EXISTS_THM]) THEN
 595   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
 596   X_GEN_TAC `c:((real^N->bool)->bool)->real^N->bool` THEN DISCH_TAC THEN
 597   CHOOSE_TAC(prove_recursive_functions_exist num_RECURSION
 598    `d 0 = {c {} :real^N->bool} /\ !n. d(SUC n) = c(d n) INSERT d n`) THEN
 599   SUBGOAL_THEN `!n:num. ~(d n:(real^N->bool)->bool = {})` ASSUME_TAC THENL
 600    [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; ALL_TAC] THEN
 601   SUBGOAL_THEN
 602    `!n. n <= dimindex(:N) + 1
 603         ==> (d n) SUBSET (f:(real^N->bool)->bool) /\
 604             FINITE(d n) /\ CARD(d n) <= n + 1`
 605   ASSUME_TAC THENL
 606    [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN
 607     ASM_SIMP_TAC[INSERT_SUBSET; CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY;
 608       EMPTY_SUBSET; ARITH_RULE `SUC n <= m + 1 ==> n <= m + 1`] THEN
 609     REPEAT STRIP_TAC THEN TRY ASM_ARITH_TAC THEN
 610     FIRST_X_ASSUM(MP_TAC o SPEC `(d:num->(real^N->bool)->bool) n`) THEN
 611     FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN
 612     ANTS_TAC THENL [ASM_ARITH_TAC; STRIP_TAC] THEN ASM_REWRITE_TAC[] THEN
 613     ANTS_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[]];
 614     ALL_TAC] THEN
 615   SUBGOAL_THEN
 616    `!n. n <= dimindex(:N)
 617         ==> (INTERS(d(SUC n)):real^N->bool) PSUBSET INTERS(d n)`
 618   ASSUME_TAC THENL
 619    [REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[INTERS_INSERT] THEN
 620     FIRST_X_ASSUM(MP_TAC o SPEC `(d:num->(real^N->bool)->bool) n`) THEN
 621     ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN
 622     REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:num`)) THEN
 623     ASM_SIMP_TAC[ARITH_RULE `n <= N ==> n <= N + 1`] THEN
 624     ASM_ARITH_TAC;
 625     ALL_TAC] THEN
 626   FIRST_X_ASSUM(CONJUNCTS_THEN(K ALL_TAC)) THEN
 627   SUBGOAL_THEN
 628    `!n. n <= dimindex(:N) + 1
 629         ==> aff_dim(INTERS(d n):real^N->bool) < &(dimindex(:N)) - &n`
 630   MP_TAC THENL
 631    [INDUCT_TAC THENL
 632      [DISCH_TAC THEN REWRITE_TAC[INT_SUB_RZERO] THEN
 633       MATCH_MP_TAC INT_LTE_TRANS THEN
 634       EXISTS_TAC `aff_dim(s:real^N->bool)` THEN
 635       REWRITE_TAC[AFF_DIM_LE_UNIV] THEN
 636       MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN
 637       ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
 638        [MATCH_MP_TAC FACE_OF_INTERS THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
 639         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY] o
 640           SPEC `0`) THEN
 641         DISCH_THEN(X_CHOOSE_TAC `e:real^N->bool`) THEN
 642         FIRST_X_ASSUM(MP_TAC o SPEC `e:real^N->bool`) THEN
 643         ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN
 644         MATCH_MP_TAC(SET_RULE
 645          `!t. t PSUBSET s /\ u SUBSET t ==> ~(u = s)`) THEN
 646         EXISTS_TAC `e:real^N->bool` THEN
 647         FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN
 648         ASM SET_TAC[]];
 649       DISCH_TAC THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN
 650       MATCH_MP_TAC(INT_ARITH
 651        `!d':int. d < d' /\ d' < m - n ==> d < m - (n + &1)`) THEN
 652       EXISTS_TAC `aff_dim(INTERS(d(n:num)):real^N->bool)` THEN
 653       ASM_SIMP_TAC[ARITH_RULE `SUC n <= k + 1 ==> n <= k + 1`] THEN
 654       MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN
 655       ASM_SIMP_TAC[ARITH_RULE `SUC n <= m + 1 ==> n <= m`;
 656                    SET_RULE `s PSUBSET t ==> ~(s = t)`] THEN
 657       CONJ_TAC THENL
 658        [MATCH_MP_TAC CONVEX_INTERS THEN
 659         REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_IMP_CONVEX THEN
 660         EXISTS_TAC `s:real^N->bool` THEN
 661         ASM_MESON_TAC[SUBSET; ARITH_RULE `SUC n <= m + 1 ==> n <= m + 1`];
 662         ALL_TAC] THEN
 663       MP_TAC(ISPECL [`INTERS(d(SUC n)):real^N->bool`;`s:real^N->bool`;
 664                      `INTERS(d(n:num)):real^N->bool`] FACE_OF_FACE) THEN
 665       ASM_SIMP_TAC[SET_RULE `s PSUBSET t ==> s SUBSET t`;
 666                    ARITH_RULE `SUC n <= m + 1 ==> n <= m`] THEN
 667       MATCH_MP_TAC(TAUT `a /\ b ==> (a ==> (c <=> b)) ==> c`) THEN
 668       CONJ_TAC THEN MATCH_MP_TAC FACE_OF_INTERS THEN ASM_REWRITE_TAC[] THEN
 669       ASM_MESON_TAC[SUBSET; ARITH_RULE `SUC n <= m + 1 ==> n <= m + 1`]];
 670     ALL_TAC] THEN
 671   DISCH_THEN(MP_TAC o SPEC `dimindex(:N) + 1`) THEN REWRITE_TAC[LE_REFL] THEN
 672   MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[INT_NOT_LT] THEN
 673   REWRITE_TAC[GSYM INT_OF_NUM_ADD; INT_ARITH `d - (d + &1):int = -- &1`] THEN
 674   REWRITE_TAC[AFF_DIM_GE]);;
 675
 676 let INTERS_FACES_FINITE_ALTBOUND = prove
 677  (`!s f:(real^N->bool)->bool.
 678         (!c. c IN f ==> c face_of s)
 679         ==> ?f'. FINITE f' /\ f' SUBSET f /\ CARD f' <= dimindex(:N) + 2 /\
 680                  INTERS f' = INTERS f`,
 681   REPEAT STRIP_TAC THEN ASM_CASES_TAC
 682    `!f':(real^N->bool)->bool.
 683         FINITE f' /\ f' SUBSET f /\ CARD f' <= dimindex(:N) + 2
 684         ==> ?c. c IN f /\ c INTER (INTERS f') PSUBSET (INTERS f')`
 685   THENL
 686    [ALL_TAC;
 687     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN
 688     MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
 689     SIMP_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN
 690     REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
 691     ASM_REWRITE_TAC[PSUBSET; INTER_SUBSET] THEN ASM SET_TAC[]] THEN
 692   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV
 693    [RIGHT_IMP_EXISTS_THM]) THEN
 694   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
 695   X_GEN_TAC `c:((real^N->bool)->bool)->real^N->bool` THEN DISCH_TAC THEN
 696   CHOOSE_TAC(prove_recursive_functions_exist num_RECURSION
 697    `d 0 = {c {} :real^N->bool} /\ !n. d(SUC n) = c(d n) INSERT d n`) THEN
 698   SUBGOAL_THEN `!n:num. ~(d n:(real^N->bool)->bool = {})` ASSUME_TAC THENL
 699    [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; ALL_TAC] THEN
 700   SUBGOAL_THEN
 701    `!n. n <= dimindex(:N) + 2
 702         ==> (d n) SUBSET (f:(real^N->bool)->bool) /\
 703             FINITE(d n) /\ CARD(d n) <= n + 1`
 704   ASSUME_TAC THENL
 705    [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN
 706     ASM_SIMP_TAC[INSERT_SUBSET; CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY;
 707       EMPTY_SUBSET; ARITH_RULE `SUC n <= m + 2 ==> n <= m + 2`] THEN
 708     REPEAT STRIP_TAC THEN TRY ASM_ARITH_TAC THEN
 709     FIRST_X_ASSUM(MP_TAC o SPEC `(d:num->(real^N->bool)->bool) n`) THEN
 710     FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN
 711     ANTS_TAC THENL [ASM_ARITH_TAC; STRIP_TAC] THEN ASM_REWRITE_TAC[] THEN
 712     ANTS_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[]];
 713     ALL_TAC] THEN
 714   SUBGOAL_THEN
 715    `!n. n <= dimindex(:N) + 1
 716         ==> (INTERS(d(SUC n)):real^N->bool) PSUBSET INTERS(d n)`
 717   ASSUME_TAC THENL
 718    [REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[INTERS_INSERT] THEN
 719     FIRST_X_ASSUM(MP_TAC o SPEC `(d:num->(real^N->bool)->bool) n`) THEN
 720     ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN
 721     REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:num`)) THEN
 722     ASM_SIMP_TAC[ARITH_RULE `n <= N + 1 ==> n <= N + 2`] THEN
 723     ASM_ARITH_TAC;
 724     ALL_TAC] THEN
 725   FIRST_X_ASSUM(CONJUNCTS_THEN(K ALL_TAC)) THEN
 726   SUBGOAL_THEN
 727    `!n. n <= dimindex(:N) + 2
 728         ==> aff_dim(INTERS(d n):real^N->bool) <= &(dimindex(:N)) - &n`
 729   MP_TAC THENL
 730    [INDUCT_TAC THEN REWRITE_TAC[INT_SUB_RZERO; AFF_DIM_LE_UNIV] THEN
 731     DISCH_TAC THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN
 732     MATCH_MP_TAC(INT_ARITH
 733      `!d':int. d < d' /\ d' <= m - n ==> d <= m - (n + &1)`) THEN
 734     EXISTS_TAC `aff_dim(INTERS(d(n:num)):real^N->bool)` THEN
 735     ASM_SIMP_TAC[ARITH_RULE `SUC n <= k + 2 ==> n <= k + 2`] THEN
 736     MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN
 737     ASM_SIMP_TAC[ARITH_RULE `SUC n <= m + 2 ==> n <= m + 1`;
 738                  SET_RULE `s PSUBSET t ==> ~(s = t)`] THEN
 739     CONJ_TAC THENL
 740      [MATCH_MP_TAC CONVEX_INTERS THEN
 741       REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_IMP_CONVEX THEN
 742       EXISTS_TAC `s:real^N->bool` THEN
 743       ASM_MESON_TAC[SUBSET; ARITH_RULE `SUC n <= m + 2 ==> n <= m + 2`];
 744       ALL_TAC] THEN
 745     MP_TAC(ISPECL [`INTERS(d(SUC n)):real^N->bool`;`s:real^N->bool`;
 746                    `INTERS(d(n:num)):real^N->bool`] FACE_OF_FACE) THEN
 747     ASM_SIMP_TAC[SET_RULE `s PSUBSET t ==> s SUBSET t`;
 748                  ARITH_RULE `SUC n <= m + 2 ==> n <= m + 1`] THEN
 749     MATCH_MP_TAC(TAUT `a /\ b ==> (a ==> (c <=> b)) ==> c`) THEN
 750     CONJ_TAC THEN MATCH_MP_TAC FACE_OF_INTERS THEN ASM_REWRITE_TAC[] THEN
 751     ASM_MESON_TAC[SUBSET; ARITH_RULE `SUC n <= m + 2 ==> n <= m + 2`];
 752     ALL_TAC] THEN
 753   DISCH_THEN(MP_TAC o SPEC `dimindex(:N) + 2`) THEN REWRITE_TAC[LE_REFL] THEN
 754   MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[INT_NOT_LE] THEN
 755   REWRITE_TAC[GSYM INT_OF_NUM_ADD; INT_ARITH
 756     `d - (d + &2):int < i <=> -- &1 <= i`] THEN
 757   REWRITE_TAC[AFF_DIM_GE]);;
 758
 759 let FACES_OF_TRANSLATION = prove
 760  (`!s a:real^N.
 761         {f | f face_of IMAGE (\x. a + x) s} =
 762         IMAGE (IMAGE (\x. a + x)) {f | f face_of s}`,
 763   REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN
 764   MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
 765   REWRITE_TAC[IN_ELIM_THM; FACE_OF_TRANSLATION_EQ] THEN
 766   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
 767   ONCE_REWRITE_TAC[TRANSLATION_GALOIS] THEN
 768   REWRITE_TAC[EXISTS_REFL]);;
 769
 770 let FACES_OF_LINEAR_IMAGE = prove
 771  (`!f:real^M->real^N s.
 772         linear f /\ (!x y. f x = f y ==> x = y)
 773         ==> {t | t face_of (IMAGE f s)} = IMAGE (IMAGE f) {t | t face_of s}`,
 774   REPEAT GEN_TAC THEN DISCH_TAC THEN
 775   REWRITE_TAC[face_of; SUBSET_IMAGE; SET_RULE
 776    `{y | (?x. P x /\ y = f x) /\ Q y} = {f x |x| P x /\ Q(f x)}`] THEN
 777   REWRITE_TAC[SET_RULE `IMAGE f {x | P x} = {f x | P x}`] THEN
 778   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
 779   FIRST_ASSUM(fun th ->
 780    REWRITE_TAC[MATCH_MP CONVEX_LINEAR_IMAGE_EQ th;
 781                MATCH_MP OPEN_SEGMENT_LINEAR_IMAGE th;
 782                MATCH_MP (SET_RULE
 783    `(!x y. f x = f y ==> x = y)  ==> (!s x. f x IN IMAGE f s <=> x IN s)`)
 784    (CONJUNCT2 th)]));;
 785
 786 let FACE_OF_CONIC = prove
 787  (`!s f:real^N->bool. conic s /\ f face_of s ==> conic f`,
 788   REPEAT GEN_TAC THEN REWRITE_TAC[face_of; conic] THEN STRIP_TAC THEN
 789   MAP_EVERY X_GEN_TAC [`x:real^N`; `c:real`] THEN STRIP_TAC THEN
 790   ASM_CASES_TAC `x:real^N = vec 0` THENL
 791    [ASM_MESON_TAC[VECTOR_MUL_RZERO]; ALL_TAC] THEN
 792   ASM_CASES_TAC `c = &1` THENL
 793    [ASM_MESON_TAC[VECTOR_MUL_LID]; ALL_TAC] THEN
 794   SUBGOAL_THEN `?d e. &0 <= d /\ &0 <= e /\ d < &1 /\ &1 < e /\ d < e /\
 795                       (d = c \/ e = c)`
 796   MP_TAC THENL
 797    [FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH
 798      `~(c = &1) ==> c < &1 \/ &1 < c`))
 799     THENL
 800      [MAP_EVERY EXISTS_TAC [`c:real`; `&2`] THEN ASM_REAL_ARITH_TAC;
 801       MAP_EVERY EXISTS_TAC [`&1 / &2`; `c:real`] THEN ASM_REAL_ARITH_TAC];
 802     DISCH_THEN(REPEAT_TCL CHOOSE_THEN
 803       (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN
 804     FIRST_X_ASSUM(MP_TAC o SPECL
 805      [`d % x :real^N`; `e % x:real^N`; `x:real^N`]) THEN
 806     ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
 807     SUBGOAL_THEN `(x:real^N) IN s` ASSUME_TAC THENL
 808      [ASM SET_TAC[]; ASM_SIMP_TAC[IN_SEGMENT]] THEN
 809     ASM_SIMP_TAC[VECTOR_MUL_RCANCEL; REAL_LT_IMP_NE] THEN
 810     EXISTS_TAC `(&1 - d) / (e - d)`  THEN
 811     ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_SUB_LT] THEN
 812     REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
 813     REWRITE_TAC[VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_RDISTRIB] THEN
 814     REWRITE_TAC[VECTOR_ARITH `x:real^N = a % x <=> (a - &1) % x = vec 0`] THEN
 815     ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN
 816     UNDISCH_TAC `d:real < e` THEN CONV_TAC REAL_FIELD]);;
 817
 818 let FACE_OF_PCROSS = prove
 819  (`!f s:real^M->bool f' s':real^N->bool.
 820         f face_of s /\ f' face_of s' ==> (f PCROSS f') face_of (s PCROSS s')`,
 821   REPEAT GEN_TAC THEN SIMP_TAC[face_of; CONVEX_PCROSS; PCROSS_MONO] THEN
 822   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
 823   REWRITE_TAC[IN_SEGMENT; FORALL_IN_PCROSS] THEN
 824   REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN
 825   REWRITE_TAC[GSYM PASTECART_CMUL; PASTECART_ADD; PASTECART_INJ] THEN
 826   REWRITE_TAC[PASTECART_IN_PCROSS] THEN
 827   MAP_EVERY X_GEN_TAC
 828    [`a:real^M`; `a':real^N`; `b:real^M`; `b':real^N`] THEN
 829   MAP_EVERY ASM_CASES_TAC [`b:real^M = a`; `b':real^N = a'`] THEN
 830   ASM_REWRITE_TAC[VECTOR_ARITH `(&1 - u) % a + u % a:real^N = a`] THEN
 831   ASM_MESON_TAC[]);;
 832
 833 let FACE_OF_PCROSS_DECOMP = prove
 834  (`!s:real^M->bool s':real^N->bool c.
 835         c face_of (s PCROSS s') <=>
 836         ?f f'. f face_of s /\ f' face_of s' /\ c = f PCROSS f'`,
 837   REPEAT GEN_TAC THEN EQ_TAC THENL
 838    [ALL_TAC; STRIP_TAC THEN ASM_SIMP_TAC[FACE_OF_PCROSS]] THEN
 839   ASM_CASES_TAC `c:real^(M,N)finite_sum->bool = {}` THENL
 840    [ASM_MESON_TAC[EMPTY_FACE_OF; PCROSS_EMPTY]; DISCH_TAC] THEN
 841   FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_CONVEX) THEN
 842   MAP_EVERY EXISTS_TAC
 843    [`IMAGE fstcart (c:real^(M,N)finite_sum->bool)`;
 844     `IMAGE sndcart (c:real^(M,N)finite_sum->bool)`] THEN
 845   MATCH_MP_TAC(TAUT `(p /\ q ==> r) /\ p /\ q ==> p /\ q /\ r`) THEN
 846   CONJ_TAC THENL
 847    [STRIP_TAC THEN MATCH_MP_TAC FACE_OF_EQ THEN
 848     EXISTS_TAC `(s:real^M->bool) PCROSS (s':real^N->bool)` THEN
 849     ASM_SIMP_TAC[FACE_OF_PCROSS; RELATIVE_INTERIOR_PCROSS] THEN
 850     ASM_SIMP_TAC[RELATIVE_INTERIOR_LINEAR_IMAGE_CONVEX;
 851                  LINEAR_FSTCART; LINEAR_SNDCART] THEN
 852     MATCH_MP_TAC(SET_RULE `~(s = {}) /\ s SUBSET t ==> ~DISJOINT s t`) THEN
 853     ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY] THEN
 854     REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS; IN_IMAGE] THEN
 855     REWRITE_TAC[EXISTS_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN
 856     MESON_TAC[];
 857     ALL_TAC] THEN
 858   FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [face_of]) THEN
 859   REWRITE_TAC[face_of] THEN
 860   ASM_SIMP_TAC[CONVEX_LINEAR_IMAGE; LINEAR_FSTCART; LINEAR_SNDCART] THEN
 861   FIRST_ASSUM(MP_TAC o ISPEC `fstcart:real^(M,N)finite_sum->real^M` o
 862         MATCH_MP IMAGE_SUBSET) THEN
 863   FIRST_ASSUM(MP_TAC o ISPEC `sndcart:real^(M,N)finite_sum->real^N` o
 864         MATCH_MP IMAGE_SUBSET) THEN
 865   REWRITE_TAC[IMAGE_FSTCART_PCROSS; IMAGE_SNDCART_PCROSS] THEN
 866   REPEAT(DISCH_THEN(ASSUME_TAC o MATCH_MP (SET_RULE
 867    `s SUBSET (if p then {} else t) ==> s SUBSET t`))) THEN
 868   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
 869    [MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`; `x:real^M`] THEN
 870     STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_IMAGE]) THEN
 871     REWRITE_TAC[EXISTS_PASTECART; FSTCART_PASTECART] THEN
 872     REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN
 873     DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN FIRST_X_ASSUM(MP_TAC o SPECL
 874      [`pastecart (a:real^M) (y:real^N)`;
 875       `pastecart (b:real^M) (y:real^N)`;
 876       `pastecart (x:real^M) (y:real^N)`]) THEN
 877     ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_IMAGE; EXISTS_PASTECART] THEN
 878     REWRITE_TAC[FSTCART_PASTECART; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN
 879     ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
 880     UNDISCH_TAC `(c:real^(M,N)finite_sum->bool) SUBSET s PCROSS s'` THEN
 881     REWRITE_TAC[SUBSET] THEN
 882     DISCH_THEN(MP_TAC o SPEC `pastecart (x:real^M) (y:real^N)`);
 883     MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN
 884     STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_IMAGE]) THEN
 885     REWRITE_TAC[EXISTS_PASTECART; SNDCART_PASTECART] THEN
 886     REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN
 887     DISCH_THEN(X_CHOOSE_TAC `y:real^M`) THEN FIRST_X_ASSUM(MP_TAC o SPECL
 888      [`pastecart (y:real^M) (a:real^N)`;
 889       `pastecart (y:real^M) (b:real^N)`;
 890       `pastecart (y:real^M) (x:real^N)`]) THEN
 891     ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_IMAGE; EXISTS_PASTECART] THEN
 892     REWRITE_TAC[SNDCART_PASTECART; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN
 893     ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
 894     UNDISCH_TAC `(c:real^(M,N)finite_sum->bool) SUBSET s PCROSS s'` THEN
 895     REWRITE_TAC[SUBSET] THEN
 896     DISCH_THEN(MP_TAC o SPEC `pastecart (y:real^M) (x:real^N)`)] THEN
 897   ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN STRIP_TAC THEN
 898   ASM_REWRITE_TAC[] THEN
 899   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN
 900   REWRITE_TAC[IN_SEGMENT; PASTECART_INJ] THEN
 901   REWRITE_TAC[PASTECART_ADD; GSYM PASTECART_CMUL;
 902               VECTOR_ARITH `(&1 - u) % a + u % a:real^N = a`] THEN
 903   MESON_TAC[]);;
 904
 905 let FACE_OF_PCROSS_EQ = prove
 906  (`!f s:real^M->bool f' s':real^N->bool.
 907         (f PCROSS f') face_of (s PCROSS s') <=>
 908         f = {} \/ f' = {} \/ f face_of s /\ f' face_of s'`,
 909   REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC
 910    [`f:real^M->bool = {}`; `f':real^N->bool = {}`] THEN
 911   ASM_REWRITE_TAC[PCROSS_EMPTY; EMPTY_FACE_OF] THEN
 912   ASM_REWRITE_TAC[FACE_OF_PCROSS_DECOMP; PCROSS_EQ] THEN MESON_TAC[]);;
 913
 914 let HYPERPLANE_FACE_OF_HALFSPACE_LE = prove
 915  (`!a:real^N b. {x | a dot x = b} face_of {x | a dot x <= b}`,
 916   REPEAT GEN_TAC THEN
 917   ONCE_REWRITE_TAC[REAL_ARITH `a:real = b <=> a <= b /\ a = b`] THEN
 918   REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN
 919   MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN
 920   REWRITE_TAC[IN_ELIM_THM; CONVEX_HALFSPACE_LE]);;
 921
 922 let HYPERPLANE_FACE_OF_HALFSPACE_GE = prove
 923  (`!a:real^N b. {x | a dot x = b} face_of {x | a dot x >= b}`,
 924   REPEAT GEN_TAC THEN
 925   ONCE_REWRITE_TAC[REAL_ARITH `a:real = b <=> a >= b /\ a = b`] THEN
 926   REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN
 927   MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE THEN
 928   REWRITE_TAC[IN_ELIM_THM; CONVEX_HALFSPACE_GE]);;
 929
 930 let FACE_OF_HALFSPACE_LE = prove
 931  (`!f a:real^N b.
 932          f face_of {x | a dot x <= b} <=>
 933          f = {} \/ f = {x | a dot x = b} \/ f = {x | a dot x <= b}`,
 934   REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL
 935    [ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | p} = if p then UNIV else {}`] THEN
 936     REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[FACE_OF_EMPTY]) THEN
 937     ASM_SIMP_TAC[FACE_OF_AFFINE_EQ; AFFINE_UNIV; DISJ_ACI] THEN
 938     ASM_REAL_ARITH_TAC;
 939     ALL_TAC] THEN
 940   EQ_TAC THEN STRIP_TAC THEN
 941   ASM_SIMP_TAC[EMPTY_FACE_OF; FACE_OF_REFL; CONVEX_HALFSPACE_LE;
 942                HYPERPLANE_FACE_OF_HALFSPACE_LE] THEN
 943   MATCH_MP_TAC(TAUT `(~r ==> p \/ q) ==> p \/ q \/ r`) THEN DISCH_TAC THEN
 944   SUBGOAL_THEN `f face_of {x:real^N | a dot x = b}` MP_TAC THENL
 945    [ASM_SIMP_TAC[GSYM FRONTIER_HALFSPACE_LE] THEN
 946     ASM_SIMP_TAC[CONV_RULE(RAND_CONV SYM_CONV)
 947                   (SPEC_ALL RELATIVE_FRONTIER_NONEMPTY_INTERIOR);
 948                  INTERIOR_HALFSPACE_LE; HALFSPACE_EQ_EMPTY_LT] THEN
 949     MATCH_MP_TAC FACE_OF_SUBSET THEN
 950     EXISTS_TAC `{x:real^N | a dot x <= b}` THEN
 951     ASM_SIMP_TAC[FACE_OF_SUBSET_RELATIVE_FRONTIER] THEN
 952     ASM_SIMP_TAC[relative_frontier; CLOSURE_CLOSED; CLOSED_HALFSPACE_LE] THEN
 953     SET_TAC[];
 954     ASM_SIMP_TAC[FACE_OF_AFFINE_EQ; AFFINE_HYPERPLANE]]);;
 955
 956 let FACE_OF_HALFSPACE_GE = prove
 957  (`!f a:real^N b.
 958          f face_of {x | a dot x >= b} <=>
 959          f = {} \/ f = {x | a dot x = b} \/ f = {x | a dot x >= b}`,
 960   REPEAT GEN_TAC THEN
 961   MP_TAC(ISPECL [`f:real^N->bool`; `--a:real^N`; `--b:real`]
 962         FACE_OF_HALFSPACE_LE) THEN
 963   REWRITE_TAC[DOT_LNEG; REAL_LE_NEG2; REAL_EQ_NEG2; real_ge]);;
 964
 965 (* ------------------------------------------------------------------------- *)
 966 (* Exposed faces (faces that are intersection with supporting hyperplane).   *)
 967 (* ------------------------------------------------------------------------- *)
 968
 969 parse_as_infix("exposed_face_of",(12,"right"));;
 970
 971 let exposed_face_of = new_definition
 972  `t exposed_face_of s <=>
 973     t face_of s /\
 974     ?a b. s SUBSET {x | a dot x <= b} /\ t = s INTER {x | a dot x = b}`;;
 975
 976 let EMPTY_EXPOSED_FACE_OF = prove
 977  (`!s:real^N->bool. {} exposed_face_of s`,
 978   GEN_TAC THEN REWRITE_TAC[exposed_face_of; EMPTY_FACE_OF] THEN
 979   MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `&1:real`] THEN
 980   REWRITE_TAC[DOT_LZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SET_TAC[]);;
 981
 982 let EXPOSED_FACE_OF_REFL_EQ = prove
 983  (`!s:real^N->bool. s exposed_face_of s <=> convex s`,
 984   GEN_TAC THEN REWRITE_TAC[exposed_face_of; FACE_OF_REFL_EQ] THEN
 985   ASM_CASES_TAC `convex(s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN
 986   MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `&0:real`] THEN
 987   REWRITE_TAC[DOT_LZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SET_TAC[]);;
 988
 989 let EXPOSED_FACE_OF_REFL = prove
 990  (`!s:real^N->bool. convex s ==> s exposed_face_of s`,
 991   REWRITE_TAC[EXPOSED_FACE_OF_REFL_EQ]);;
 992
 993 let EXPOSED_FACE_OF = prove
 994  (`!s t. t exposed_face_of s <=>
 995              t face_of s /\
 996              (t = {} \/ t = s \/
 997               ?a b. ~(a = vec 0) /\
 998                     s SUBSET {x:real^N | a dot x <= b} /\
 999                     t = s INTER {x | a dot x = b})`,
1000   REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN
1001   ASM_REWRITE_TAC[EMPTY_EXPOSED_FACE_OF; EMPTY_FACE_OF] THEN
1002   ASM_CASES_TAC `t:real^N->bool = s` THEN
1003   ASM_REWRITE_TAC[EXPOSED_FACE_OF_REFL_EQ; FACE_OF_REFL_EQ] THEN
1004   REWRITE_TAC[exposed_face_of] THEN AP_TERM_TAC THEN
1005   EQ_TAC THENL [REWRITE_TAC[LEFT_IMP_EXISTS_THM]; MESON_TAC[]] THEN
1006   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN
1007   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
1008   MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real`] THEN
1009   ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_REWRITE_TAC[] THEN
1010   FIRST_X_ASSUM SUBST_ALL_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN
1011   REWRITE_TAC[DOT_LZERO] THEN SET_TAC[]);;
1012
1013 let EXPOSED_FACE_OF_TRANSLATION_EQ = prove
1014  (`!a f s:real^N->bool.
1015         (IMAGE (\x. a + x) f) exposed_face_of (IMAGE (\x. a + x) s) <=>
1016         f exposed_face_of s`,
1017   REPEAT GEN_TAC THEN REWRITE_TAC[exposed_face_of; FACE_OF_TRANSLATION_EQ] THEN
1018   MP_TAC(ISPEC `\x:real^N. a + x` QUANTIFY_SURJECTION_THM) THEN
1019   REWRITE_TAC[] THEN ANTS_TAC THENL
1020    [MESON_TAC[VECTOR_ARITH `y + (x - y):real^N = x`]; ALL_TAC] THEN
1021   DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
1022     [last(CONJUNCTS th)]) THEN
1023   REWRITE_TAC[end_itlist CONJ (!invariant_under_translation)] THEN
1024   REWRITE_TAC[DOT_RADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
1025   REWRITE_TAC[GSYM REAL_LE_SUB_LADD; GSYM REAL_EQ_SUB_LADD] THEN
1026   AP_TERM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN
1027   X_GEN_TAC `c:real^N` THEN REWRITE_TAC[] THEN
1028   EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THENL
1029    [EXISTS_TAC `b - (c:real^N) dot a`;
1030     EXISTS_TAC `b + (c:real^N) dot a`] THEN
1031   ASM_REWRITE_TAC[REAL_ARITH `(x + y) - y:real = x`]);;
1032
1033 add_translation_invariants [EXPOSED_FACE_OF_TRANSLATION_EQ];;
1034
1035 let EXPOSED_FACE_OF_LINEAR_IMAGE = prove
1036  (`!f:real^M->real^N c s.
1037       linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
1038       ==> ((IMAGE f c) exposed_face_of (IMAGE f s) <=> c exposed_face_of s)`,
1039   REPEAT STRIP_TAC THEN REWRITE_TAC[exposed_face_of] THEN
1040   BINOP_TAC THENL [ASM_MESON_TAC[FACE_OF_LINEAR_IMAGE]; ALL_TAC] THEN
1041   MP_TAC(ISPEC `f:real^M->real^N` QUANTIFY_SURJECTION_THM) THEN
1042   ASM_REWRITE_TAC[] THEN
1043   DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
1044     [last(CONJUNCTS th)]) THEN
1045   ONCE_REWRITE_TAC[DOT_SYM] THEN ASM_SIMP_TAC[ADJOINT_WORKS] THEN
1046   MP_TAC(end_itlist CONJ
1047    (mapfilter (ISPEC `f:real^M->real^N`) (!invariant_under_linear))) THEN
1048   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
1049   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN
1050   EQ_TAC THENL
1051    [DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
1052     EXISTS_TAC `adjoint(f:real^M->real^N) a` THEN ASM_REWRITE_TAC[];
1053     DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN
1054     MP_TAC(ISPEC `adjoint(f:real^M->real^N)`
1055       LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN
1056     ASM_SIMP_TAC[ADJOINT_SURJECTIVE; ADJOINT_LINEAR] THEN
1057     REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; LEFT_IMP_EXISTS_THM] THEN
1058     X_GEN_TAC `g:real^M->real^N` THEN STRIP_TAC THEN
1059     EXISTS_TAC `(g:real^M->real^N) a` THEN ASM_REWRITE_TAC[]]);;
1060
1061 let EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE = prove
1062  (`!s a:real^N b.
1063         convex s /\ (!x. x IN s ==> a dot x <= b)
1064         ==> (s INTER {x | a dot x = b}) exposed_face_of s`,
1065   SIMP_TAC[FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE; exposed_face_of] THEN
1066   SET_TAC[]);;
1067
1068 let EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE = prove
1069  (`!s a:real^N b.
1070         convex s /\ (!x. x IN s ==> a dot x >= b)
1071         ==> (s INTER {x | a dot x = b}) exposed_face_of s`,
1072   REWRITE_TAC[real_ge] THEN REPEAT STRIP_TAC THEN
1073   MP_TAC(ISPECL [`s:real^N->bool`; `--a:real^N`; `--b:real`]
1074     EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE) THEN
1075   ASM_REWRITE_TAC[DOT_LNEG; REAL_EQ_NEG2; REAL_LE_NEG2]);;
1076
1077 let EXPOSED_FACE_OF_INTER = prove
1078  (`!s t u:real^N->bool.
1079         t exposed_face_of s /\ u exposed_face_of s
1080         ==> (t INTER u) exposed_face_of s`,
1081   REPEAT GEN_TAC THEN SIMP_TAC[exposed_face_of; FACE_OF_INTER] THEN
1082   REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
1083   REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
1084   MAP_EVERY X_GEN_TAC
1085    [`a':real^N`; `b':real`; `a:real^N`; `b:real`] THEN
1086   REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN STRIP_TAC THEN
1087   ASM_REWRITE_TAC[] THEN
1088   MAP_EVERY EXISTS_TAC [`a + a':real^N`; `b + b':real`] THEN
1089   REWRITE_TAC[SET_RULE
1090    `(s INTER t1) INTER (s INTER t2) = s INTER u <=>
1091     !x. x IN s ==> (x IN t1 /\ x IN t2 <=> x IN u)`] THEN
1092   ASM_SIMP_TAC[DOT_LADD; REAL_LE_ADD2; IN_ELIM_THM] THEN
1093   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
1094   REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`)) THEN
1095   ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);;
1096
1097 let EXPOSED_FACE_OF_INTERS = prove
1098  (`!P s:real^N->bool.
1099         ~(P = {}) /\ (!t. t IN P ==> t exposed_face_of s)
1100         ==> INTERS P exposed_face_of s`,
1101   REPEAT STRIP_TAC THEN
1102   MP_TAC(ISPECL [`s:real^N->bool`; `P:(real^N->bool)->bool`]
1103     INTERS_FACES_FINITE_ALTBOUND) THEN
1104   ANTS_TAC THENL [ASM_MESON_TAC[exposed_face_of]; ALL_TAC] THEN
1105   DISCH_THEN(X_CHOOSE_THEN `Q:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
1106   FIRST_X_ASSUM(MP_TAC o SYM) THEN
1107   ASM_CASES_TAC `Q:(real^N->bool)->bool = {}` THENL
1108    [ASM_SIMP_TAC[INTERS_0] THEN
1109     REWRITE_TAC[SET_RULE `INTERS s = UNIV <=> !t. t IN s ==> t = UNIV`] THEN
1110     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
1111     ASM_MESON_TAC[];
1112     DISCH_THEN SUBST1_TAC THEN
1113     FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN
1114     SUBGOAL_THEN `!t:real^N->bool. t IN Q ==> t exposed_face_of s` MP_TAC THENL
1115      [ASM SET_TAC[]; UNDISCH_TAC `FINITE(Q:(real^N->bool)->bool)`] THEN
1116     SPEC_TAC(`Q:(real^N->bool)->bool`,`Q:(real^N->bool)->bool`) THEN
1117     POP_ASSUM_LIST(K ALL_TAC) THEN
1118     MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[FORALL_IN_INSERT] THEN
1119     MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `P:(real^N->bool)->bool`] THEN
1120     DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
1121     REWRITE_TAC[INTERS_INSERT] THEN
1122     ASM_CASES_TAC `P:(real^N->bool)->bool = {}` THEN
1123     ASM_SIMP_TAC[INTERS_0; INTER_UNIV; EXPOSED_FACE_OF_INTER]]);;
1124
1125 let EXPOSED_FACE_OF_SUMS = prove
1126  (`!s t f:real^N->bool.
1127         convex s /\ convex t /\
1128         f exposed_face_of {x + y | x IN s /\ y IN t}
1129         ==> ?k l. k exposed_face_of s /\ l exposed_face_of t /\
1130                   f = {x + y | x IN k /\ y IN l}`,
1131   REPEAT STRIP_TAC THEN
1132   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXPOSED_FACE_OF]) THEN
1133   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1134   ASM_CASES_TAC `f:real^N->bool = {}` THENL
1135    [DISCH_TAC THEN REPEAT (EXISTS_TAC `{}:real^N->bool`) THEN
1136     ASM_REWRITE_TAC[EMPTY_EXPOSED_FACE_OF] THEN SET_TAC[];
1137     ALL_TAC] THEN
1138   ASM_CASES_TAC `f = {x + y :real^N | x IN s /\ y IN t}` THENL
1139    [DISCH_TAC THEN
1140     MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN
1141     ASM_SIMP_TAC[EXPOSED_FACE_OF_REFL];
1142     ALL_TAC] THEN
1143   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
1144   MAP_EVERY X_GEN_TAC [`u:real^N`; `z:real`] THEN
1145   REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM] THEN
1146   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
1147   DISCH_THEN SUBST_ALL_TAC THEN
1148   RULE_ASSUM_TAC(REWRITE_RULE[GSYM SUBSET_INTER_ABSORPTION]) THEN
1149   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
1150   REWRITE_TAC[EXISTS_IN_GSPEC; IN_INTER] THEN
1151   REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
1152   MAP_EVERY X_GEN_TAC [`a0:real^N`; `b0:real^N`] THEN STRIP_TAC THEN
1153   FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
1154   EXISTS_TAC `s INTER {x:real^N | u dot x = u dot a0}` THEN
1155   EXISTS_TAC `t INTER {y:real^N | u dot y = u dot b0}` THEN
1156   REPEAT CONJ_TAC THENL
1157    [MATCH_MP_TAC EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN
1158     ASM_REWRITE_TAC[] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
1159     FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b0:real^N`]) THEN
1160     ASM_REWRITE_TAC[DOT_RADD] THEN REAL_ARITH_TAC;
1161     MATCH_MP_TAC EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN
1162     ASM_REWRITE_TAC[] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN
1163     FIRST_X_ASSUM(MP_TAC o SPECL [`a0:real^N`; `b:real^N`]) THEN
1164     ASM_REWRITE_TAC[DOT_RADD] THEN REAL_ARITH_TAC;
1165     ALL_TAC] THEN
1166   MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN
1167   REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_INTER; IMP_CONJ] THENL
1168    [ALL_TAC; SIMP_TAC[IN_INTER; IN_ELIM_THM; DOT_RADD] THEN MESON_TAC[]] THEN
1169   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
1170   DISCH_TAC THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM; DOT_RADD] THEN
1171   DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN
1172   ASM_REWRITE_TAC[] THEN
1173   FIRST_ASSUM(MP_TAC o SPECL  [`a:real^N`; `b0:real^N`]) THEN
1174   FIRST_X_ASSUM(MP_TAC o SPECL  [`a0:real^N`; `b:real^N`]) THEN
1175   ASM_REWRITE_TAC[DOT_RADD] THEN ASM_REAL_ARITH_TAC);;
1176
1177 let EXPOSED_FACE_OF_PARALLEL = prove
1178  (`!t s. t exposed_face_of s <=>
1179          t face_of s /\
1180           ?a b. s SUBSET {x:real^N | a dot x <= b} /\
1181                 t = s INTER {x | a dot x = b} /\
1182                 (~(t = {}) /\ ~(t = s) ==> ~(a = vec 0)) /\
1183                 (!w. w IN affine hull s /\ ~(t = s)
1184                      ==> (w + a) IN affine hull s)`,
1185   REPEAT GEN_TAC THEN REWRITE_TAC[exposed_face_of] THEN
1186   AP_TERM_TAC THEN EQ_TAC THENL
1187    [REWRITE_TAC[LEFT_IMP_EXISTS_THM];
1188     REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[]] THEN
1189   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN STRIP_TAC THEN
1190   MP_TAC(ISPECL [`affine hull s:real^N->bool`; `--a:real^N`; `--b:real`]
1191         AFFINE_PARALLEL_SLICE) THEN
1192   SIMP_TAC[AFFINE_AFFINE_HULL; DOT_LNEG; REAL_LE_NEG2; REAL_EQ_NEG2] THEN
1193   DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL
1194    [MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `&1`] THEN
1195     REWRITE_TAC[DOT_LZERO; REAL_POS; SET_RULE `{x | T} = UNIV`] THEN
1196     SIMP_TAC[SUBSET_UNIV; VECTOR_ADD_RID; REAL_ARITH `~(&0 = &1)`] THEN
1197     REWRITE_TAC[EMPTY_GSPEC] THEN ASM_REWRITE_TAC[INTER_EMPTY] THEN
1198     MATCH_MP_TAC(TAUT `p ==> p /\ ~(~p /\ q)`) THEN
1199     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
1200      `s' INTER t' = {}
1201       ==> s SUBSET s' /\ t SUBSET t' ==> s INTER t = {}`)) THEN
1202     REWRITE_TAC[HULL_SUBSET] THEN SIMP_TAC[SUBSET; IN_ELIM_THM; REAL_LE_REFL];
1203     SUBGOAL_THEN `t:real^N->bool = s` SUBST1_TAC THENL
1204      [FIRST_X_ASSUM SUBST1_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
1205       SUBGOAL_THEN `s SUBSET affine hull (s:real^N->bool)` MP_TAC THENL
1206        [REWRITE_TAC[HULL_SUBSET]; ASM SET_TAC[]];
1207       MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `&0`] THEN
1208       REWRITE_TAC[DOT_LZERO; SET_RULE `{x | T} = UNIV`; REAL_LE_REFL] THEN
1209       SET_TAC[]];
1210     FIRST_X_ASSUM(X_CHOOSE_THEN `a':real^N` MP_TAC) THEN
1211     DISCH_THEN(X_CHOOSE_THEN `b':real` STRIP_ASSUME_TAC) THEN
1212     MAP_EVERY EXISTS_TAC [`--a':real^N`; `--b':real`] THEN
1213     ASM_REWRITE_TAC[DOT_LNEG; REAL_LE_NEG2; REAL_EQ_NEG2] THEN
1214     REPEAT CONJ_TAC THENL
1215      [ONCE_REWRITE_TAC[REAL_ARITH `b <= a <=> ~(a <= b) \/ a = b`] THEN
1216       MATCH_MP_TAC(SET_RULE
1217        `!s'. s SUBSET s' /\
1218             s SUBSET (UNIV DIFF (s' INTER {x | P x})) UNION
1219                      (s' INTER {x | Q x})
1220             ==> s SUBSET {x | ~P x \/ Q x}`) THEN
1221       EXISTS_TAC `affine hull s:real^N->bool` THEN
1222       ASM_REWRITE_TAC[HULL_SUBSET] THEN
1223       MATCH_MP_TAC(SET_RULE
1224        `s SUBSET s' /\ s SUBSET (UNIV DIFF {x | P x}) UNION {x | Q x}
1225         ==> s SUBSET (UNIV DIFF (s' INTER {x | P x})) UNION
1226                      (s' INTER {x | Q x})`) THEN
1227       REWRITE_TAC[HULL_SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN
1228       EXISTS_TAC `{x:real^N | a dot x <= b}` THEN ASM_REWRITE_TAC[] THEN
1229       REWRITE_TAC[SUBSET; IN_DIFF; IN_UNIV; IN_UNION; IN_ELIM_THM] THEN
1230       REAL_ARITH_TAC;
1231       FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
1232        `s' INTER a = s' INTER b
1233         ==> s SUBSET s' ==> s INTER b = s INTER a`)) THEN
1234       REWRITE_TAC[HULL_SUBSET];
1235       ASM_REWRITE_TAC[VECTOR_NEG_EQ_0];
1236       ONCE_REWRITE_TAC[VECTOR_ARITH
1237        `w + --a:real^N = w + &1 % (w - (w + a))`] THEN
1238       ASM_SIMP_TAC[IN_AFFINE_ADD_MUL_DIFF; AFFINE_AFFINE_HULL]]]);;
1239
1240 (* ------------------------------------------------------------------------- *)
1241 (* Extreme points of a set, which are its singleton faces.                   *)
1242 (* ------------------------------------------------------------------------- *)
1243
1244 parse_as_infix("extreme_point_of",(12,"right"));;
1245
1246 let extreme_point_of = new_definition
1247  `x extreme_point_of s <=>
1248     x IN s /\ !a b. a IN s /\ b IN s ==> ~(x IN segment(a,b))`;;
1249
1250 let EXTREME_POINT_OF_STILLCONVEX = prove
1251  (`!s x:real^N.
1252         convex s ==> (x extreme_point_of s <=> x IN s /\ convex(s DELETE x))`,
1253   REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; extreme_point_of; open_segment] THEN
1254   REWRITE_TAC[IN_DIFF; IN_DELETE; IN_INSERT; NOT_IN_EMPTY; SUBSET_DELETE] THEN
1255   SET_TAC[]);;
1256
1257 let FACE_OF_SING = prove
1258  (`!x s. {x} face_of s <=> x extreme_point_of s`,
1259   SIMP_TAC[face_of; extreme_point_of; SING_SUBSET; CONVEX_SING; IN_SING] THEN
1260   MESON_TAC[SEGMENT_REFL; NOT_IN_EMPTY]);;
1261
1262 let EXTREME_POINT_NOT_IN_RELATIVE_INTERIOR = prove
1263  (`!s x:real^N.
1264         x extreme_point_of s /\ ~(s = {x})
1265         ==> ~(x IN relative_interior s)`,
1266   REPEAT GEN_TAC THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN
1267   REWRITE_TAC[GSYM FACE_OF_SING] THEN
1268   DISCH_THEN(MP_TAC o MATCH_MP FACE_OF_DISJOINT_RELATIVE_INTERIOR) THEN
1269   SET_TAC[]);;
1270
1271 let EXTREME_POINT_NOT_IN_INTERIOR = prove
1272  (`!s x:real^N. x extreme_point_of s ==> ~(x IN interior s)`,
1273   REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `s = {x:real^N}` THEN
1274   ASM_SIMP_TAC[EMPTY_INTERIOR_FINITE; FINITE_SING; NOT_IN_EMPTY] THEN
1275   DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET]
1276     INTERIOR_SUBSET_RELATIVE_INTERIOR)) THEN
1277   ASM_SIMP_TAC[EXTREME_POINT_NOT_IN_RELATIVE_INTERIOR]);;
1278
1279 let EXTREME_POINT_OF_FACE = prove
1280  (`!f s v. f face_of s
1281            ==> (v extreme_point_of f <=> v extreme_point_of s /\ v IN f)`,
1282   REWRITE_TAC[GSYM FACE_OF_SING; GSYM SING_SUBSET; FACE_OF_FACE]);;
1283
1284 let EXTREME_POINT_OF_MIDPOINT = prove
1285  (`!s x:real^N.
1286         convex s
1287         ==> (x extreme_point_of s <=>
1288              x IN s /\
1289              !a b. a IN s /\ b IN s /\ x = midpoint(a,b) ==> x = a /\ x = b)`,
1290   REPEAT STRIP_TAC THEN REWRITE_TAC[extreme_point_of] THEN
1291   AP_TERM_TAC THEN EQ_TAC THEN
1292   DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
1293   DISCH_TAC THENL
1294    [FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
1295     ASM_SIMP_TAC[MIDPOINT_IN_SEGMENT; MIDPOINT_REFL];
1296     ALL_TAC] THEN
1297   REWRITE_TAC[IN_SEGMENT] THEN DISCH_THEN(CONJUNCTS_THEN2
1298     ASSUME_TAC (X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC)) THEN
1299   ABBREV_TAC `d = min (&1 - u) u` THEN
1300   FIRST_X_ASSUM(MP_TAC o SPECL
1301    [`x - d / &2 % (b - a):real^N`; `x + d / &2 % (b - a):real^N`]) THEN
1302   REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL
1303    [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN
1304     ASM_REWRITE_TAC[VECTOR_ARITH
1305      `((&1 - u) % a + u % b) - d / &2 % (b - a):real^N =
1306       (&1 - (u - d / &2)) % a + (u - d / &2) % b`] THEN
1307     DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
1308     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN
1309     ASM_REWRITE_TAC[VECTOR_ARITH
1310      `((&1 - u) % a + u % b) + d / &2 % (b - a):real^N =
1311       (&1 - (u + d / &2)) % a + (u + d / &2) % b`] THEN
1312     DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
1313     REWRITE_TAC[midpoint] THEN VECTOR_ARITH_TAC;
1314     REWRITE_TAC[VECTOR_ARITH `x:real^N = x - d <=> d = vec 0`;
1315                 VECTOR_ARITH `x:real^N = x + d <=> d = vec 0`] THEN
1316     ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC]);;
1317
1318 let EXTREME_POINT_OF_CONVEX_HULL = prove
1319  (`!x:real^N s. x extreme_point_of (convex hull s) ==> x IN s`,
1320   REPEAT GEN_TAC THEN
1321   SIMP_TAC[EXTREME_POINT_OF_STILLCONVEX; CONVEX_CONVEX_HULL] THEN
1322   MP_TAC(ISPECL [`convex:(real^N->bool)->bool`; `s:real^N->bool`;
1323                  `(convex hull s) DELETE (x:real^N)`] HULL_MINIMAL) THEN
1324   MP_TAC(ISPECL [`convex:(real^N->bool)->bool`; `s:real^N->bool`]
1325         HULL_SUBSET) THEN
1326   ASM SET_TAC[]);;
1327
1328 let EXTREME_POINTS_OF_CONVEX_HULL = prove
1329  (`!s. {x | x extreme_point_of (convex hull s)} SUBSET s`,
1330   REWRITE_TAC[SUBSET; IN_ELIM_THM; EXTREME_POINT_OF_CONVEX_HULL]);;
1331
1332 let EXTREME_POINT_OF_EMPTY = prove
1333  (`!x. ~(x extreme_point_of {})`,
1334   REWRITE_TAC[extreme_point_of; NOT_IN_EMPTY]);;
1335
1336 let EXTREME_POINT_OF_SING = prove
1337  (`!a x. x extreme_point_of {a} <=> x = a`,
1338   REWRITE_TAC[extreme_point_of; IN_SING] THEN
1339   MESON_TAC[SEGMENT_REFL; NOT_IN_EMPTY]);;
1340
1341 let EXTREME_POINT_OF_TRANSLATION_EQ = prove
1342  (`!a:real^N x s.
1343            (a + x) extreme_point_of (IMAGE (\x. a + x) s) <=>
1344            x extreme_point_of s`,
1345   REWRITE_TAC[extreme_point_of] THEN GEOM_TRANSLATE_TAC[]);;
1346
1347 add_translation_invariants [EXTREME_POINT_OF_TRANSLATION_EQ];;
1348
1349 let EXTREME_POINT_OF_LINEAR_IMAGE = prove
1350  (`!f:real^M->real^N.
1351       linear f /\ (!x y. f x = f y ==> x = y)
1352       ==> ((f x) extreme_point_of (IMAGE f s) <=> x extreme_point_of s)`,
1353   REWRITE_TAC[GSYM FACE_OF_SING] THEN GEOM_TRANSFORM_TAC[]);;
1354
1355 add_linear_invariants [EXTREME_POINT_OF_LINEAR_IMAGE];;
1356
1357 let EXTREME_POINTS_OF_TRANSLATION = prove
1358  (`!a s. {x:real^N | x extreme_point_of (IMAGE (\x. a + x) s)} =
1359          IMAGE (\x. a + x) {x | x extreme_point_of s}`,
1360   REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN
1361   MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
1362   REWRITE_TAC[VECTOR_ARITH `a + x:real^N = y <=> x = y - a`; EXISTS_REFL] THEN
1363   REWRITE_TAC[IN_ELIM_THM; EXTREME_POINT_OF_TRANSLATION_EQ]);;
1364
1365 let EXTREME_POINT_OF_INTER = prove
1366  (`!x s t. x extreme_point_of s /\ x extreme_point_of t
1367            ==> x extreme_point_of (s INTER t)`,
1368   REWRITE_TAC[extreme_point_of; IN_INTER] THEN MESON_TAC[]);;
1369
1370 let EXTREME_POINTS_OF_LINEAR_IMAGE = prove
1371  (`!f:real^M->real^N.
1372         linear f /\ (!x y. f x = f y ==> x = y)
1373         ==> {y | y extreme_point_of (IMAGE f s)} =
1374             IMAGE f {x | x extreme_point_of s}`,
1375
1376   REPEAT GEN_TAC THEN DISCH_TAC THEN
1377   FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_SEGMENT_LINEAR_IMAGE) THEN
1378   MATCH_MP_TAC SUBSET_ANTISYM THEN
1379   REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC; SUBSET;
1380               extreme_point_of; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
1381   ASM_SIMP_TAC[FUN_IN_IMAGE; IN_ELIM_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN
1382   ASM SET_TAC[]);;
1383
1384 let EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE = prove
1385  (`!s a b c. (!x. x IN s ==> a dot x <= b) /\
1386              s INTER {x | a dot x = b} = {c}
1387              ==> c extreme_point_of s`,
1388   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FACE_OF_SING] THEN
1389   FIRST_ASSUM(SUBST1_TAC o SYM) THEN
1390   MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG THEN
1391   ASM_REWRITE_TAC[CONVEX_SING]);;
1392
1393 let EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE = prove
1394  (`!s a b c. (!x. x IN s ==> a dot x >= b) /\
1395              s INTER {x | a dot x = b} = {c}
1396              ==> c extreme_point_of s`,
1397   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FACE_OF_SING] THEN
1398   FIRST_ASSUM(SUBST1_TAC o SYM) THEN
1399   MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE_STRONG THEN
1400   ASM_REWRITE_TAC[CONVEX_SING]);;
1401
1402 let EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE = prove
1403  (`!s a b c:real^N.
1404         (!x. x IN s ==> a dot x <= b) /\
1405         s INTER {x | a dot x = b} = {c}
1406         ==> {c} exposed_face_of s`,
1407   REPEAT STRIP_TAC THEN REWRITE_TAC[exposed_face_of] THEN CONJ_TAC THENL
1408    [REWRITE_TAC[FACE_OF_SING] THEN
1409     MATCH_MP_TAC EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE;
1410     ALL_TAC] THEN
1411   MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real`] THEN ASM SET_TAC[]);;
1412
1413 let EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE = prove
1414  (`!s a b c:real^N.
1415         (!x. x IN s ==> a dot x >= b) /\
1416         s INTER {x | a dot x = b} = {c}
1417         ==> {c} exposed_face_of s`,
1418   REWRITE_TAC[real_ge] THEN REPEAT STRIP_TAC THEN
1419   MP_TAC(ISPECL [`s:real^N->bool`; `--a:real^N`; `--b:real`; `c:real^N`]
1420     EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE) THEN
1421   ASM_REWRITE_TAC[DOT_LNEG; REAL_EQ_NEG2; REAL_LE_NEG2]);;
1422
1423 let EXPOSED_POINT_OF_FURTHEST_POINT = prove
1424  (`!s a b:real^N.
1425         b IN s /\ (!x. x IN s ==> dist(a,x) <= dist(a,b))
1426         ==> {b} exposed_face_of s`,
1427   REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN
1428   REWRITE_TAC[DIST_0; NORM_LE] THEN REPEAT STRIP_TAC THEN
1429   MATCH_MP_TAC EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN
1430   MAP_EVERY EXISTS_TAC [`b:real^N`; `(b:real^N) dot b`] THEN CONJ_TAC THENL
1431    [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
1432     FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
1433     ASM_REWRITE_TAC[];
1434     MATCH_MP_TAC SUBSET_ANTISYM THEN
1435     ASM_REWRITE_TAC[IN_INTER; SING_SUBSET; IN_ELIM_THM] THEN
1436     REWRITE_TAC[SUBSET; IN_SING; IN_INTER; IN_ELIM_THM] THEN
1437     X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
1438     CONV_TAC SYM_CONV THEN ASM_REWRITE_TAC[VECTOR_EQ] THEN
1439     ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM] THEN
1440     UNDISCH_TAC `(b:real^N) dot x = b dot b`] THEN
1441   MP_TAC(ISPEC `b - x:real^N` DOT_POS_LE) THEN
1442   REWRITE_TAC[DOT_LSUB; DOT_RSUB; DOT_SYM] THEN REAL_ARITH_TAC);;
1443
1444 let COLLINEAR_EXTREME_POINTS = prove
1445  (`!s. collinear s
1446        ==> FINITE {x:real^N | x extreme_point_of s} /\
1447            CARD {x | x extreme_point_of s} <= 2`,
1448   REWRITE_TAC[GSYM NOT_LT; TAUT `a /\ ~b <=> ~(a ==> b)`] THEN
1449   REWRITE_TAC[ARITH_RULE `2 < n <=> 3 <= n`] THEN REPEAT STRIP_TAC THEN
1450   FIRST_ASSUM(MP_TAC o MATCH_MP CHOOSE_SUBSET_STRONG) THEN
1451   CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN
1452   REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN
1453   MAP_EVERY X_GEN_TAC
1454    [`t:real^N->bool`; `a:real^N`; `b:real^N`; `c:real^N`] THEN
1455   REPEAT STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN
1456   SUBGOAL_THEN
1457    `(a:real^N) extreme_point_of s /\
1458     b extreme_point_of s /\ c extreme_point_of s`
1459   STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
1460   SUBGOAL_THEN `(a:real^N) IN s /\ b IN s /\ c IN s` STRIP_ASSUME_TAC THENL
1461    [ASM_MESON_TAC[extreme_point_of]; ALL_TAC] THEN
1462   SUBGOAL_THEN `collinear {a:real^N,b,c}` MP_TAC THENL
1463    [MATCH_MP_TAC COLLINEAR_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN
1464     ASM SET_TAC[];
1465     REWRITE_TAC[COLLINEAR_BETWEEN_CASES; BETWEEN_IN_SEGMENT] THEN
1466     ASM_SIMP_TAC[SEGMENT_CLOSED_OPEN; IN_INSERT; NOT_IN_EMPTY; IN_UNION] THEN
1467     ASM_MESON_TAC[extreme_point_of]]);;
1468
1469 let EXTREME_POINT_OF_CONIC = prove
1470  (`!s x:real^N.
1471         conic s /\ x extreme_point_of s ==> x = vec 0`,
1472   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM FACE_OF_SING] THEN
1473   DISCH_THEN(MP_TAC o MATCH_MP FACE_OF_CONIC) THEN
1474   SIMP_TAC[conic; IN_SING; VECTOR_MUL_EQ_0; REAL_SUB_0; VECTOR_ARITH
1475     `c % x:real^N = x <=> (c - &1) % x = vec 0`] THEN
1476   MESON_TAC[REAL_ARITH `&0 <= &0 /\ ~(&1 = &0)`]);;
1477
1478 let EXTREME_POINT_OF_CONVEX_HULL_INSERT = prove
1479  (`!s a:real^N.
1480         FINITE s /\ ~(a IN convex hull s)
1481         ==> a extreme_point_of (convex hull (a INSERT s))`,
1482   REPEAT GEN_TAC THEN
1483   ASM_CASES_TAC `(a:real^N) IN s` THEN ASM_SIMP_TAC[HULL_INC] THEN
1484   STRIP_TAC THEN MP_TAC(ISPECL [`{a:real^N}`; `(a:real^N) INSERT s`]
1485     FACE_OF_CONVEX_HULLS) THEN
1486   ASM_REWRITE_TAC[FINITE_INSERT; AFFINE_HULL_SING; CONVEX_HULL_SING] THEN
1487   REWRITE_TAC[FACE_OF_SING] THEN DISCH_THEN MATCH_MP_TAC THEN
1488   ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> a INSERT s DIFF {a} = s`] THEN
1489   ASM SET_TAC[]);;
1490
1491 (* ------------------------------------------------------------------------- *)
1492 (* Facets.                                                                   *)
1493 (* ------------------------------------------------------------------------- *)
1494
1495 parse_as_infix("facet_of",(12, "right"));;
1496
1497 let facet_of = new_definition
1498  `f facet_of s <=> f face_of s /\ ~(f = {}) /\ aff_dim f = aff_dim s - &1`;;
1499
1500 let FACET_OF_EMPTY = prove
1501  (`!s. ~(s facet_of {})`,
1502   REWRITE_TAC[facet_of; FACE_OF_EMPTY] THEN CONV_TAC TAUT);;
1503
1504 let FACET_OF_REFL = prove
1505  (`!s. ~(s facet_of s)`,
1506   REWRITE_TAC[facet_of; INT_ARITH `~(x:int = x - &1)`]);;
1507
1508 let FACET_OF_IMP_FACE_OF = prove
1509  (`!f s. f facet_of s ==> f face_of s`,
1510   SIMP_TAC[facet_of]);;
1511
1512 let FACET_OF_IMP_SUBSET = prove
1513  (`!f s. f facet_of s ==> f SUBSET s`,
1514   SIMP_TAC[FACET_OF_IMP_FACE_OF; FACE_OF_IMP_SUBSET]);;
1515
1516 let FACET_OF_IMP_PROPER = prove
1517  (`!f s. f facet_of s ==> ~(f = {}) /\ ~(f = s)`,
1518   REWRITE_TAC[facet_of] THEN MESON_TAC[INT_ARITH `~(x - &1:int = x)`]);;
1519
1520 let FACET_OF_TRANSLATION_EQ = prove
1521  (`!a:real^N f s.
1522         (IMAGE (\x. a + x) f) facet_of (IMAGE (\x. a + x) s) <=> f facet_of s`,
1523   REWRITE_TAC[facet_of] THEN GEOM_TRANSLATE_TAC[]);;
1524
1525 add_translation_invariants [FACET_OF_TRANSLATION_EQ];;
1526
1527 let FACET_OF_LINEAR_IMAGE = prove
1528  (`!f:real^M->real^N c s.
1529       linear f /\ (!x y. f x = f y ==> x = y)
1530       ==> ((IMAGE f c) facet_of (IMAGE f s) <=> c facet_of s)`,
1531   REWRITE_TAC[facet_of] THEN GEOM_TRANSFORM_TAC[]);;
1532
1533 add_linear_invariants [FACET_OF_LINEAR_IMAGE];;
1534
1535 let HYPERPLANE_FACET_OF_HALFSPACE_LE = prove
1536  (`!a:real^N b.
1537         ~(a = vec 0) ==> {x | a dot x = b} facet_of {x | a dot x <= b}`,
1538   SIMP_TAC[facet_of; HYPERPLANE_FACE_OF_HALFSPACE_LE; HYPERPLANE_EQ_EMPTY;
1539            AFF_DIM_HYPERPLANE; AFF_DIM_HALFSPACE_LE]);;
1540
1541 let HYPERPLANE_FACET_OF_HALFSPACE_GE = prove
1542  (`!a:real^N b.
1543         ~(a = vec 0) ==> {x | a dot x = b} facet_of {x | a dot x >= b}`,
1544   SIMP_TAC[facet_of; HYPERPLANE_FACE_OF_HALFSPACE_GE; HYPERPLANE_EQ_EMPTY;
1545            AFF_DIM_HYPERPLANE; AFF_DIM_HALFSPACE_GE]);;
1546
1547 let FACET_OF_HALFSPACE_LE = prove
1548  (`!f a:real^N b.
1549         f facet_of {x | a dot x <= b} <=>
1550         ~(a = vec 0) /\ f = {x | a dot x = b}`,
1551   REPEAT GEN_TAC THEN
1552   EQ_TAC THEN ASM_SIMP_TAC[HYPERPLANE_FACET_OF_HALFSPACE_LE] THEN
1553   SIMP_TAC[AFF_DIM_HALFSPACE_LE; facet_of; FACE_OF_HALFSPACE_LE] THEN
1554   REWRITE_TAC[TAUT `(p \/ q) /\ ~p /\ r <=> (~p /\ q) /\ r`] THEN
1555   ASM_CASES_TAC `a:real^N = vec 0` THENL
1556    [ASM_REWRITE_TAC[DOT_LZERO; SET_RULE
1557      `{x | p} = if p then UNIV else {}`] THEN
1558     REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[TAUT `~(~p /\ p)`]) THEN
1559     TRY ASM_REAL_ARITH_TAC THEN
1560     DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
1561     ASM_REWRITE_TAC[AFF_DIM_UNIV] THEN TRY INT_ARITH_TAC THEN ASM SET_TAC[];
1562     DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
1563     ASM_REWRITE_TAC[AFF_DIM_HALFSPACE_LE] THEN INT_ARITH_TAC]);;
1564
1565 let FACET_OF_HALFSPACE_GE = prove
1566  (`!f a:real^N b.
1567         f facet_of {x | a dot x >= b} <=>
1568         ~(a = vec 0) /\ f = {x | a dot x = b}`,
1569   REPEAT GEN_TAC THEN
1570   MP_TAC(ISPECL [`f:real^N->bool`; `--a:real^N`; `--b:real`]
1571         FACET_OF_HALFSPACE_LE) THEN
1572   SIMP_TAC[DOT_LNEG; REAL_LE_NEG2; REAL_EQ_NEG2; VECTOR_NEG_EQ_0; real_ge]);;
1573
1574 (* ------------------------------------------------------------------------- *)
1575 (* Edges, i.e. faces of affine dimension 1.                                  *)
1576 (* ------------------------------------------------------------------------- *)
1577
1578 parse_as_infix("edge_of",(12, "right"));;
1579
1580 let edge_of = new_definition
1581  `e edge_of s <=> e face_of s /\ aff_dim e = &1`;;
1582
1583 let EDGE_OF_TRANSLATION_EQ = prove
1584  (`!a:real^N f s.
1585         (IMAGE (\x. a + x) f) edge_of (IMAGE (\x. a + x) s) <=> f edge_of s`,
1586   REWRITE_TAC[edge_of] THEN GEOM_TRANSLATE_TAC[]);;
1587
1588 add_translation_invariants [EDGE_OF_TRANSLATION_EQ];;
1589
1590 let EDGE_OF_LINEAR_IMAGE = prove
1591  (`!f:real^M->real^N c s.
1592       linear f /\ (!x y. f x = f y ==> x = y)
1593       ==> ((IMAGE f c) edge_of (IMAGE f s) <=> c edge_of s)`,
1594   REWRITE_TAC[edge_of] THEN GEOM_TRANSFORM_TAC[]);;
1595
1596 add_linear_invariants [EDGE_OF_LINEAR_IMAGE];;
1597
1598 let EDGE_OF_IMP_SUBSET = prove
1599  (`!s t. s edge_of t ==> s SUBSET t`,
1600   SIMP_TAC[edge_of; face_of]);;
1601
1602 (* ------------------------------------------------------------------------- *)
1603 (* Existence of extreme points.                                              *)
1604 (* ------------------------------------------------------------------------- *)
1605
1606 let DIFFERENT_NORM_3_COLLINEAR_POINTS = prove
1607  (`!a b x:real^N.
1608      ~(x IN segment(a,b) /\ norm(a) = norm(b) /\ norm(x) = norm(b))`,
1609   REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN
1610   ASM_SIMP_TAC[SEGMENT_REFL; NOT_IN_EMPTY; OPEN_SEGMENT_ALT] THEN
1611   REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN
1612    (CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) MP_TAC) THEN
1613   ASM_REWRITE_TAC[NORM_EQ] THEN REWRITE_TAC[VECTOR_ARITH
1614    `(x + y:real^N) dot (x + y) = x dot x + &2 * x dot y + y dot y`] THEN
1615   REWRITE_TAC[DOT_LMUL; DOT_RMUL] THEN
1616   DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) MP_TAC) THEN
1617   UNDISCH_TAC `~(a:real^N = b)` THEN
1618   GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM VECTOR_SUB_EQ] THEN
1619   REWRITE_TAC[GSYM DOT_EQ_0; VECTOR_ARITH
1620    `(a - b:real^N) dot (a - b) = a dot a + b dot b - &2 * a dot b`] THEN
1621   ASM_REWRITE_TAC[REAL_RING `a + a - &2 * ab = &0 <=> ab = a`] THEN
1622   SIMP_TAC[REAL_RING
1623    `(&1 - u) * (&1 - u) * a + &2 * (&1 - u) * u * x + u * u * a = a <=>
1624     x = a \/ u = &0 \/ u = &1`] THEN
1625   ASM_REAL_ARITH_TAC);;
1626
1627 let EXTREME_POINT_EXISTS_CONVEX = prove
1628  (`!s:real^N->bool.
1629         compact s /\ convex s /\ ~(s = {}) ==> ?x. x extreme_point_of s`,
1630   REPEAT STRIP_TAC THEN
1631   MP_TAC(ISPECL [`s:real^N->bool`; `vec 0:real^N`] DISTANCE_ATTAINS_SUP) THEN
1632   ASM_REWRITE_TAC[DIST_0; extreme_point_of] THEN
1633   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN
1634   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
1635   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
1636   REPEAT STRIP_TAC THEN
1637   MP_TAC(ISPECL [`a:real^N`; `b:real^N`; `x:real^N`]
1638      DIFFERENT_NORM_3_COLLINEAR_POINTS) THEN
1639   ASM_REWRITE_TAC[] THEN
1640   MATCH_MP_TAC(REAL_ARITH
1641    `a <= x /\ b <= x /\ (a < x ==> x < x) /\ (b < x ==> x < x)
1642     ==> a = b /\ x = b`) THEN
1643   ASM_SIMP_TAC[] THEN
1644   UNDISCH_TAC `(x:real^N) IN segment(a,b)` THEN
1645   ASM_CASES_TAC `a:real^N = b` THEN
1646   ASM_REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY] THEN
1647   ASM_SIMP_TAC[OPEN_SEGMENT_ALT; IN_ELIM_THM] THEN
1648   DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN
1649   CONJ_TAC THEN DISCH_TAC THEN
1650   FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN
1651   MATCH_MP_TAC NORM_TRIANGLE_LT THEN REWRITE_TAC[NORM_MUL] THEN
1652   ASM_SIMP_TAC[REAL_ARITH
1653    `&0 < u /\ u < &1 ==> abs u = u /\ abs(&1 - u) = &1 - u`] THEN
1654   SUBST1_TAC(REAL_RING `norm(x:real^N) = (&1 - u) * norm x + u * norm x`) THENL
1655    [MATCH_MP_TAC REAL_LTE_ADD2; MATCH_MP_TAC REAL_LET_ADD2] THEN
1656   ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_LMUL_EQ; REAL_SUB_LT]);;
1657
1658 (* ------------------------------------------------------------------------- *)
1659 (* Krein-Milman, the weaker form as in more general spaces first.            *)
1660 (* ------------------------------------------------------------------------- *)
1661
1662 let KREIN_MILMAN = prove
1663  (`!s:real^N->bool.
1664         convex s /\ compact s
1665         ==> s = closure(convex hull {x | x extreme_point_of s})`,
1666   GEN_TAC THEN
1667   ASM_CASES_TAC `s:real^N->bool = {}` THENL
1668    [ASM_REWRITE_TAC[extreme_point_of; NOT_IN_EMPTY; EMPTY_GSPEC] THEN
1669     REWRITE_TAC[CONVEX_HULL_EMPTY; CLOSURE_EMPTY];
1670     ALL_TAC] THEN
1671   STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
1672    [ALL_TAC;
1673     MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN
1674     MATCH_MP_TAC HULL_MINIMAL THEN
1675     ASM_SIMP_TAC[SUBSET; IN_ELIM_THM; extreme_point_of]] THEN
1676   REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
1677   X_GEN_TAC `u:real^N` THEN DISCH_TAC THEN
1678   MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
1679   MP_TAC(ISPECL [`closure(convex hull {x:real^N | x extreme_point_of s})`;
1680                  `u:real^N`] SEPARATING_HYPERPLANE_CLOSED_POINT) THEN
1681   ASM_SIMP_TAC[CONVEX_CLOSURE; CLOSED_CLOSURE; CONVEX_CONVEX_HULL] THEN
1682   REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b) <=> a ==> ~b`] THEN
1683   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN REPEAT STRIP_TAC THEN
1684   MP_TAC(ISPECL [`\x:real^N. a dot x`; `s:real^N->bool`]
1685     CONTINUOUS_ATTAINS_INF) THEN
1686   ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_DOT] THEN
1687   DISCH_THEN(X_CHOOSE_THEN `m:real^N` STRIP_ASSUME_TAC) THEN
1688   ABBREV_TAC `t = {x:real^N | x IN s /\ a dot x = a dot m}` THEN
1689   SUBGOAL_THEN `?x:real^N. x extreme_point_of t` (X_CHOOSE_TAC `v:real^N`)
1690   THENL
1691    [MATCH_MP_TAC EXTREME_POINT_EXISTS_CONVEX THEN
1692     EXPAND_TAC "t" THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
1693     REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN
1694     ASM_SIMP_TAC[CONVEX_INTER; CONVEX_HYPERPLANE; COMPACT_INTER_CLOSED;
1695                  CLOSED_HYPERPLANE] THEN
1696     ASM SET_TAC[];
1697     ALL_TAC] THEN
1698   SUBGOAL_THEN `(v:real^N) extreme_point_of s` ASSUME_TAC THENL
1699    [REWRITE_TAC[GSYM FACE_OF_SING] THEN MATCH_MP_TAC FACE_OF_TRANS THEN
1700     EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_SING] THEN
1701     EXPAND_TAC "t" THEN
1702     REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN
1703     MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE THEN
1704     ASM_SIMP_TAC[real_ge];
1705     SUBGOAL_THEN `(a:real^N) dot v > b` MP_TAC THENL
1706      [FIRST_X_ASSUM MATCH_MP_TAC THEN
1707       MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN
1708       MATCH_MP_TAC HULL_INC THEN ASM_REWRITE_TAC[IN_ELIM_THM];
1709       ALL_TAC] THEN
1710     REWRITE_TAC[real_gt; REAL_NOT_LT] THEN
1711     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(a:real^N) dot u` THEN
1712     ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN
1713     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(a:real^N) dot m` THEN
1714     ASM_SIMP_TAC[] THEN
1715     UNDISCH_TAC `(v:real^N) extreme_point_of t` THEN EXPAND_TAC "t" THEN
1716     SIMP_TAC[extreme_point_of; IN_ELIM_THM; REAL_LE_REFL]]);;
1717
1718 (* ------------------------------------------------------------------------- *)
1719 (* Now the sharper form.                                                     *)
1720 (* ------------------------------------------------------------------------- *)
1721
1722 let KREIN_MILMAN_MINKOWSKI = prove
1723  (`!s:real^N->bool.
1724         convex s /\ compact s
1725         ==> s = convex hull {x | x extreme_point_of s}`,
1726   SUBGOAL_THEN
1727    `!s:real^N->bool.
1728         convex s /\ compact s /\ (vec 0) IN s
1729         ==> (vec 0) IN convex hull {x | x extreme_point_of s}`
1730   ASSUME_TAC THENL
1731    [GEN_TAC THEN WF_INDUCT_TAC `dim(s:real^N->bool)` THEN STRIP_TAC THEN
1732     ASM_CASES_TAC `(vec 0:real^N) IN relative_interior s` THENL
1733      [MP_TAC(ISPEC `s:real^N->bool` KREIN_MILMAN) THEN
1734       ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
1735       UNDISCH_TAC `(vec 0:real^N) IN relative_interior s` THEN
1736       FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC
1737        (LAND_CONV o RAND_CONV o RAND_CONV) [th]) THEN
1738       SIMP_TAC[CONVEX_RELATIVE_INTERIOR_CLOSURE; CONVEX_CONVEX_HULL] THEN
1739       MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET];
1740       ALL_TAC] THEN
1741     SUBGOAL_THEN `~(relative_interior(s:real^N->bool) = {})` ASSUME_TAC THENL
1742      [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY] THEN ASM SET_TAC[];
1743       ALL_TAC] THEN
1744     MP_TAC(ISPECL [`s:real^N->bool`; `vec 0:real^N`]
1745           SUPPORTING_HYPERPLANE_RELATIVE_BOUNDARY) THEN
1746     ASM_REWRITE_TAC[DOT_RZERO] THEN
1747     DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
1748     MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `&0`]
1749       FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE) THEN
1750     ASM_REWRITE_TAC[real_ge] THEN DISCH_TAC THEN
1751     SUBGOAL_THEN
1752      `(vec 0:real^N) IN convex hull
1753           {x | x extreme_point_of (s INTER {x | a dot x = &0})}`
1754     MP_TAC THENL
1755      [ALL_TAC;
1756       MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN
1757       MATCH_MP_TAC HULL_MONO THEN REWRITE_TAC[SUBSET] THEN
1758       GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM; GSYM FACE_OF_SING] THEN
1759       ASM_MESON_TAC[FACE_OF_TRANS]] THEN
1760     RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
1761     ASM_SIMP_TAC[CONVEX_INTER; CONVEX_HYPERPLANE; COMPACT_INTER_CLOSED;
1762                  CLOSED_HYPERPLANE; IN_INTER; IN_ELIM_THM; DOT_RZERO] THEN
1763     REWRITE_TAC[GSYM NOT_LE] THEN DISCH_TAC THEN
1764     MP_TAC(ISPECL
1765      [`s INTER {x:real^N | a dot x = &0}`; `s:real^N->bool`]
1766           DIM_EQ_SPAN) THEN
1767     ASM_REWRITE_TAC[INTER_SUBSET; EXTENSION; NOT_FORALL_THM] THEN
1768     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
1769     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN
1770     MATCH_MP_TAC(TAUT `b /\ ~a ==> ~(a <=> b)`) THEN CONJ_TAC THENL
1771      [ASM_MESON_TAC[SUBSET; SPAN_INC; RELATIVE_INTERIOR_SUBSET]; ALL_TAC] THEN
1772     SUBGOAL_THEN
1773      `!x:real^N. x IN span (s INTER {x | a dot x = &0}) ==> a dot x = &0`
1774      (fun th -> ASM_MESON_TAC[th; REAL_LT_REFL]) THEN
1775     MATCH_MP_TAC SPAN_INDUCT THEN SIMP_TAC[IN_INTER; IN_ELIM_THM] THEN
1776     REWRITE_TAC[subspace; DOT_RZERO; DOT_RADD; DOT_RMUL; IN_ELIM_THM] THEN
1777     CONV_TAC REAL_RING;
1778     ALL_TAC] THEN
1779   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
1780    [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
1781     FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\x:real^N. --a + x) s`) THEN
1782     ASM_SIMP_TAC[CONVEX_TRANSLATION_EQ; COMPACT_TRANSLATION_EQ] THEN
1783     REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN
1784     ASM_REWRITE_TAC[UNWIND_THM2] THEN
1785     REWRITE_TAC[EXTREME_POINTS_OF_TRANSLATION; CONVEX_HULL_TRANSLATION] THEN
1786     REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN
1787     REWRITE_TAC[UNWIND_THM2];
1788     MATCH_MP_TAC HULL_MINIMAL THEN
1789     ASM_SIMP_TAC[SUBSET; extreme_point_of; IN_ELIM_THM]]);;
1790
1791 (* ------------------------------------------------------------------------- *)
1792 (* Applying it to convex hulls of explicitly indicated finite sets.          *)
1793 (* ------------------------------------------------------------------------- *)
1794
1795 let KREIN_MILMAN_POLYTOPE = prove
1796  (`!s. FINITE s
1797        ==> convex hull s =
1798            convex hull {x | x extreme_point_of (convex hull s)}`,
1799   SIMP_TAC[KREIN_MILMAN_MINKOWSKI; CONVEX_CONVEX_HULL;
1800            COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT]);;
1801
1802 let EXTREME_POINTS_OF_CONVEX_HULL_EQ = prove
1803  (`!s:real^N->bool.
1804         compact s /\
1805         (!t. t PSUBSET s ==> ~(convex hull t = convex hull s))
1806         ==> {x | x extreme_point_of (convex hull s)} = s`,
1807   REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC
1808    `{x:real^N | x extreme_point_of (convex hull s)}`) THEN
1809   MATCH_MP_TAC(SET_RULE
1810    `P /\ t SUBSET s ==> (t PSUBSET s ==> ~P) ==> t = s`) THEN
1811   REWRITE_TAC[EXTREME_POINTS_OF_CONVEX_HULL] THEN
1812   CONV_TAC SYM_CONV THEN MATCH_MP_TAC KREIN_MILMAN_MINKOWSKI THEN
1813   ASM_SIMP_TAC[CONVEX_CONVEX_HULL; COMPACT_CONVEX_HULL]);;
1814
1815 let EXTREME_POINT_OF_CONVEX_HULL_EQ = prove
1816  (`!s x:real^N.
1817         compact s /\
1818         (!t. t PSUBSET s ==> ~(convex hull t = convex hull s))
1819         ==> (x extreme_point_of (convex hull s) <=> x IN s)`,
1820   REPEAT GEN_TAC THEN
1821   DISCH_THEN(MP_TAC o MATCH_MP EXTREME_POINTS_OF_CONVEX_HULL_EQ) THEN
1822   SET_TAC[]);;
1823
1824 let EXTREME_POINT_OF_CONVEX_HULL_CONVEX_INDEPENDENT = prove
1825  (`!s x:real^N.
1826         compact s /\
1827         (!a. a IN s ==> ~(a IN convex hull (s DELETE a)))
1828         ==> (x extreme_point_of (convex hull s) <=> x IN s)`,
1829   REPEAT STRIP_TAC THEN MATCH_MP_TAC EXTREME_POINT_OF_CONVEX_HULL_EQ THEN
1830   ASM_REWRITE_TAC[PSUBSET_MEMBER] THEN X_GEN_TAC `t:real^N->bool` THEN
1831   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `a:real^N`)) THEN
1832   DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N`) THEN
1833   ASM_REWRITE_TAC[] THEN
1834   SUBGOAL_THEN `s SUBSET convex hull (s DELETE (a:real^N))` MP_TAC THENL
1835    [ALL_TAC; ASM SET_TAC[]] THEN
1836   MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull t:real^N->bool` THEN
1837   CONJ_TAC THENL
1838    [ASM_REWRITE_TAC[HULL_SUBSET];
1839     MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]]);;
1840
1841 let EXTREME_POINT_OF_CONVEX_HULL_AFFINE_INDEPENDENT = prove
1842  (`!s x. ~affine_dependent s
1843          ==> (x extreme_point_of (convex hull s) <=> x IN s)`,
1844   REPEAT STRIP_TAC THEN
1845   MATCH_MP_TAC EXTREME_POINT_OF_CONVEX_HULL_CONVEX_INDEPENDENT THEN
1846   ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE; FINITE_IMP_COMPACT] THEN
1847   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [affine_dependent]) THEN
1848   MESON_TAC[SUBSET; CONVEX_HULL_SUBSET_AFFINE_HULL]);;
1849
1850 let EXTREME_POINT_OF_CONVEX_HULL_2 = prove
1851  (`!a b x. x extreme_point_of (convex hull {a,b}) <=> x = a \/ x = b`,
1852   REWRITE_TAC[SET_RULE `x = a \/ x = b <=> x IN {a,b}`] THEN
1853   SIMP_TAC[EXTREME_POINT_OF_CONVEX_HULL_AFFINE_INDEPENDENT;
1854            AFFINE_INDEPENDENT_2]);;
1855
1856 let EXTREME_POINT_OF_SEGMENT = prove
1857  (`!a b x:real^N. x extreme_point_of segment[a,b] <=> x = a \/ x = b`,
1858   REWRITE_TAC[SEGMENT_CONVEX_HULL; EXTREME_POINT_OF_CONVEX_HULL_2]);;
1859
1860 let FACE_OF_CONVEX_HULL_SUBSET = prove
1861  (`!s t:real^N->bool.
1862         compact s /\ t face_of (convex hull s)
1863         ==> ?s'. s' SUBSET s /\ t = convex hull s'`,
1864   REPEAT STRIP_TAC THEN EXISTS_TAC `{x:real^N | x extreme_point_of t}` THEN
1865   REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL
1866    [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
1867     MATCH_MP_TAC EXTREME_POINT_OF_CONVEX_HULL THEN
1868     ASM_MESON_TAC[FACE_OF_SING; FACE_OF_TRANS];
1869     MATCH_MP_TAC KREIN_MILMAN_MINKOWSKI THEN
1870     ASM_MESON_TAC[FACE_OF_IMP_CONVEX; FACE_OF_IMP_COMPACT;
1871                   COMPACT_CONVEX_HULL; CONVEX_CONVEX_HULL]]);;
1872
1873 let FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT = prove
1874  (`!s t:real^N->bool.
1875         ~affine_dependent s
1876         ==> (t face_of (convex hull s) <=>
1877              ?c. c SUBSET s /\ t = convex hull c)`,
1878   REPEAT STRIP_TAC THEN EQ_TAC THENL
1879    [ASM_MESON_TAC[AFFINE_INDEPENDENT_IMP_FINITE; FINITE_IMP_COMPACT;
1880                   FACE_OF_CONVEX_HULL_SUBSET];
1881     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
1882     MATCH_MP_TAC FACE_OF_CONVEX_HULLS THEN
1883     ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE] THEN
1884     MATCH_MP_TAC(SET_RULE `
1885      !t. u SUBSET t /\ DISJOINT s t ==> DISJOINT s u`) THEN
1886     EXISTS_TAC `affine hull (s DIFF c:real^N->bool)` THEN
1887     REWRITE_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL] THEN
1888     MATCH_MP_TAC DISJOINT_AFFINE_HULL THEN
1889     EXISTS_TAC `s:real^N->bool` THEN ASM SET_TAC[]]);;
1890
1891 let FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT = prove
1892  (`!s t:real^N->bool.
1893         ~affine_dependent s
1894         ==> (t facet_of (convex hull s) <=>
1895              ~(t = {}) /\ ?u. u IN s /\ t = convex hull (s DELETE u))`,
1896   REPEAT STRIP_TAC THEN
1897   ASM_SIMP_TAC[facet_of; FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT] THEN
1898   REWRITE_TAC[AFF_DIM_CONVEX_HULL] THEN EQ_TAC THENL
1899    [DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
1900     DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` MP_TAC) THEN
1901     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN
1902     UNDISCH_TAC
1903      `aff_dim(convex hull c:real^N->bool) = aff_dim(s:real^N->bool) - &1` THEN
1904     SUBGOAL_THEN `~affine_dependent(c:real^N->bool)` ASSUME_TAC THENL
1905      [ASM_MESON_TAC[AFFINE_INDEPENDENT_SUBSET];
1906       ASM_SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT; AFF_DIM_CONVEX_HULL]] THEN
1907     REWRITE_TAC[INT_ARITH `x - &1:int = y - &1 - &1 <=> y = x + &1`] THEN
1908     REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_EQ] THEN DISCH_TAC THEN
1909     SUBGOAL_THEN `(s DIFF c:real^N->bool) HAS_SIZE 1` MP_TAC THENL
1910      [ASM_SIMP_TAC[HAS_SIZE; FINITE_DIFF; CARD_DIFF;
1911                    AFFINE_INDEPENDENT_IMP_FINITE] THEN ARITH_TAC;
1912       CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN
1913       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N` THEN
1914       DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
1915        `s DIFF t = {a} ==> t SUBSET s ==> s = a INSERT t`)) THEN
1916       ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN
1917       UNDISCH_TAC `CARD((u:real^N) INSERT c) = CARD c + 1` THEN
1918       ASM_SIMP_TAC[CARD_CLAUSES; AFFINE_INDEPENDENT_IMP_FINITE] THEN
1919       COND_CASES_TAC THENL [ARITH_TAC; DISCH_THEN(K ALL_TAC)] THEN
1920       CONJ_TAC THENL [ALL_TAC; AP_TERM_TAC] THEN ASM SET_TAC[]];
1921     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN
1922     DISCH_THEN(X_CHOOSE_THEN `u:real^N` MP_TAC) THEN
1923     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC) THEN
1924     CONJ_TAC THENL [MESON_TAC[DELETE_SUBSET]; ALL_TAC] THEN
1925     ASM_SIMP_TAC[AFF_DIM_CONVEX_HULL] THEN
1926     SUBGOAL_THEN `~affine_dependent(s DELETE (u:real^N))` ASSUME_TAC THENL
1927      [ASM_MESON_TAC[AFFINE_INDEPENDENT_SUBSET; DELETE_SUBSET];
1928       ASM_SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT]] THEN
1929     REWRITE_TAC[INT_ARITH `x - &1:int = y - &1 - &1 <=> y = x + &1`] THEN
1930     REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_EQ] THEN
1931     ASM_SIMP_TAC[CARD_DELETE; AFFINE_INDEPENDENT_IMP_FINITE] THEN
1932     MATCH_MP_TAC(ARITH_RULE `~(s = 0) ==> s = s - 1 + 1`) THEN
1933     ASM_SIMP_TAC[CARD_EQ_0; AFFINE_INDEPENDENT_IMP_FINITE] THEN
1934     ASM SET_TAC[]]);;
1935
1936 let FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT_ALT = prove
1937  (`!s t:real^N->bool.
1938         ~affine_dependent s
1939         ==> (t facet_of (convex hull s) <=>
1940              2 <= CARD s /\ ?u. u IN s /\ t = convex hull (s DELETE u))`,
1941   REPEAT STRIP_TAC THEN
1942   ASM_SIMP_TAC[FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT] THEN
1943   REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN AP_TERM_TAC THEN
1944   GEN_REWRITE_TAC I [FUN_EQ_THM] THEN
1945   X_GEN_TAC `u:real^N` THEN
1946   ASM_CASES_TAC `t = convex hull (s DELETE (u:real^N))` THEN
1947   ASM_REWRITE_TAC[CONVEX_HULL_EQ_EMPTY] THEN
1948   ASM_CASES_TAC `(u:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
1949   SUBGOAL_THEN `CARD s = 1 + CARD(s DELETE (u:real^N))` SUBST1_TAC THENL
1950    [ASM_SIMP_TAC[CARD_DELETE; AFFINE_INDEPENDENT_IMP_FINITE] THEN
1951     MATCH_MP_TAC(ARITH_RULE `~(s = 0) ==> s = 1 + s - 1`) THEN
1952     ASM_SIMP_TAC[CARD_EQ_0; AFFINE_INDEPENDENT_IMP_FINITE] THEN
1953     ASM SET_TAC[];
1954     REWRITE_TAC[ARITH_RULE `2 <= 1 + x <=> ~(x = 0)`] THEN
1955     ASM_SIMP_TAC[CARD_EQ_0; AFFINE_INDEPENDENT_IMP_FINITE; FINITE_DELETE]]);;
1956
1957 let SEGMENT_FACE_OF = prove
1958  (`!s a b:real^N.
1959     segment[a,b] face_of s ==> a extreme_point_of s /\ b extreme_point_of s`,
1960   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FACE_OF_SING] THEN
1961   MATCH_MP_TAC FACE_OF_TRANS THEN EXISTS_TAC `segment[a:real^N,b]` THEN
1962   ASM_REWRITE_TAC[] THEN REWRITE_TAC[FACE_OF_SING; EXTREME_POINT_OF_SEGMENT]);;
1963
1964 let SEGMENT_EDGE_OF = prove
1965  (`!s a b:real^N.
1966         segment[a,b] edge_of s
1967         ==> ~(a = b) /\ a extreme_point_of s /\ b extreme_point_of s`,
1968   REPEAT GEN_TAC THEN DISCH_TAC THEN CONJ_TAC THENL
1969    [ALL_TAC; ASM_MESON_TAC[edge_of; SEGMENT_FACE_OF]] THEN
1970   POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
1971   SIMP_TAC[SEGMENT_REFL; edge_of; AFF_DIM_SING] THEN INT_ARITH_TAC);;
1972
1973 let COMPACT_CONVEX_COLLINEAR_SEGMENT = prove
1974  (`!s:real^N->bool.
1975         ~(s = {}) /\ compact s /\ convex s /\ collinear s
1976         ==> ?a b. s = segment[a,b]`,
1977   REPEAT STRIP_TAC THEN
1978   MP_TAC(ISPEC `s:real^N->bool` KREIN_MILMAN_MINKOWSKI) THEN
1979   FIRST_ASSUM(MP_TAC o MATCH_MP COLLINEAR_EXTREME_POINTS) THEN
1980   REWRITE_TAC[ARITH_RULE `n <= 2 <=> n = 0 \/ n = 1 \/ n = 2`] THEN
1981   REWRITE_TAC[LEFT_OR_DISTRIB; GSYM HAS_SIZE] THEN
1982   CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN
1983   STRIP_TAC THEN ASM_REWRITE_TAC[CONVEX_HULL_EMPTY; SEGMENT_CONVEX_HULL] THEN
1984   DISCH_THEN SUBST1_TAC THEN MESON_TAC[SET_RULE `{a} = {a,a}`]);;
1985
1986 let KREIN_MILMAN_RELATIVE_FRONTIER = prove
1987  (`!s:real^N->bool.
1988         convex s /\ compact s /\ ~(?a. s = {a})
1989         ==> s = convex hull (s DIFF relative_interior s)`,
1990   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
1991    [MATCH_MP_TAC SUBSET_TRANS THEN
1992     EXISTS_TAC `convex hull {x:real^N | x extreme_point_of s}` THEN
1993     CONJ_TAC THENL
1994      [ASM_SIMP_TAC[GSYM KREIN_MILMAN_MINKOWSKI; SUBSET_REFL];
1995       MATCH_MP_TAC HULL_MONO THEN SIMP_TAC[SUBSET; IN_ELIM_THM; IN_DIFF] THEN
1996       ASM_MESON_TAC[EXTREME_POINT_NOT_IN_RELATIVE_INTERIOR; extreme_point_of]];
1997     MATCH_MP_TAC SUBSET_TRANS THEN
1998     EXISTS_TAC `convex hull s:real^N->bool` THEN CONJ_TAC THENL
1999      [MATCH_MP_TAC HULL_MONO THEN SET_TAC[];
2000       ASM_SIMP_TAC[HULL_P; SUBSET_REFL]]]);;
2001
2002 let KREIN_MILMAN_FRONTIER = prove
2003  (`!s:real^N->bool.
2004         convex s /\ compact s
2005         ==> s = convex hull (frontier s)`,
2006   REPEAT STRIP_TAC THEN
2007   ASM_SIMP_TAC[frontier; COMPACT_IMP_CLOSED; CLOSURE_CLOSED] THEN
2008   MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
2009    [MATCH_MP_TAC SUBSET_TRANS THEN
2010     EXISTS_TAC `convex hull {x:real^N | x extreme_point_of s}` THEN
2011     CONJ_TAC THENL
2012      [ASM_SIMP_TAC[GSYM KREIN_MILMAN_MINKOWSKI; SUBSET_REFL];
2013       MATCH_MP_TAC HULL_MONO THEN SIMP_TAC[SUBSET; IN_ELIM_THM; IN_DIFF] THEN
2014       ASM_MESON_TAC[EXTREME_POINT_NOT_IN_INTERIOR; extreme_point_of]];
2015     MATCH_MP_TAC SUBSET_TRANS THEN
2016     EXISTS_TAC `convex hull s:real^N->bool` THEN CONJ_TAC THENL
2017      [MATCH_MP_TAC HULL_MONO THEN SET_TAC[];
2018       ASM_SIMP_TAC[HULL_P; SUBSET_REFL]]]);;
2019
2020 let EXTREME_POINT_OF_CONVEX_HULL_INSERT_EQ = prove
2021  (`!s a x:real^N.
2022         FINITE s /\ ~(a IN affine hull s)
2023         ==> (x extreme_point_of (convex hull (a INSERT s)) <=>
2024              x = a \/ x extreme_point_of (convex hull s))`,
2025   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM AFFINE_HULL_CONVEX_HULL] THEN
2026   STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN
2027   ONCE_REWRITE_TAC[HULL_UNION_RIGHT] THEN
2028   MP_TAC(ISPEC `convex hull s:real^N->bool` KREIN_MILMAN_MINKOWSKI) THEN
2029   ANTS_TAC THENL
2030    [ASM_SIMP_TAC[CONVEX_CONVEX_HULL; COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT];
2031     ALL_TAC] THEN
2032   FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN
2033   DISCH_THEN(MP_TAC o SPEC
2034    `{x:real^N | x extreme_point_of convex hull s}`) THEN
2035   REWRITE_TAC[EXTREME_POINTS_OF_CONVEX_HULL] THEN
2036   ABBREV_TAC `v = {x:real^N | x extreme_point_of (convex hull s)}` THEN
2037   DISCH_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN
2038   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (RAND_CONV o RAND_CONV)
2039    [AFFINE_HULL_CONVEX_HULL]) THEN
2040   ASM_CASES_TAC `(a:real^N) IN v` THEN ASM_SIMP_TAC[HULL_INC] THEN
2041   STRIP_TAC THEN REWRITE_TAC[GSYM HULL_UNION_RIGHT] THEN
2042   REWRITE_TAC[SET_RULE `{a} UNION s = a INSERT s`] THEN EQ_TAC THENL
2043    [DISCH_THEN(MP_TAC o MATCH_MP EXTREME_POINT_OF_CONVEX_HULL) THEN
2044     ASM SET_TAC[];
2045     STRIP_TAC THENL
2046      [ASM_REWRITE_TAC[] THEN
2047       MATCH_MP_TAC EXTREME_POINT_OF_CONVEX_HULL_INSERT THEN
2048       ASM_MESON_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL; SUBSET];
2049       REWRITE_TAC[GSYM FACE_OF_SING] THEN
2050       MATCH_MP_TAC FACE_OF_TRANS THEN
2051       EXISTS_TAC `convex hull v:real^N->bool` THEN
2052       ASM_REWRITE_TAC[FACE_OF_SING] THEN
2053       MATCH_MP_TAC FACE_OF_CONVEX_HULLS THEN
2054       ASM_SIMP_TAC[FINITE_INSERT; AFFINE_HULL_SING; CONVEX_HULL_SING;
2055                SET_RULE `~(a IN s) ==> a INSERT s DIFF s = {a}`] THEN
2056       ASM SET_TAC[]]]);;
2057
2058 let FACE_OF_CONVEX_HULL_INSERT_EQ = prove
2059  (`!f s a:real^N.
2060         FINITE s /\ ~(a IN affine hull s)
2061         ==> (f face_of (convex hull (a INSERT s)) <=>
2062              f face_of (convex hull s) \/
2063              ?f'. f' face_of (convex hull s) /\
2064                   f = convex hull (a INSERT f'))`,
2065   let lemma = prove
2066    (`!a b c p:real^N u v w x.
2067           x % p = u % a + v % b + w % c
2068           ==> !s. u + v + w = x /\ ~(x = &0) /\ affine s /\
2069                   a IN s /\ b IN s /\ c IN s
2070                   ==> p IN s`,
2071     REPEAT STRIP_TAC THEN
2072     FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv x):real^N->real^N`) THEN
2073     ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID] THEN
2074     DISCH_THEN SUBST1_TAC THEN
2075     REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN
2076     MATCH_MP_TAC(SET_RULE `!t. x IN t /\ t SUBSET s ==> x IN s`) THEN
2077     EXISTS_TAC `affine hull {a:real^N,b,c}` THEN
2078     ASM_SIMP_TAC[HULL_MINIMAL; INSERT_SUBSET; EMPTY_SUBSET] THEN
2079     REWRITE_TAC[AFFINE_HULL_3; IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC
2080      [`inv x * u:real`; `inv x * v:real`; `inv x * w:real`] THEN
2081     REWRITE_TAC[] THEN UNDISCH_TAC `u + v + w:real = x` THEN
2082     UNDISCH_TAC `~(x = &0)` THEN CONV_TAC REAL_FIELD) in
2083   REPEAT STRIP_TAC THEN EQ_TAC THENL
2084    [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
2085       FACE_OF_CONVEX_HULL_SUBSET)) THEN
2086     ASM_SIMP_TAC[COMPACT_INSERT; FINITE_IMP_COMPACT] THEN
2087     DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
2088     FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_CASES_TAC `(a:real^N) IN t` THENL
2089      [ALL_TAC;
2090       DISJ1_TAC THEN MATCH_MP_TAC FACE_OF_SUBSET THEN
2091       EXISTS_TAC `convex hull ((a:real^N) INSERT s)` THEN
2092       ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC HULL_MONO THEN
2093       ASM SET_TAC[]] THEN
2094     DISJ2_TAC THEN
2095     EXISTS_TAC `(convex hull t) INTER (convex hull s):real^N->bool` THEN
2096     CONJ_TAC THENL
2097      [MATCH_MP_TAC FACE_OF_SUBSET THEN
2098       EXISTS_TAC `convex hull ((a:real^N) INSERT s)` THEN
2099       SIMP_TAC[INTER_SUBSET; HULL_MONO; SET_RULE `s SUBSET (a INSERT s)`] THEN
2100       MATCH_MP_TAC FACE_OF_INTER THEN ASM_REWRITE_TAC[] THEN
2101       MATCH_MP_TAC FACE_OF_CONVEX_HULL_INSERT THEN
2102       ASM_REWRITE_TAC[FACE_OF_REFL_EQ; CONVEX_CONVEX_HULL];
2103       MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN
2104       MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
2105       ASM_SIMP_TAC[INSERT_SUBSET; HULL_INC; INTER_SUBSET] THEN
2106       REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_INC THEN
2107       ASM_CASES_TAC `x:real^N = a` THEN ASM_REWRITE_TAC[IN_INSERT] THEN
2108       REWRITE_TAC[IN_INTER] THEN CONJ_TAC THEN MATCH_MP_TAC HULL_INC THEN
2109       ASM SET_TAC[]];
2110     ALL_TAC] THEN
2111   DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL
2112    [MATCH_MP_TAC FACE_OF_CONVEX_HULL_INSERT THEN ASM_REWRITE_TAC[];
2113     FIRST_X_ASSUM(X_CHOOSE_THEN `f':real^N->bool` MP_TAC)] THEN
2114   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC SUBST1_TAC) THEN
2115   SPEC_TAC(`f':real^N->bool`,`f:real^N->bool`) THEN REPEAT STRIP_TAC THEN
2116   ASM_CASES_TAC `s:real^N->bool = {}` THENL
2117    [UNDISCH_TAC `(f:real^N->bool) face_of convex hull s` THEN
2118     ASM_SIMP_TAC[FACE_OF_EMPTY; CONVEX_HULL_EMPTY; FACE_OF_REFL_EQ] THEN
2119     REWRITE_TAC[CONVEX_CONVEX_HULL];
2120     ALL_TAC] THEN
2121   ASM_CASES_TAC `f:real^N->bool = {}` THENL
2122    [ASM_REWRITE_TAC[CONVEX_HULL_SING; FACE_OF_SING] THEN
2123     MATCH_MP_TAC EXTREME_POINT_OF_CONVEX_HULL_INSERT THEN
2124     ASM_REWRITE_TAC[] THEN
2125     ASM_MESON_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL; SUBSET];
2126     ALL_TAC] THEN
2127   REWRITE_TAC[face_of; CONVEX_CONVEX_HULL] THEN CONJ_TAC THENL
2128    [MATCH_MP_TAC HULL_MINIMAL THEN
2129     SIMP_TAC[INSERT_SUBSET; HULL_INC; IN_INSERT; CONVEX_CONVEX_HULL] THEN
2130     MATCH_MP_TAC SUBSET_TRANS THEN
2131     EXISTS_TAC `convex hull s:real^N->bool` THEN
2132     ASM_SIMP_TAC[HULL_MONO; SET_RULE `s SUBSET (a INSERT s)`] THEN
2133     ASM_MESON_TAC[FACE_OF_IMP_SUBSET];
2134     ALL_TAC] THEN
2135   ASM_REWRITE_TAC[CONVEX_HULL_INSERT_ALT] THEN
2136   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN
2137   REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
2138   X_GEN_TAC `ub:real` THEN STRIP_TAC THEN
2139   X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN
2140   X_GEN_TAC `uc:real` THEN STRIP_TAC THEN
2141   X_GEN_TAC `c:real^N` THEN STRIP_TAC THEN
2142   X_GEN_TAC `ux:real` THEN STRIP_TAC THEN
2143   X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
2144   FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [face_of]) THEN
2145   SUBGOAL_THEN `convex hull f:real^N->bool = f` SUBST_ALL_TAC THENL
2146    [ASM_MESON_TAC[CONVEX_HULL_EQ]; ALL_TAC] THEN
2147   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN
2148   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `v:real` MP_TAC)) THEN
2149   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
2150   REWRITE_TAC[VECTOR_ARITH
2151    `(&1 - ux) % a + ux % x:real^N =
2152     (&1 - v) % ((&1 - ub) % a + ub % b) + v % ((&1 - uc) % a + uc % c) <=>
2153     ((&1 - ux) - ((&1 - v) * (&1 - ub) + v * (&1 - uc))) % a +
2154     (ux % x - (((&1 - v) * ub) % b + (v * uc) % c)) = vec 0`] THEN
2155   ASM_CASES_TAC `&1 - ux - ((&1 - v) * (&1 - ub) + v * (&1 - uc)) = &0` THENL
2156    [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN
2157     FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_RING
2158      `(&1 - ux) - ((&1 - v) * (&1 - ub) + v * (&1 - uc)) = &0
2159       ==> (&1 - v) * ub + v * uc = ux`)) THEN
2160     ASM_CASES_TAC `uc = &0` THENL
2161      [UNDISCH_THEN `uc = &0` SUBST_ALL_TAC THEN
2162       FIRST_X_ASSUM(SUBST_ALL_TAC o MATCH_MP (REAL_ARITH
2163        `a + v * &0 = b ==> b = a`)) THEN
2164       REWRITE_TAC[REAL_MUL_RZERO; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN
2165       REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_MUL_LCANCEL; REAL_ENTIRE] THEN
2166       STRIP_TAC THENL
2167        [ASM_REAL_ARITH_TAC;
2168         ASM_MESON_TAC[VECTOR_MUL_LZERO];
2169         ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
2170         REWRITE_TAC[IN_ELIM_THM] THEN
2171         MAP_EVERY EXISTS_TAC [`&0`; `x:real^N`] THEN
2172         ASM_REWRITE_TAC[] THEN CONV_TAC VECTOR_ARITH];
2173       ALL_TAC] THEN
2174     ASM_CASES_TAC `ub = &0` THENL
2175      [UNDISCH_THEN `ub = &0` SUBST_ALL_TAC THEN
2176       FIRST_X_ASSUM(SUBST_ALL_TAC o MATCH_MP (REAL_ARITH
2177        `v * &0 + a = b ==> b = a`)) THEN
2178       REWRITE_TAC[REAL_MUL_RZERO; VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN
2179       REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_MUL_LCANCEL; REAL_ENTIRE] THEN
2180       STRIP_TAC THENL
2181        [ASM_REAL_ARITH_TAC;
2182         ASM_MESON_TAC[VECTOR_MUL_LZERO];
2183         ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
2184         REWRITE_TAC[IN_ELIM_THM] THEN
2185         MAP_EVERY EXISTS_TAC [`&0`; `x:real^N`] THEN
2186         ASM_REWRITE_TAC[] THEN CONV_TAC VECTOR_ARITH];
2187       ALL_TAC] THEN
2188     DISCH_THEN(fun th ->
2189       SUBGOAL_THEN
2190        `(b:real^N) IN f /\ (c:real^N) IN f`
2191       MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MP_TAC th) THEN
2192     ASM_CASES_TAC `ux = &0` THENL
2193      [DISCH_THEN(K ALL_TAC) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
2194       EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN
2195       FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH
2196        `&1 - ux - a = &0 ==> ux = &0 ==> ~(a < &1)`)) THEN
2197       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN
2198       MATCH_MP_TAC REAL_LTE_TRANS THEN
2199       EXISTS_TAC `(&1 - v) * &1 + v * &1` THEN
2200       CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN
2201       MATCH_MP_TAC(REAL_ARITH
2202        `x <= y /\ w <= z /\ ~(x = y /\ w = z) ==> x + w < y + z`) THEN
2203       ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_SUB_LT; REAL_EQ_MUL_LCANCEL] THEN
2204       REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
2205       ASM_SIMP_TAC[REAL_SUB_0; REAL_LT_IMP_NE] THEN
2206       REWRITE_TAC[REAL_ARITH `&1 - x = &1 <=> x = &0`] THEN
2207       DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC) THEN
2208       ASM_MESON_TAC[VECTOR_MUL_LZERO];
2209       ALL_TAC] THEN
2210     REWRITE_TAC[VECTOR_SUB_EQ] THEN ASM_CASES_TAC `c:real^N = b` THENL
2211      [ASM_REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; VECTOR_MUL_LCANCEL] THEN
2212       ASM_MESON_TAC[];
2213       ALL_TAC] THEN
2214     DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
2215     EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_SEGMENT] THEN
2216     EXISTS_TAC `(v * uc) / ux:real` THEN
2217     ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_ARITH
2218      `&0 <= x /\ ~(x = &0) ==> &0 < x`] THEN
2219     REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN REPEAT CONJ_TAC THENL
2220      [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC;
2221       EXPAND_TAC "ux" THEN REWRITE_TAC[REAL_ARITH `b < a + b <=> &0 < a`] THEN
2222       MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC;
2223       FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv ux) :real^N->real^N`) THEN
2224       ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV] THEN
2225       REWRITE_TAC[VECTOR_MUL_LID] THEN DISCH_THEN SUBST1_TAC THEN
2226       REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN
2227       BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
2228       REWRITE_TAC[REAL_ARITH `inv u * v * uc:real = (v * uc) / u`] THEN
2229       UNDISCH_TAC `(&1 - v) * ub + v * uc = ux` THEN
2230       UNDISCH_TAC `~(ux = &0)` THEN CONV_TAC REAL_FIELD];
2231     DISCH_THEN(MP_TAC o MATCH_MP (VECTOR_ARITH
2232      `a + (b - c):real^N = vec 0 ==> a = c + --b`)) THEN
2233     REWRITE_TAC[GSYM VECTOR_ADD_ASSOC; GSYM VECTOR_MUL_LNEG] THEN
2234     DISCH_THEN(MP_TAC o SPEC `affine hull s:real^N->bool` o
2235       MATCH_MP lemma) THEN
2236     ASM_REWRITE_TAC[AFFINE_AFFINE_HULL] THEN
2237     MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN
2238     CONJ_TAC THENL [CONV_TAC REAL_RING; REPEAT CONJ_TAC] THEN
2239     MATCH_MP_TAC(REWRITE_RULE[SUBSET] CONVEX_HULL_SUBSET_AFFINE_HULL) THEN
2240     ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);;
2241
2242 (* ------------------------------------------------------------------------- *)
2243 (* Polytopes.                                                                *)
2244 (* ------------------------------------------------------------------------- *)
2245
2246 let polytope = new_definition
2247  `polytope s <=> ?v. FINITE v /\ s = convex hull v`;;
2248
2249 let POLYTOPE_TRANSLATION_EQ = prove
2250  (`!a s. polytope (IMAGE (\x:real^N. a + x) s) <=> polytope s`,
2251   REWRITE_TAC[polytope] THEN GEOM_TRANSLATE_TAC[]);;
2252
2253 add_translation_invariants [POLYTOPE_TRANSLATION_EQ];;
2254
2255 let POLYTOPE_LINEAR_IMAGE = prove
2256  (`!f:real^M->real^N p.
2257         linear f /\ polytope p ==> polytope(IMAGE f p)`,
2258   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2259   REWRITE_TAC[polytope] THEN
2260   DISCH_THEN(X_CHOOSE_THEN `s:real^M->bool` STRIP_ASSUME_TAC) THEN
2261   EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN
2262   ASM_SIMP_TAC[CONVEX_HULL_LINEAR_IMAGE; FINITE_IMAGE]);;
2263
2264 let POLYTOPE_LINEAR_IMAGE_EQ = prove
2265  (`!f:real^M->real^N s.
2266         linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
2267         ==> (polytope (IMAGE f s) <=> polytope s)`,
2268   REPEAT STRIP_TAC THEN REWRITE_TAC[polytope] THEN
2269   MP_TAC(ISPEC `f:real^M->real^N` QUANTIFY_SURJECTION_THM) THEN
2270   ASM_REWRITE_TAC[] THEN
2271   DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)[th]) THEN
2272   MP_TAC(end_itlist CONJ
2273    (mapfilter (ISPEC `f:real^M->real^N`) (!invariant_under_linear))) THEN
2274   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);;
2275
2276 let POLYTOPE_EMPTY = prove
2277  (`polytope {}`,
2278   REWRITE_TAC[polytope] THEN MESON_TAC[FINITE_EMPTY; CONVEX_HULL_EMPTY]);;
2279
2280 let POLYTOPE_NEGATIONS = prove
2281  (`!s:real^N->bool. polytope s ==> polytope(IMAGE (--) s)`,
2282   SIMP_TAC[POLYTOPE_LINEAR_IMAGE; LINEAR_NEGATION]);;
2283
2284 let POLYTOPE_CONVEX_HULL = prove
2285  (`!s. FINITE s ==> polytope(convex hull s)`,
2286   REWRITE_TAC[polytope] THEN MESON_TAC[]);;
2287
2288 let POLYTOPE_PCROSS = prove
2289  (`!s:real^M->bool t:real^N->bool.
2290         polytope s /\ polytope t ==> polytope(s PCROSS t)`,
2291   REPEAT GEN_TAC THEN REWRITE_TAC[polytope] THEN
2292   MESON_TAC[CONVEX_HULL_PCROSS; FINITE_PCROSS]);;
2293
2294 let POLYTOPE_PCROSS_EQ = prove
2295  (`!s:real^M->bool t:real^N->bool.
2296         polytope(s PCROSS t) <=>
2297         s = {} \/ t = {} \/ polytope s /\ polytope t`,
2298   REPEAT GEN_TAC THEN
2299   ASM_CASES_TAC `s:real^M->bool = {}` THEN
2300   ASM_REWRITE_TAC[PCROSS_EMPTY; POLYTOPE_EMPTY] THEN
2301   ASM_CASES_TAC `t:real^N->bool = {}` THEN
2302   ASM_REWRITE_TAC[PCROSS_EMPTY; POLYTOPE_EMPTY] THEN
2303   EQ_TAC THEN REWRITE_TAC[POLYTOPE_PCROSS] THEN REPEAT STRIP_TAC THENL
2304    [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`;
2305                     `(s:real^M->bool) PCROSS (t:real^N->bool)`]
2306        POLYTOPE_LINEAR_IMAGE) THEN
2307     ASM_REWRITE_TAC[LINEAR_FSTCART];
2308     MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`;
2309                    `(s:real^M->bool) PCROSS (t:real^N->bool)`]
2310        POLYTOPE_LINEAR_IMAGE) THEN
2311     ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN
2312   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
2313   REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS;
2314               FSTCART_PASTECART; SNDCART_PASTECART] THEN
2315   ASM SET_TAC[]);;
2316
2317 let FACE_OF_POLYTOPE_POLYTOPE = prove
2318  (`!f s:real^N->bool. polytope s /\ f face_of s ==> polytope f`,
2319   REWRITE_TAC[polytope] THEN
2320   MESON_TAC[FINITE_SUBSET; FACE_OF_CONVEX_HULL_SUBSET; FINITE_IMP_COMPACT]);;
2321
2322 let FINITE_POLYTOPE_FACES = prove
2323  (`!s:real^N->bool. polytope s ==> FINITE {f | f face_of s}`,
2324   GEN_TAC THEN REWRITE_TAC[polytope; LEFT_IMP_EXISTS_THM] THEN
2325   X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2326   MATCH_MP_TAC FINITE_SUBSET THEN
2327   EXISTS_TAC `IMAGE ((hull) convex) {t:real^N->bool | t SUBSET v}` THEN
2328   ASM_SIMP_TAC[FINITE_POWERSET; FINITE_IMAGE] THEN
2329   GEN_REWRITE_TAC I [SUBSET] THEN
2330   REWRITE_TAC[FORALL_IN_GSPEC; IN_IMAGE; IN_ELIM_THM] THEN
2331   ASM_MESON_TAC[FACE_OF_CONVEX_HULL_SUBSET; FINITE_IMP_COMPACT]);;
2332
2333 let FINITE_POLYTOPE_FACETS = prove
2334  (`!s:real^N->bool. polytope s ==> FINITE {f | f facet_of s}`,
2335   REWRITE_TAC[facet_of] THEN ONCE_REWRITE_TAC[SET_RULE
2336    `{x | P x /\ Q x} = {x | x IN {x | P x} /\ Q x}`] THEN
2337   SIMP_TAC[FINITE_RESTRICT; FINITE_POLYTOPE_FACES]);;
2338
2339 let POLYTOPE_SCALING = prove
2340  (`!c s:real^N->bool. polytope s ==> polytope (IMAGE (\x. c % x) s)`,
2341   REPEAT GEN_TAC THEN REWRITE_TAC[polytope] THEN DISCH_THEN
2342    (X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
2343   EXISTS_TAC `IMAGE (\x:real^N. c % x) u` THEN
2344   ASM_SIMP_TAC[CONVEX_HULL_SCALING; FINITE_IMAGE]);;
2345
2346 let POLYTOPE_SCALING_EQ = prove
2347  (`!c s:real^N->bool.
2348      ~(c = &0) ==> (polytope (IMAGE (\x. c % x) s) <=> polytope s)`,
2349   REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[POLYTOPE_SCALING] THEN
2350   DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP POLYTOPE_SCALING) THEN
2351   ASM_SIMP_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC;
2352                REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]);;
2353
2354 let POLYTOPE_SUMS = prove
2355  (`!s t:real^N->bool.
2356         polytope s /\ polytope t ==> polytope {x + y | x IN s /\ y IN t}`,
2357   REPEAT GEN_TAC THEN REWRITE_TAC[polytope] THEN DISCH_THEN(CONJUNCTS_THEN2
2358    (X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC)
2359    (X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC)) THEN
2360   EXISTS_TAC `{x + y:real^N | x IN u /\ y IN v}` THEN
2361   ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT; CONVEX_HULL_SUMS]);;
2362
2363 let POLYTOPE_IMP_COMPACT = prove
2364  (`!s. polytope s ==> compact s`,
2365   SIMP_TAC[polytope; LEFT_IMP_EXISTS_THM; COMPACT_CONVEX_HULL;
2366            FINITE_IMP_COMPACT; FINITE_INSERT; FINITE_EMPTY]);;
2367
2368 let POLYTOPE_IMP_CONVEX = prove
2369  (`!s. polytope s ==> convex s`,
2370   SIMP_TAC[polytope; LEFT_IMP_EXISTS_THM; CONVEX_CONVEX_HULL]);;
2371
2372 let POLYTOPE_IMP_CLOSED = prove
2373  (`!s. polytope s ==> closed s`,
2374   SIMP_TAC[POLYTOPE_IMP_COMPACT; COMPACT_IMP_CLOSED]);;
2375
2376 let POLYTOPE_IMP_BOUNDED = prove
2377  (`!s. polytope s ==> bounded s`,
2378   SIMP_TAC[POLYTOPE_IMP_COMPACT; COMPACT_IMP_BOUNDED]);;
2379
2380 let POLYTOPE_INTERVAL = prove
2381  (`!a b. polytope(interval[a,b])`,
2382   REWRITE_TAC[polytope] THEN MESON_TAC[CLOSED_INTERVAL_AS_CONVEX_HULL]);;
2383
2384 let POLYTOPE_SING = prove
2385  (`!a. polytope {a}`,
2386   MESON_TAC[POLYTOPE_INTERVAL; INTERVAL_SING]);;
2387
2388 (* ------------------------------------------------------------------------- *)
2389 (* Approximation of bounded convex sets by polytopes.                        *)
2390 (* ------------------------------------------------------------------------- *)
2391
2392 let CONVEX_INNER_APPROXIMATION = prove
2393  (`!s:real^N->bool e.
2394         bounded s /\ convex s /\ &0 < e
2395         ==> ?k. FINITE k /\ convex hull k SUBSET s /\
2396                 hausdist(convex hull k,s) < e /\
2397                 (k = {} ==> s = {})`,
2398   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
2399    [EXISTS_TAC `{}:real^N->bool` THEN
2400     ASM_SIMP_TAC[FINITE_EMPTY; CONVEX_HULL_EMPTY; HAUSDIST_REFL; SUBSET_REFL];
2401     ALL_TAC] THEN
2402   MP_TAC(ISPEC `closure s:real^N->bool` COMPACT_EQ_HEINE_BOREL) THEN
2403   ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN
2404   DISCH_THEN(MP_TAC o SPEC `{ball(x:real^N,e / &2) | x IN s}`) THEN
2405   REWRITE_TAC[FORALL_IN_GSPEC; OPEN_BALL] THEN ANTS_TAC THENL
2406    [REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM; CLOSURE_APPROACHABLE] THEN
2407     X_GEN_TAC `x:real^N` THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
2408     ASM_REWRITE_TAC[IN_BALL; REAL_HALF];
2409     ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
2410     REWRITE_TAC[SIMPLE_IMAGE; EXISTS_FINITE_SUBSET_IMAGE]] THEN
2411   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^N->bool` THEN
2412   ASM_CASES_TAC `k:real^N->bool = {}` THEN
2413   ASM_REWRITE_TAC[IMAGE_CLAUSES; UNIONS_0; SUBSET_EMPTY; CLOSURE_EQ_EMPTY] THEN
2414   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2415   MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
2416    [ASM_SIMP_TAC[HULL_MINIMAL]; DISCH_TAC] THEN
2417   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
2418    `&0 < e ==> x <= e / &2 ==> x < e`)) THEN
2419   MATCH_MP_TAC REAL_HAUSDIST_LE THEN
2420   ASM_REWRITE_TAC[CONVEX_HULL_EQ_EMPTY] THEN CONJ_TAC THENL
2421    [RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN
2422     ASM_SIMP_TAC[SETDIST_SING_IN_SET] THEN ASM_REAL_ARITH_TAC;
2423     ALL_TAC] THEN
2424   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN UNDISCH_TAC
2425    `closure s SUBSET UNIONS (IMAGE (\x:real^N. ball (x,e / &2)) k)` THEN
2426   REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
2427   ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN
2428   REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_BALL] THEN
2429   ONCE_REWRITE_TAC[DIST_SYM] THEN
2430   DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
2431   TRANS_TAC REAL_LE_TRANS `dist(x:real^N,y)` THEN
2432   ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN
2433   ASM_SIMP_TAC[IN_SING; HULL_INC]);;
2434
2435 let CONVEX_OUTER_APPROXIMATION = prove
2436  (`!s:real^N->bool e.
2437         bounded s /\ convex s /\ &0 < e
2438         ==> ?k. FINITE k /\ s SUBSET convex hull k /\
2439                 hausdist(convex hull k,s) < e`,
2440   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
2441    [EXISTS_TAC `{}:real^N->bool` THEN
2442     ASM_REWRITE_TAC[FINITE_EMPTY; EMPTY_SUBSET; HAUSDIST_EMPTY;
2443                     CONVEX_HULL_EMPTY];
2444     ALL_TAC] THEN
2445   MP_TAC(ISPECL [`{x + y:real^N | x IN s /\ y IN ball(vec 0,e / &2)}`;
2446                  `e / &2`] CONVEX_INNER_APPROXIMATION) THEN
2447   ASM_SIMP_TAC[CONVEX_SUMS; CONVEX_BALL; BOUNDED_SUMS; BOUNDED_BALL] THEN
2448   ASM_REWRITE_TAC[REAL_HALF; BALL_EQ_EMPTY; GSYM REAL_NOT_LT; SET_RULE
2449    `{f x y | x IN s /\ y IN t} = {} <=> s = {} \/ t = {}`] THEN
2450   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^N->bool` THEN
2451   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2452   FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[REAL_NOT_LE]
2453    (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] REAL_LE_HAUSDIST))) THEN
2454   REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`; RIGHT_FORALL_IMP_THM] THEN
2455   ASM_REWRITE_TAC[CONVEX_HULL_EQ_EMPTY; LEFT_FORALL_IMP_THM] THEN
2456   ASM_REWRITE_TAC[REAL_HALF; BALL_EQ_EMPTY; GSYM REAL_NOT_LT; SET_RULE
2457    `{f x y | x IN s /\ y IN t} = {} <=> s = {} \/ t = {}`] THEN
2458   REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LT; FORALL_AND_THM] THEN ANTS_TAC THENL
2459    [EXISTS_TAC `hausdist(convex hull k,
2460                       {x + y:real^N | x IN s /\ y IN ball(vec 0,e / &2)})` THEN
2461     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
2462     MATCH_MP_TAC SETDIST_SING_LE_HAUSDIST THEN
2463     ASM_SIMP_TAC[BOUNDED_CONVEX_HULL; FINITE_IMP_BOUNDED] THEN
2464     ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_BALL];
2465     ALL_TAC] THEN
2466   ANTS_TAC THENL
2467    [EXISTS_TAC `hausdist(convex hull k,
2468                       {x + y:real^N | x IN s /\ y IN ball(vec 0,e / &2)})` THEN
2469     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
2470     ONCE_REWRITE_TAC[HAUSDIST_SYM] THEN
2471     MATCH_MP_TAC SETDIST_SING_LE_HAUSDIST THEN
2472     ASM_SIMP_TAC[BOUNDED_CONVEX_HULL; FINITE_IMP_BOUNDED] THEN
2473     ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_BALL];
2474     REWRITE_TAC[TAUT `~p \/ q <=> p ==> q`] THEN DISCH_TAC] THEN
2475   CONJ_TAC THENL
2476    [MATCH_MP_TAC SUBSET_SUMS_RCANCEL THEN
2477     EXISTS_TAC `ball(vec 0:real^N,e / &2)` THEN
2478     ASM_SIMP_TAC[COMPACT_IMP_CLOSED; COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT;
2479       CONVEX_CONVEX_HULL; BALL_EQ_EMPTY; BOUNDED_BALL; REAL_NOT_LE] THEN
2480     ASM_REWRITE_TAC[REAL_HALF; SUBSET] THEN X_GEN_TAC `z:real^N` THEN
2481     DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N` o CONJUNCT2) THEN
2482     ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP
2483      (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC]
2484         REAL_SETDIST_LT_EXISTS))) THEN
2485     ASM_REWRITE_TAC[NOT_INSERT_EMPTY; CONVEX_HULL_EQ_EMPTY; IN_SING] THEN
2486     REWRITE_TAC[IN_BALL_0; IN_ELIM_THM; GSYM CONJ_ASSOC] THEN
2487     REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN
2488     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
2489     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `z - y:real^N` THEN
2490     ASM_REWRITE_TAC[GSYM dist] THEN CONV_TAC VECTOR_ARITH;
2491     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
2492      `&0 < e ==> x <= e / &2 ==> x < e`)) THEN
2493     MATCH_MP_TAC REAL_HAUSDIST_LE THEN
2494     ASM_REWRITE_TAC[CONVEX_HULL_EQ_EMPTY] THEN CONJ_TAC THENL
2495      [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
2496       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
2497       DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
2498       ASM_REWRITE_TAC[IN_ELIM_THM] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
2499       REWRITE_TAC[VECTOR_ARITH `x:real^N = z + y <=> x - z = y`] THEN
2500       REWRITE_TAC[UNWIND_THM1; IN_BALL_0; GSYM dist] THEN
2501       DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
2502       TRANS_TAC REAL_LE_TRANS `dist(x:real^N,y)` THEN
2503       ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN
2504       ASM_REWRITE_TAC[IN_SING];
2505       X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
2506       FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o CONJUNCT2) THEN
2507       ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[REAL_LT_IMP_LE]] THEN
2508       REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `x:real^N` THEN
2509       EXISTS_TAC `vec 0:real^N` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN
2510       ASM_REWRITE_TAC[REAL_HALF; VECTOR_ADD_RID]]]);;
2511
2512 let CONVEX_INNER_POLYTOPE = prove
2513  (`!s:real^N->bool e.
2514         bounded s /\ convex s /\ &0 < e
2515         ==> ?p. polytope p /\ p SUBSET s /\ hausdist(p,s) < e /\
2516                 (p = {} ==> s = {})`,
2517   REPEAT GEN_TAC THEN DISCH_TAC THEN
2518   FIRST_ASSUM(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC o
2519         MATCH_MP CONVEX_INNER_APPROXIMATION) THEN
2520   EXISTS_TAC `convex hull k:real^N->bool` THEN
2521   ASM_SIMP_TAC[CONVEX_HULL_EQ_EMPTY; POLYTOPE_CONVEX_HULL]);;
2522
2523 let CONVEX_OUTER_POLYTOPE = prove
2524  (`!s:real^N->bool e.
2525         bounded s /\ convex s /\ &0 < e
2526         ==> ?p. polytope p /\ s SUBSET p /\ hausdist(p,s) < e`,
2527   REPEAT GEN_TAC THEN DISCH_TAC THEN
2528   FIRST_ASSUM(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC o
2529         MATCH_MP CONVEX_OUTER_APPROXIMATION) THEN
2530   EXISTS_TAC `convex hull k:real^N->bool` THEN
2531   ASM_SIMP_TAC[CONVEX_HULL_EQ_EMPTY; POLYTOPE_CONVEX_HULL]);;
2532
2533 (* ------------------------------------------------------------------------- *)
2534 (* Polyhedra.                                                                *)
2535 (* ------------------------------------------------------------------------- *)
2536
2537 let polyhedron = new_definition
2538  `polyhedron s <=>
2539         ?f. FINITE f /\
2540             s = INTERS f /\
2541             (!h. h IN f ==> ?a b. ~(a = vec 0) /\ h = {x | a dot x <= b})`;;
2542
2543 let POLYHEDRON_INTER = prove
2544  (`!s t:real^N->bool.
2545         polyhedron s /\ polyhedron t ==> polyhedron (s INTER t)`,
2546   REPEAT GEN_TAC THEN REWRITE_TAC[polyhedron] THEN
2547   DISCH_THEN(CONJUNCTS_THEN2
2548    (X_CHOOSE_TAC `f:(real^N->bool)->bool`)
2549    (X_CHOOSE_TAC `g:(real^N->bool)->bool`)) THEN
2550   EXISTS_TAC `f UNION g:(real^N->bool)->bool` THEN
2551   ASM_REWRITE_TAC[SET_RULE `INTERS(f UNION g) = INTERS f INTER INTERS g`] THEN
2552   REWRITE_TAC[FINITE_UNION; IN_UNION] THEN
2553   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]);;
2554
2555 let POLYHEDRON_UNIV = prove
2556  (`polyhedron(:real^N)`,
2557   REWRITE_TAC[polyhedron] THEN EXISTS_TAC `{}:(real^N->bool)->bool` THEN
2558   REWRITE_TAC[INTERS_0; NOT_IN_EMPTY; FINITE_RULES]);;
2559
2560 let POLYHEDRON_POSITIVE_ORTHANT = prove
2561  (`polyhedron {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i}`,
2562   REWRITE_TAC[polyhedron] THEN
2563   EXISTS_TAC `IMAGE (\i. {x:real^N | &0 <= x$i}) (1..dimindex(:N))` THEN
2564   SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE] THEN CONJ_TAC THENL
2565    [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[INTERS_IMAGE] THEN
2566     REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG];
2567     X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN
2568     MAP_EVERY EXISTS_TAC [`--basis k:real^N`; `&0`] THEN
2569     ASM_SIMP_TAC[VECTOR_NEG_EQ_0; DOT_LNEG; DOT_BASIS; BASIS_NONZERO] THEN
2570     REWRITE_TAC[REAL_ARITH `--x <= &0 <=> &0 <= x`]]);;
2571
2572 let POLYHEDRON_INTERS = prove
2573  (`!f:(real^N->bool)->bool.
2574         FINITE f /\ (!s. s IN f ==> polyhedron s) ==> polyhedron(INTERS f)`,
2575   REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
2576   REWRITE_TAC[NOT_IN_EMPTY; INTERS_0; POLYHEDRON_UNIV] THEN
2577   ASM_SIMP_TAC[INTERS_INSERT; FORALL_IN_INSERT; POLYHEDRON_INTER]);;
2578
2579 let POLYHEDRON_EMPTY = prove
2580  (`polyhedron({}:real^N->bool)`,
2581   REWRITE_TAC[polyhedron] THEN
2582   EXISTS_TAC `{{x:real^N | basis 1 dot x <= -- &1},
2583                {x | --(basis 1) dot x <= -- &1}}` THEN
2584   REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; INTERS_2; FORALL_IN_INSERT] THEN
2585   REWRITE_TAC[NOT_IN_EMPTY; INTER; IN_ELIM_THM; DOT_LNEG] THEN
2586   REWRITE_TAC[REAL_ARITH `~(a <= -- &1 /\ --a <= -- &1)`; EMPTY_GSPEC] THEN
2587   CONJ_TAC THENL
2588    [MAP_EVERY EXISTS_TAC [`basis 1:real^N`; `-- &1`];
2589     MAP_EVERY EXISTS_TAC [`--(basis 1):real^N`; `-- &1`]] THEN
2590   SIMP_TAC[VECTOR_NEG_EQ_0; BASIS_NONZERO; DOT_LNEG;
2591            DIMINDEX_GE_1; LE_REFL]);;
2592
2593 let POLYHEDRON_HALFSPACE_LE = prove
2594  (`!a b. polyhedron {x:real^N | a dot x <= b}`,
2595   REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL
2596    [ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | p} = if p then UNIV else {}`] THEN
2597     COND_CASES_TAC THEN ASM_REWRITE_TAC[POLYHEDRON_EMPTY; POLYHEDRON_UNIV];
2598     REWRITE_TAC[polyhedron] THEN EXISTS_TAC `{{x:real^N | a dot x <= b}}` THEN
2599     REWRITE_TAC[FINITE_SING; INTERS_1; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN
2600     MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real`] THEN ASM_REWRITE_TAC[]]);;
2601
2602 let POLYHEDRON_HALFSPACE_GE = prove
2603  (`!a b. polyhedron {x:real^N | a dot x >= b}`,
2604   REWRITE_TAC[REAL_ARITH `a:real >= b <=> --a <= --b`] THEN
2605   REWRITE_TAC[GSYM DOT_LNEG; POLYHEDRON_HALFSPACE_LE]);;
2606
2607 let POLYHEDRON_HYPERPLANE = prove
2608  (`!a b. polyhedron {x:real^N | a dot x = b}`,
2609   REWRITE_TAC[REAL_ARITH `x:real = b <=> x <= b /\ x >= b`] THEN
2610   REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN
2611   SIMP_TAC[POLYHEDRON_INTER; POLYHEDRON_HALFSPACE_LE;
2612            POLYHEDRON_HALFSPACE_GE]);;
2613
2614 let AFFINE_IMP_POLYHEDRON = prove
2615  (`!s:real^N->bool. affine s ==> polyhedron s`,
2616   REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool`
2617     AFFINE_HULL_FINITE_INTERSECTION_HYPERPLANES) THEN
2618   ASM_SIMP_TAC[HULL_P; RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN
2619   STRIP_TAC THEN ASM_SIMP_TAC[] THEN
2620   MATCH_MP_TAC POLYHEDRON_INTERS THEN ASM_REWRITE_TAC[] THEN
2621   X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN
2622   FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN
2623   ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o CONJUNCT2) THEN
2624   REWRITE_TAC[POLYHEDRON_HYPERPLANE]);;
2625
2626 let POLYHEDRON_IMP_CLOSED = prove
2627  (`!s:real^N->bool. polyhedron s ==> closed s`,
2628   REWRITE_TAC[polyhedron; RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN
2629   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2630   MATCH_MP_TAC CLOSED_INTERS THEN
2631   X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN
2632   FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN
2633   ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o CONJUNCT2) THEN
2634   REWRITE_TAC[CLOSED_HALFSPACE_LE]);;
2635
2636 let POLYHEDRON_IMP_CONVEX = prove
2637  (`!s:real^N->bool. polyhedron s ==> convex s`,
2638   REWRITE_TAC[polyhedron; RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN
2639   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2640   MATCH_MP_TAC CONVEX_INTERS THEN
2641   X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN
2642   FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN
2643   ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o CONJUNCT2) THEN
2644   REWRITE_TAC[CONVEX_HALFSPACE_LE]);;
2645
2646 let POLYHEDRON_AFFINE_HULL = prove
2647  (`!s. polyhedron(affine hull s)`,
2648   SIMP_TAC[AFFINE_IMP_POLYHEDRON; AFFINE_AFFINE_HULL]);;
2649
2650 (* ------------------------------------------------------------------------- *)
2651 (* Canonical polyedron representation making facial structure explicit.      *)
2652 (* ------------------------------------------------------------------------- *)
2653
2654 let POLYHEDRON_INTER_AFFINE = prove
2655  (`!s. polyhedron s <=>
2656         ?f. FINITE f /\
2657             s = (affine hull s) INTER (INTERS f) /\
2658             (!h. h IN f
2659                  ==> ?a b. ~(a = vec 0) /\ h = {x:real^N | a dot x <= b})`,
2660   GEN_TAC THEN EQ_TAC THENL
2661    [REWRITE_TAC[polyhedron] THEN MATCH_MP_TAC MONO_EXISTS THEN
2662     GEN_TAC THEN STRIP_TAC THEN REPEAT CONJ_TAC THEN
2663     TRY(FIRST_ASSUM ACCEPT_TAC) THEN
2664     MATCH_MP_TAC(SET_RULE `s = t /\ s SUBSET u ==> s = u INTER t`) THEN
2665     REWRITE_TAC[HULL_SUBSET] THEN ASM_REWRITE_TAC[];
2666     STRIP_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN
2667     MATCH_MP_TAC POLYHEDRON_INTER THEN REWRITE_TAC[POLYHEDRON_AFFINE_HULL] THEN
2668     MATCH_MP_TAC POLYHEDRON_INTERS THEN ASM_REWRITE_TAC[] THEN
2669     ASM_MESON_TAC[POLYHEDRON_HALFSPACE_LE]]);;
2670
2671 let POLYHEDRON_INTER_AFFINE_PARALLEL = prove
2672  (`!s:real^N->bool.
2673         polyhedron s <=>
2674         ?f. FINITE f /\
2675             s = (affine hull s) INTER (INTERS f) /\
2676             (!h. h IN f
2677                  ==> ?a b. ~(a = vec 0) /\ h = {x:real^N | a dot x <= b} /\
2678                            (!x. x IN affine hull s
2679                                 ==> (x + a) IN affine hull s))`,
2680   GEN_TAC THEN REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN EQ_TAC THENL
2681    [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]] THEN
2682   DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` MP_TAC) THEN
2683   ASM_CASES_TAC `s:real^N->bool = {}` THENL
2684    [DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `{}:(real^N->bool)->bool` THEN
2685     ASM_SIMP_TAC[AFFINE_HULL_EMPTY; INTER_EMPTY; NOT_IN_EMPTY; FINITE_EMPTY];
2686     ALL_TAC] THEN
2687   ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL
2688    [ASM_REWRITE_TAC[NOT_IN_EMPTY; INTERS_0; INTER_UNIV] THEN
2689     DISCH_THEN(ASSUME_TAC o SYM o CONJUNCT2) THEN
2690     EXISTS_TAC `{}:(real^N->bool)->bool` THEN
2691     ASM_REWRITE_TAC[NOT_IN_EMPTY; INTERS_0; INTER_UNIV; FINITE_EMPTY];
2692     ALL_TAC] THEN
2693   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o GSYM) MP_TAC)) THEN
2694   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV)
2695    [RIGHT_IMP_EXISTS_THM] THEN
2696   REWRITE_TAC[LEFT_IMP_EXISTS_THM; SKOLEM_THM] THEN
2697   MAP_EVERY X_GEN_TAC
2698    [`a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] THEN
2699   DISCH_THEN(ASSUME_TAC o GSYM) THEN
2700   SUBGOAL_THEN
2701    `!h. h IN f /\ ~(affine hull s SUBSET h)
2702         ==> ?a' b'. ~(a' = vec 0) /\
2703                   affine hull s INTER {x:real^N | a' dot x <= b'} =
2704                   affine hull s INTER h /\
2705                   !w. w IN affine hull s ==> (w + a') IN affine hull s`
2706   MP_TAC THENL
2707    [GEN_TAC THEN STRIP_TAC THEN
2708     FIRST_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN
2709     REWRITE_TAC[ASSUME `(h:real^N->bool) IN f`] THEN
2710     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC o GSYM) THEN
2711     MP_TAC(ISPECL [`affine hull s:real^N->bool`;
2712                    `(a:(real^N->bool)->real^N) h`;
2713                    `(b:(real^N->bool)->real) h`]
2714                 AFFINE_PARALLEL_SLICE) THEN
2715     REWRITE_TAC[AFFINE_AFFINE_HULL] THEN MATCH_MP_TAC(TAUT
2716      `~p /\ ~q /\ (r ==> r') ==> (p \/ q \/ r ==> r')`) THEN
2717     ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
2718     DISCH_TAC THEN
2719     UNDISCH_TAC `~(s:real^N->bool = {})` THEN
2720     EXPAND_TAC "s" THEN REWRITE_TAC[GSYM INTERS_INSERT] THEN
2721     MATCH_MP_TAC(SET_RULE
2722      `!t. t SUBSET s /\ INTERS t = {} ==> INTERS s = {}`) THEN
2723     EXISTS_TAC `{affine hull s,h:real^N->bool}` THEN
2724     ASM_REWRITE_TAC[INTERS_2] THEN ASM SET_TAC[];
2725     ALL_TAC] THEN
2726   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
2727   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
2728   FIRST_X_ASSUM(K ALL_TAC o SPEC `{}:real^N->bool`) THEN
2729   MAP_EVERY X_GEN_TAC
2730     [`a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] THEN
2731   DISCH_TAC THEN
2732   EXISTS_TAC `IMAGE (\h:real^N->bool. {x:real^N | a h dot x <= b h})
2733                     {h | h IN f /\ ~(affine hull s SUBSET h)}` THEN
2734   ASM_SIMP_TAC[FINITE_IMAGE; FINITE_RESTRICT; FORALL_IN_IMAGE] THEN
2735   REWRITE_TAC[FORALL_IN_GSPEC] THEN CONJ_TAC THENL
2736    [ALL_TAC;
2737     X_GEN_TAC `h:real^N->bool` THEN STRIP_TAC THEN
2738     MAP_EVERY EXISTS_TAC
2739      [`(a:(real^N->bool)->real^N) h`; `(b:(real^N->bool)->real) h`] THEN
2740     ASM_MESON_TAC[]] THEN
2741   FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN
2742   GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN
2743   REWRITE_TAC[INTERS_IMAGE; IN_INTER; IN_ELIM_THM] THEN
2744   ASM_CASES_TAC `(x:real^N) IN affine hull s` THEN
2745   ASM_REWRITE_TAC[IN_INTERS] THEN AP_TERM_TAC THEN ABS_TAC THEN
2746   ASM SET_TAC[]);;
2747
2748 let POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL = prove
2749  (`!s. polyhedron s <=>
2750         ?f. FINITE f /\
2751             s = (affine hull s) INTER (INTERS f) /\
2752             (!h. h IN f
2753                  ==> ?a b. ~(a = vec 0) /\ h = {x:real^N | a dot x <= b} /\
2754                            (!x. x IN affine hull s
2755                                 ==> (x + a) IN affine hull s)) /\
2756             !f'. f' PSUBSET f ==> s PSUBSET (affine hull s) INTER (INTERS f')`,
2757   GEN_TAC THEN REWRITE_TAC[POLYHEDRON_INTER_AFFINE_PARALLEL] THEN
2758   EQ_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]] THEN
2759   GEN_REWRITE_TAC LAND_CONV
2760    [MESON[HAS_SIZE]
2761      `(?f. FINITE f /\ P f) <=> (?n f. f HAS_SIZE n /\ P f)`] THEN
2762   GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN
2763   DISCH_THEN(X_CHOOSE_THEN `n:num` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN
2764   MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[HAS_SIZE] THEN
2765   X_GEN_TAC `f:(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2766   CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN
2767   X_GEN_TAC `f':(real^N->bool)->bool` THEN DISCH_TAC THEN
2768   FIRST_X_ASSUM(MP_TAC o SPEC `CARD(f':(real^N->bool)->bool)`) THEN
2769   ANTS_TAC THENL [ASM_MESON_TAC[CARD_PSUBSET]; ALL_TAC] THEN
2770   REWRITE_TAC[NOT_EXISTS_THM; HAS_SIZE] THEN
2771   DISCH_THEN(MP_TAC o SPEC `f':(real^N->bool)->bool`) THEN
2772   MATCH_MP_TAC(TAUT `a /\ c /\ (~b ==> d) ==> ~(a /\ b /\ c) ==> d`) THEN
2773   CONJ_TAC THENL [ASM_MESON_TAC[PSUBSET; FINITE_SUBSET]; ALL_TAC] THEN
2774   CONJ_TAC THENL
2775    [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[];
2776     MATCH_MP_TAC(SET_RULE `s SUBSET t ==> ~(s = t) ==> s PSUBSET t`) THEN
2777     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN
2778     ASM SET_TAC[]]);;
2779
2780 let POLYHEDRON_INTER_AFFINE_MINIMAL = prove
2781  (`!s. polyhedron s <=>
2782         ?f. FINITE f /\
2783             s = (affine hull s) INTER (INTERS f) /\
2784             (!h. h IN f
2785                  ==> ?a b. ~(a = vec 0) /\ h = {x:real^N | a dot x <= b}) /\
2786             !f'. f' PSUBSET f ==> s PSUBSET (affine hull s) INTER (INTERS f')`,
2787   GEN_TAC THEN EQ_TAC THENL
2788    [REWRITE_TAC[POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL];
2789     REWRITE_TAC[POLYHEDRON_INTER_AFFINE]] THEN
2790   MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN MESON_TAC[]);;
2791
2792 let RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT = prove
2793  (`!s:real^N->bool f a b.
2794         FINITE f /\
2795         s = affine hull s INTER INTERS f /\
2796         (!h. h IN f ==> ~(a h = vec 0) /\ h = {x | a h dot x <= b h}) /\
2797         (!f'. f' PSUBSET f ==> s PSUBSET affine hull s INTER INTERS f')
2798         ==> relative_interior s =
2799                 {x | x IN s /\ !h. h IN f ==> a h dot x < b h}`,
2800   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2801   DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) STRIP_ASSUME_TAC) THEN
2802   GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN
2803   X_GEN_TAC `x:real^N` THEN EQ_TAC THENL
2804    [ALL_TAC;
2805     STRIP_TAC THEN ASM_REWRITE_TAC[RELATIVE_INTERIOR; IN_ELIM_THM] THEN
2806     EXISTS_TAC `INTERS {interior h | (h:real^N->bool) IN f}` THEN
2807     ASM_SIMP_TAC[SIMPLE_IMAGE; OPEN_INTERS; FINITE_IMAGE; OPEN_INTERIOR;
2808                  FORALL_IN_IMAGE; IN_INTERS] THEN
2809     CONJ_TAC THENL
2810      [X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN
2811       REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`)) THEN
2812       ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN
2813       FIRST_ASSUM(SUBST1_TAC o CONJUNCT2) THEN
2814       ASM_SIMP_TAC[INTERIOR_HALFSPACE_LE; IN_ELIM_THM];
2815       FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
2816       MATCH_MP_TAC(SET_RULE
2817        `(!s. s IN f ==> i s SUBSET s)
2818         ==> INTERS (IMAGE i f) INTER t SUBSET t INTER INTERS f`) THEN
2819       REWRITE_TAC[INTERIOR_SUBSET]]] THEN
2820   DISCH_TAC THEN
2821   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR]) THEN
2822   DISCH_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:real^N->bool` THEN
2823   DISCH_TAC THEN
2824   FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (i:real^N->bool)`) THEN ANTS_TAC THENL
2825    [ASM SET_TAC[];
2826     REWRITE_TAC[PSUBSET_ALT; IN_INTER; IN_INTERS; IN_DELETE]] THEN
2827   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2828   DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN
2829   SUBGOAL_THEN `(a:(real^N->bool)->real^N) i dot z > b i` ASSUME_TAC THENL
2830    [UNDISCH_TAC `~((z:real^N) IN s)` THEN
2831     FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_INTER; IN_INTERS] THEN
2832     ASM_REWRITE_TAC[REAL_ARITH `a:real > b <=> ~(a <= b)`] THEN ASM SET_TAC[];
2833     ALL_TAC] THEN
2834   SUBGOAL_THEN `~(z:real^N = x)` ASSUME_TAC THENL
2835    [ASM_MESON_TAC[]; ALL_TAC] THEN
2836   SUBGOAL_THEN
2837    `?l. &0 < l /\ l < &1 /\ (l % z + (&1 - l) % x:real^N) IN s`
2838   STRIP_ASSUME_TAC THENL
2839    [FIRST_ASSUM(X_CHOOSE_THEN `e:real` MP_TAC o CONJUNCT2) THEN
2840     REWRITE_TAC[SUBSET; IN_INTER; IN_BALL; dist] THEN STRIP_TAC THEN
2841     EXISTS_TAC `min (&1 / &2) (e / &2 / norm(z - x:real^N))` THEN
2842     REWRITE_TAC[REAL_MIN_LT; REAL_LT_MIN] THEN
2843     CONV_TAC REAL_RAT_REDUCE_CONV THEN
2844     ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ] THEN
2845     FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL
2846      [REWRITE_TAC[VECTOR_ARITH
2847        `x - (l % z + (&1 - l) % x):real^N = --l % (z - x)`] THEN
2848       REWRITE_TAC[NORM_MUL; REAL_ABS_NEG] THEN
2849       ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN
2850       MATCH_MP_TAC(REAL_ARITH
2851        `&0 < a /\ &0 < b /\ b < c ==> abs(min a b) < c`) THEN
2852       ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ] THEN
2853       REWRITE_TAC[REAL_LT_01; real_div; REAL_MUL_ASSOC] THEN
2854       MATCH_MP_TAC REAL_LT_RMUL THEN
2855       ASM_REWRITE_TAC[REAL_LT_INV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN
2856       UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC;
2857       ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN
2858       MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN
2859       ASM SET_TAC[]];
2860     ALL_TAC] THEN
2861   MATCH_MP_TAC REAL_LT_RCANCEL_IMP THEN EXISTS_TAC `&1 - l` THEN
2862   ASM_REWRITE_TAC[REAL_SUB_LT] THEN
2863   REWRITE_TAC[REAL_ARITH `a < b * (&1 - l) <=> l * b + a < b`] THEN
2864   MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC
2865    `l * (a:(real^N->bool)->real^N) i dot z + (a i dot x) * (&1 - l)` THEN
2866   ASM_SIMP_TAC[REAL_LT_RADD; REAL_LT_LMUL_EQ; GSYM real_gt] THEN
2867   ONCE_REWRITE_TAC[REAL_ARITH `a * (&1 - b) = (&1 - b) * a`] THEN
2868   REWRITE_TAC[GSYM DOT_RMUL; GSYM DOT_RADD] THEN ASM SET_TAC[]);;
2869
2870 let FACET_OF_POLYHEDRON_EXPLICIT = prove
2871  (`!s:real^N->bool f a b.
2872         FINITE f /\
2873         s = affine hull s INTER INTERS f /\
2874         (!h. h IN f ==> ~(a h = vec 0) /\ h = {x | a h dot x <= b h}) /\
2875         (!f'. f' PSUBSET f ==> s PSUBSET affine hull s INTER INTERS f')
2876         ==> !c. c facet_of s <=>
2877                 ?h. h IN f /\ c = s INTER {x | a h dot x = b h}`,
2878   REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
2879    [ASM_REWRITE_TAC[INTER_EMPTY; AFFINE_HULL_EMPTY; SET_RULE `~(s PSUBSET s)`;
2880                     FACET_OF_EMPTY] THEN
2881     ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN
2882     ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
2883     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
2884     DISCH_THEN(X_CHOOSE_TAC `h:real^N->bool`) THEN DISCH_THEN
2885      (MP_TAC o SPEC `f DELETE (h:real^N->bool)` o last o CONJUNCTS) THEN
2886     ASM SET_TAC[];
2887     STRIP_TAC] THEN
2888   SUBGOAL_THEN `polyhedron(s:real^N->bool)` ASSUME_TAC THENL
2889    [REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN
2890     REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[];
2891     ALL_TAC] THEN
2892   FIRST_ASSUM(ASSUME_TAC o MATCH_MP POLYHEDRON_IMP_CONVEX) THEN
2893   SUBGOAL_THEN
2894    `!h:real^N->bool.
2895        h IN f ==> (s INTER {x:real^N | a h dot x = b h}) facet_of s`
2896   (LABEL_TAC "face") THENL
2897    [REPEAT STRIP_TAC THEN REWRITE_TAC[facet_of] THEN CONJ_TAC THENL
2898      [MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN
2899       CONJ_TAC THENL
2900        [MATCH_MP_TAC POLYHEDRON_IMP_CONVEX THEN
2901         REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN
2902         REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[];
2903         X_GEN_TAC `x:real^N` THEN FIRST_X_ASSUM SUBST1_TAC THEN
2904         REWRITE_TAC[IN_INTER; IN_INTERS] THEN
2905         DISCH_THEN(MP_TAC o SPEC `h:real^N->bool` o CONJUNCT2) THEN
2906         ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
2907         FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN
2908         ASM_REWRITE_TAC[] THEN ASM SET_TAC[]];
2909       ALL_TAC] THEN
2910     MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_EQ_EMPTY) THEN
2911     ASM_SIMP_TAC[] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
2912     DISCH_THEN(X_CHOOSE_TAC `x:real^N`) THEN
2913     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR]) THEN
2914     DISCH_TAC THEN
2915     FIRST_ASSUM(MP_TAC o SPEC `f DELETE (h:real^N->bool)`) THEN
2916     ANTS_TAC THENL
2917      [ASM SET_TAC[];
2918       REWRITE_TAC[PSUBSET_ALT; IN_INTER; IN_INTERS; IN_DELETE]] THEN
2919     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2920     DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN
2921     SUBGOAL_THEN `(a:(real^N->bool)->real^N) h dot z > b h` ASSUME_TAC THENL
2922      [UNDISCH_TAC `~((z:real^N) IN s)` THEN
2923       FIRST_ASSUM(SUBST1_TAC o SYM) THEN
2924       REWRITE_TAC[IN_INTER; IN_INTERS] THEN
2925       ASM_REWRITE_TAC[REAL_ARITH `a:real > b <=> ~(a <= b)`] THEN
2926       ASM SET_TAC[];
2927       ALL_TAC] THEN
2928     SUBGOAL_THEN `~(z:real^N = x)` ASSUME_TAC THENL
2929      [ASM_MESON_TAC[]; ALL_TAC] THEN
2930     MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`;
2931                    `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`]
2932            RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN
2933     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
2934      [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN
2935     GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN
2936     DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
2937     ASM_REWRITE_TAC[IN_ELIM_THM] THEN
2938     DISCH_THEN(fun th ->
2939       MP_TAC(SPEC `h:real^N->bool` th) THEN ASM_REWRITE_TAC[] THEN
2940       DISCH_TAC THEN ASSUME_TAC th) THEN
2941     SUBGOAL_THEN `(a:(real^N->bool)->real^N) h dot x < a h dot z`
2942     ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
2943     ABBREV_TAC `l = (b h - (a:(real^N->bool)->real^N) h dot x) /
2944                     (a h dot z - a h dot x)` THEN
2945     SUBGOAL_THEN `&0 < l /\ l < &1` STRIP_ASSUME_TAC THENL
2946      [EXPAND_TAC "l" THEN
2947       ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_SUB_LT] THEN
2948       ASM_REAL_ARITH_TAC;
2949       ALL_TAC] THEN
2950     ABBREV_TAC `w:real^N = (&1 - l) % x + l % z:real^N` THEN
2951     SUBGOAL_THEN
2952      `!i. i IN f /\ ~(i = h) ==> (a:(real^N->bool)->real^N) i dot w < b i`
2953     ASSUME_TAC THENL
2954      [X_GEN_TAC `i:real^N->bool` THEN STRIP_TAC THEN EXPAND_TAC "w" THEN
2955       REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN
2956       MATCH_MP_TAC(REAL_ARITH
2957        `(&1 - l) * x < (&1 - l) * z /\ l * y <= l * z
2958         ==> (&1 - l) * x + l * y < z`) THEN
2959       ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_IMP_LE;
2960                    REAL_LT_LMUL_EQ; REAL_SUB_LT] THEN
2961       UNDISCH_TAC `!t:real^N->bool. t IN f /\ ~(t = h) ==> z IN t` THEN
2962       DISCH_THEN(MP_TAC o SPEC `i:real^N->bool`) THEN ASM SET_TAC[];
2963       ALL_TAC] THEN
2964     SUBGOAL_THEN `(a:(real^N->bool)->real^N) h dot w = b h` ASSUME_TAC THENL
2965      [EXPAND_TAC "w" THEN REWRITE_TAC[VECTOR_ARITH
2966          `(&1 - l) % x + l % z:real^N = x + l % (z - x)`] THEN
2967       EXPAND_TAC "l" THEN REWRITE_TAC[DOT_RADD; DOT_RSUB; DOT_RMUL] THEN
2968       ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NE; REAL_SUB_0] THEN
2969       REAL_ARITH_TAC;
2970       ALL_TAC] THEN
2971     SUBGOAL_THEN `(w:real^N) IN s` ASSUME_TAC THENL
2972      [FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [th]) THEN
2973       REWRITE_TAC[IN_INTER; IN_INTERS] THEN CONJ_TAC THENL
2974        [EXPAND_TAC "w" THEN
2975         MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN
2976         ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HULL_INC THEN
2977         ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET];
2978         ALL_TAC] THEN
2979       X_GEN_TAC `i:real^N->bool` THEN DISCH_TAC THEN
2980       ASM_CASES_TAC `i:real^N->bool = h` THENL
2981        [ASM SET_TAC[REAL_LE_REFL]; ALL_TAC] THEN
2982       SUBGOAL_THEN `convex(i:real^N->bool)` MP_TAC THENL
2983        [REPEAT(FIRST_X_ASSUM(MP_TAC o C MATCH_MP
2984          (ASSUME `(i:real^N->bool) IN f`))) THEN
2985         REPEAT(DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th])) THEN
2986         REWRITE_TAC[CONVEX_HALFSPACE_LE];
2987         ALL_TAC] THEN
2988       REWRITE_TAC[CONVEX_ALT] THEN EXPAND_TAC "w" THEN
2989       DISCH_THEN MATCH_MP_TAC THEN
2990       ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT1) THEN
2991       FIRST_ASSUM(fun t -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [t]) THEN
2992       REWRITE_TAC[IN_INTER; IN_INTERS] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE];
2993       ALL_TAC] THEN
2994     CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
2995     ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN
2996     SUBGOAL_THEN
2997      `affine hull (s INTER {x | (a:(real^N->bool)->real^N) h dot x = b h}) =
2998       (affine hull s) INTER {x | a h dot x = b h}`
2999     SUBST1_TAC THENL
3000      [ALL_TAC;
3001       SIMP_TAC[AFF_DIM_AFFINE_INTER_HYPERPLANE; AFFINE_AFFINE_HULL] THEN
3002       COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
3003       COND_CASES_TAC THENL [ASM SET_TAC[REAL_LT_REFL]; REFL_TAC]] THEN
3004     MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET_INTER] THEN
3005     REPEAT CONJ_TAC THENL
3006      [MATCH_MP_TAC HULL_MONO THEN SET_TAC[];
3007       MATCH_MP_TAC(SET_RULE
3008        `s SUBSET affine hull t /\ affine hull t = t ==> s SUBSET t`) THEN
3009       REWRITE_TAC[AFFINE_HULL_EQ; AFFINE_HYPERPLANE] THEN
3010       MATCH_MP_TAC HULL_MONO THEN SET_TAC[];
3011       ALL_TAC] THEN
3012     REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN
3013     X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
3014     SUBGOAL_THEN
3015      `?t. &0 < t /\
3016           !j. j IN f /\ ~(j:real^N->bool = h)
3017               ==> t * (a j dot y - a j dot w) <= b j - a j dot (w:real^N)`
3018     STRIP_ASSUME_TAC THENL
3019      [ASM_CASES_TAC `f DELETE (h:real^N->bool) = {}` THENL
3020        [ASM_REWRITE_TAC[GSYM IN_DELETE; NOT_IN_EMPTY] THEN
3021         EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01];
3022         ALL_TAC] THEN
3023       EXISTS_TAC `inf (IMAGE
3024        (\j. if &0 < a j dot y - a j dot (w:real^N)
3025             then (b j - a j dot w) / (a j dot y - a j dot w)
3026             else &1) (f DELETE (h:real^N->bool)))` THEN
3027       MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
3028        [ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; FINITE_DELETE;
3029                      IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; IN_DELETE] THEN
3030         ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN
3031         ASM_SIMP_TAC[REAL_LT_DIV; REAL_SUB_LT; REAL_LT_01; COND_ID];
3032         REWRITE_TAC[REAL_SUB_LT] THEN DISCH_TAC] THEN
3033       X_GEN_TAC `j:real^N->bool` THEN STRIP_TAC THEN
3034       ASM_CASES_TAC `a j dot (w:real^N) < a(j:real^N->bool) dot y` THENL
3035        [ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_INF_LE_FINITE; REAL_SUB_LT;
3036                      FINITE_IMAGE; FINITE_DELETE; IMAGE_EQ_EMPTY] THEN
3037         REWRITE_TAC[EXISTS_IN_IMAGE] THEN EXISTS_TAC `j:real^N->bool` THEN
3038         ASM_REWRITE_TAC[IN_DELETE; REAL_LE_REFL];
3039         MATCH_MP_TAC(REAL_ARITH `&0 <= --x /\ &0 < y ==> x <= y`) THEN
3040         ASM_SIMP_TAC[REAL_SUB_LT; GSYM REAL_MUL_RNEG; REAL_LE_MUL_EQ] THEN
3041         ASM_REAL_ARITH_TAC];
3042       ALL_TAC] THEN
3043     ABBREV_TAC `c:real^N = (&1 - t) % w + t % y` THEN
3044     SUBGOAL_THEN `y:real^N = (&1 - inv t) % w + inv(t) % c` SUBST1_TAC THENL
3045      [EXPAND_TAC "c" THEN
3046       REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN
3047       ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ;
3048                 REAL_FIELD `&0 < x ==> inv x * (&1 - x) = inv x - &1`] THEN
3049       VECTOR_ARITH_TAC;
3050       ALL_TAC] THEN
3051     MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN
3052     CONJ_TAC THEN MATCH_MP_TAC HULL_INC THEN
3053     ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
3054     MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
3055      [EXPAND_TAC "c" THEN REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN
3056       ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RING;
3057       DISCH_TAC] THEN
3058     FIRST_ASSUM(fun t -> GEN_REWRITE_TAC RAND_CONV [t]) THEN
3059     REWRITE_TAC[IN_INTER; IN_INTERS] THEN CONJ_TAC THENL
3060      [EXPAND_TAC "c" THEN
3061       MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN
3062       ASM_SIMP_TAC[HULL_INC];
3063       ALL_TAC] THEN
3064     X_GEN_TAC `j:real^N->bool` THEN DISCH_TAC THEN
3065     FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o C MATCH_MP
3066       (ASSUME `(j:real^N->bool) IN f`)) THEN
3067     DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN
3068     ASM_CASES_TAC `j:real^N->bool = h` THEN ASM_SIMP_TAC[REAL_EQ_IMP_LE] THEN
3069     EXPAND_TAC "c" THEN REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN
3070     REWRITE_TAC[REAL_ARITH
3071      `(&1 - t) * x + t * y <= z <=> t * (y - x) <= z - x`] THEN
3072     ASM_SIMP_TAC[];
3073     ALL_TAC] THEN
3074   X_GEN_TAC `c:real^N->bool` THEN EQ_TAC THENL
3075    [ALL_TAC; STRIP_TAC THEN ASM_SIMP_TAC[]] THEN
3076   REWRITE_TAC[facet_of] THEN STRIP_TAC THEN
3077   FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_CONVEX) THEN
3078   SUBGOAL_THEN `~(relative_interior(c:real^N->bool) = {})` MP_TAC THENL
3079    [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; ALL_TAC] THEN
3080   REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
3081   DISCH_THEN(X_CHOOSE_TAC `x:real^N`) THEN
3082   MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`;
3083                  `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`]
3084          RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN
3085   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN
3086   GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN
3087   DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN
3088   SUBGOAL_THEN `~(c:real^N->bool = s)` ASSUME_TAC THENL
3089    [ASM_MESON_TAC[INT_ARITH`~(i:int = i - &1)`]; ALL_TAC] THEN
3090   SUBGOAL_THEN `~((x:real^N) IN relative_interior s)` ASSUME_TAC THENL
3091    [UNDISCH_TAC `~(c:real^N->bool = s)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN
3092     DISCH_TAC THEN MATCH_MP_TAC FACE_OF_EQ THEN
3093     EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_REFL] THEN
3094     ASM SET_TAC[];
3095     ALL_TAC] THEN
3096   SUBGOAL_THEN `(x:real^N) IN s` MP_TAC THENL
3097    [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o MATCH_MP
3098        FACE_OF_IMP_SUBSET) THEN
3099     ASM_SIMP_TAC[REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET];
3100     ALL_TAC] THEN
3101   ASM_SIMP_TAC[] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
3102   FIRST_ASSUM(fun t -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [t]) THEN
3103   REWRITE_TAC[IN_INTER; IN_INTERS] THEN STRIP_TAC THEN
3104   REWRITE_TAC[NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
3105   X_GEN_TAC `i:real^N->bool` THEN REWRITE_TAC[NOT_IMP] THEN STRIP_TAC THEN
3106   ASM_REWRITE_TAC[] THEN
3107   SUBGOAL_THEN `(a:(real^N->bool)->real^N) i dot x = b i` ASSUME_TAC THENL
3108    [MATCH_MP_TAC(REAL_ARITH `x <= y /\ ~(x < y) ==> x = y`) THEN
3109     ASM_REWRITE_TAC[] THEN UNDISCH_THEN
3110      `!t:real^N->bool. t IN f ==> x IN t` (MP_TAC o SPEC `i:real^N->bool`) THEN
3111     ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o C MATCH_MP
3112      (ASSUME `(i:real^N->bool) IN f`)) THEN SET_TAC[];
3113     ALL_TAC] THEN
3114   SUBGOAL_THEN `c SUBSET (s INTER {x:real^N | a(i:real^N->bool) dot x = b i})`
3115   ASSUME_TAC THENL
3116    [MATCH_MP_TAC SUBSET_OF_FACE_OF THEN EXISTS_TAC `s:real^N->bool` THEN
3117     ASM_SIMP_TAC[FACE_OF_IMP_SUBSET] THEN
3118     RULE_ASSUM_TAC(REWRITE_RULE[facet_of]) THEN ASM_SIMP_TAC[] THEN
3119     REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY] THEN
3120     EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM];
3121     ALL_TAC] THEN
3122   SUBGOAL_THEN `c face_of (s INTER {x:real^N | a(i:real^N->bool) dot x = b i})`
3123   ASSUME_TAC THENL
3124    [MP_TAC(ISPECL [`c:real^N->bool`; `s:real^N->bool`;
3125                    `s INTER {x:real^N | a(i:real^N->bool) dot x = b i}`]
3126                 FACE_OF_FACE) THEN
3127     RULE_ASSUM_TAC(REWRITE_RULE[facet_of]) THEN ASM_SIMP_TAC[];
3128     ALL_TAC] THEN
3129   MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
3130   SUBGOAL_THEN
3131    `aff_dim(c:real^N->bool) <
3132     aff_dim(s INTER {x:real^N | a(i:real^N->bool) dot x = b i})`
3133   MP_TAC THENL
3134    [MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN
3135     ASM_SIMP_TAC[CONVEX_INTER; CONVEX_HYPERPLANE];
3136     RULE_ASSUM_TAC(REWRITE_RULE[facet_of]) THEN ASM_SIMP_TAC[INT_LT_REFL]]);;
3137
3138 let FACE_OF_POLYHEDRON_SUBSET_EXPLICIT = prove
3139  (`!s:real^N->bool f a b.
3140         FINITE f /\
3141         s = affine hull s INTER INTERS f /\
3142         (!h. h IN f ==> ~(a h = vec 0) /\ h = {x | a h dot x <= b h}) /\
3143         (!f'. f' PSUBSET f ==> s PSUBSET affine hull s INTER INTERS f')
3144         ==> !c. c face_of s /\ ~(c = {}) /\ ~(c = s)
3145                 ==> ?h. h IN f /\ c SUBSET (s INTER {x | a h dot x = b h})`,
3146   REPEAT GEN_TAC THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL
3147    [DISCH_THEN(MP_TAC o SYM o CONJUNCT1 o CONJUNCT2) THEN
3148     ASM_REWRITE_TAC[INTERS_0; INTER_UNIV; AFFINE_HULL_EQ] THEN
3149     MESON_TAC[FACE_OF_AFFINE_TRIVIAL];
3150     ALL_TAC] THEN
3151   DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC th) THEN
3152   DISCH_THEN(ASSUME_TAC o MATCH_MP FACET_OF_POLYHEDRON_EXPLICIT) THEN
3153   REPEAT STRIP_TAC THEN
3154   FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_CONVEX) THEN
3155   FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN
3156   SUBGOAL_THEN `polyhedron(s:real^N->bool)` ASSUME_TAC THENL
3157    [REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN
3158     REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[];
3159     ALL_TAC] THEN
3160   FIRST_ASSUM(ASSUME_TAC o MATCH_MP POLYHEDRON_IMP_CONVEX) THEN
3161   SUBGOAL_THEN
3162    `!h:real^N->bool.
3163         h IN f ==> (s INTER {x:real^N | a h dot x = b h}) face_of s`
3164   ASSUME_TAC THENL
3165    [REPEAT STRIP_TAC THEN
3166     MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN CONJ_TAC THENL
3167      [MATCH_MP_TAC POLYHEDRON_IMP_CONVEX THEN
3168       REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN
3169       REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[];
3170       X_GEN_TAC `x:real^N` THEN FIRST_X_ASSUM SUBST1_TAC THEN
3171       REWRITE_TAC[IN_INTER; IN_INTERS] THEN
3172       DISCH_THEN(MP_TAC o SPEC `h:real^N->bool` o CONJUNCT2) THEN
3173       ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
3174       FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN
3175       ASM_REWRITE_TAC[] THEN ASM SET_TAC[]];
3176     ALL_TAC] THEN
3177   SUBGOAL_THEN `~(relative_interior(c:real^N->bool) = {})` MP_TAC THENL
3178    [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; ALL_TAC] THEN
3179   REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
3180   DISCH_THEN(X_CHOOSE_TAC `x:real^N`) THEN
3181   MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`;
3182                  `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`]
3183          RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN
3184   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN
3185   GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN
3186   DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN
3187   SUBGOAL_THEN `~((x:real^N) IN relative_interior s)` ASSUME_TAC THENL
3188    [UNDISCH_TAC `~(c:real^N->bool = s)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN
3189     DISCH_TAC THEN MATCH_MP_TAC FACE_OF_EQ THEN
3190     EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_REFL] THEN
3191     ASM SET_TAC[];
3192     ALL_TAC] THEN
3193   SUBGOAL_THEN `(x:real^N) IN s` MP_TAC THENL
3194    [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o MATCH_MP
3195        FACE_OF_IMP_SUBSET) THEN
3196     ASM_SIMP_TAC[REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET];
3197     ALL_TAC] THEN
3198   ASM_SIMP_TAC[] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
3199   FIRST_ASSUM(fun t -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [t]) THEN
3200   REWRITE_TAC[IN_INTER; IN_INTERS] THEN STRIP_TAC THEN
3201   REWRITE_TAC[NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
3202   X_GEN_TAC `i:real^N->bool` THEN REWRITE_TAC[NOT_IMP] THEN STRIP_TAC THEN
3203   ASM_REWRITE_TAC[] THEN
3204   SUBGOAL_THEN `(a:(real^N->bool)->real^N) i dot x = b i` ASSUME_TAC THENL
3205    [MATCH_MP_TAC(REAL_ARITH `x <= y /\ ~(x < y) ==> x = y`) THEN
3206     ASM_REWRITE_TAC[] THEN UNDISCH_THEN
3207      `!t:real^N->bool. t IN f ==> x IN t` (MP_TAC o SPEC `i:real^N->bool`) THEN
3208     ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o C MATCH_MP
3209      (ASSUME `(i:real^N->bool) IN f`)) THEN SET_TAC[];
3210     ALL_TAC] THEN
3211   MATCH_MP_TAC SUBSET_OF_FACE_OF THEN EXISTS_TAC `s:real^N->bool` THEN
3212   ASM_SIMP_TAC[FACE_OF_IMP_SUBSET] THEN
3213   RULE_ASSUM_TAC(REWRITE_RULE[facet_of]) THEN ASM_SIMP_TAC[] THEN
3214   REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY] THEN
3215   EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM]);;
3216
3217 let FACE_OF_POLYHEDRON_EXPLICIT = prove
3218  (`!s:real^N->bool f a b.
3219         FINITE f /\
3220         s = affine hull s INTER INTERS f /\
3221         (!h. h IN f ==> ~(a h = vec 0) /\ h = {x | a h dot x <= b h}) /\
3222         (!f'. f' PSUBSET f ==> s PSUBSET affine hull s INTER INTERS f')
3223         ==> !c. c face_of s /\ ~(c = {}) /\ ~(c = s)
3224                 ==> c = INTERS {s INTER {x | a h dot x = b h} |h|
3225                                 h IN f /\
3226                                 c SUBSET (s INTER {x | a h dot x = b h})}`,
3227   let lemma = prove
3228    (`!t s. (!a. P a ==> t SUBSET s INTER INTERS {f x | P x})
3229            ==> t SUBSET INTERS {s INTER f x | P x}`,
3230     ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
3231     REWRITE_TAC[INTERS_IMAGE] THEN SET_TAC[]) in
3232   REPEAT GEN_TAC THEN
3233   DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC th) THEN
3234   DISCH_THEN(ASSUME_TAC o MATCH_MP FACET_OF_POLYHEDRON_EXPLICIT) THEN
3235   REPEAT STRIP_TAC THEN
3236   FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_CONVEX) THEN
3237   FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN
3238   SUBGOAL_THEN `polyhedron(s:real^N->bool)` ASSUME_TAC THENL
3239    [REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN
3240     REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[];
3241     ALL_TAC] THEN
3242   FIRST_ASSUM(ASSUME_TAC o MATCH_MP POLYHEDRON_IMP_CONVEX) THEN
3243   SUBGOAL_THEN
3244    `!h:real^N->bool.
3245         h IN f ==> (s INTER {x:real^N | a h dot x = b h}) face_of s`
3246   ASSUME_TAC THENL
3247    [REPEAT STRIP_TAC THEN
3248     MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN CONJ_TAC THENL
3249      [MATCH_MP_TAC POLYHEDRON_IMP_CONVEX THEN
3250       REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN
3251       REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[];
3252       X_GEN_TAC `x:real^N` THEN FIRST_X_ASSUM SUBST1_TAC THEN
3253       REWRITE_TAC[IN_INTER; IN_INTERS] THEN
3254       DISCH_THEN(MP_TAC o SPEC `h:real^N->bool` o CONJUNCT2) THEN
3255       ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
3256       FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN
3257       ASM_REWRITE_TAC[] THEN ASM SET_TAC[]];
3258     ALL_TAC] THEN
3259   SUBGOAL_THEN `~(relative_interior(c:real^N->bool) = {})` MP_TAC THENL
3260    [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; ALL_TAC] THEN
3261   REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN
3262   X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
3263   SUBGOAL_THEN `(z:real^N) IN s` ASSUME_TAC THENL
3264    [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN
3265     MATCH_MP_TAC(REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET) THEN
3266     ASM_REWRITE_TAC[];
3267     ALL_TAC] THEN
3268   MATCH_MP_TAC FACE_OF_EQ THEN EXISTS_TAC `s:real^N->bool` THEN
3269   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
3270    [MATCH_MP_TAC FACE_OF_INTERS THEN ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN
3271     ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[IMAGE_EQ_EMPTY] THEN
3272     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
3273     MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`;
3274                    `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`]
3275          FACE_OF_POLYHEDRON_SUBSET_EXPLICIT) THEN
3276     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL[FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN
3277     DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[];
3278     ALL_TAC] THEN
3279   SUBGOAL_THEN
3280    `{s INTER {x | a(h:real^N->bool) dot x = b h} |h|
3281      h IN f /\ c SUBSET (s INTER {x:real^N | a h dot x = b h})} =
3282     {s INTER {x | a(h:real^N->bool) dot x = b h} |h|
3283      h IN f /\ z IN s INTER {x:real^N | a h dot x = b h}}`
3284   SUBST1_TAC THENL
3285    [MATCH_MP_TAC(SET_RULE
3286      `(!x. P x <=> Q x) ==> {f x | P x} = {f x | Q x}`) THEN
3287     X_GEN_TAC `h:real^N->bool` THEN EQ_TAC THEN STRIP_TAC THEN
3288     ASM_REWRITE_TAC[] THENL
3289      [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN
3290       MATCH_MP_TAC(REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET) THEN
3291       ASM_REWRITE_TAC[];
3292       MATCH_MP_TAC SUBSET_OF_FACE_OF THEN EXISTS_TAC `s:real^N->bool` THEN
3293       ASM_SIMP_TAC[] THEN ASM SET_TAC[]];
3294     ALL_TAC] THEN
3295   REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
3296   EXISTS_TAC `z:real^N` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN
3297   SUBGOAL_THEN
3298    `?e. &0 < e /\ !h. h IN f /\ a(h:real^N->bool) dot z < b h
3299                       ==> ball(z,e) SUBSET {w:real^N | a h dot w < b h}`
3300   (CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THENL
3301    [REWRITE_TAC[SET_RULE
3302      `(!h. P h ==> s SUBSET t h) <=> s SUBSET INTERS (IMAGE t {h | P h})`] THEN
3303     MATCH_MP_TAC(MESON[OPEN_CONTAINS_BALL]
3304      `open s /\ x IN s ==> ?e. &0 < e /\ ball(x,e) SUBSET s`) THEN
3305     SIMP_TAC[IN_INTERS; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
3306     MATCH_MP_TAC OPEN_INTERS THEN
3307     ASM_SIMP_TAC[FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_RESTRICT] THEN
3308     REWRITE_TAC[OPEN_HALFSPACE_LT];
3309     ALL_TAC] THEN
3310   ASM_REWRITE_TAC[IN_RELATIVE_INTERIOR] THEN
3311   ASM_SIMP_TAC[IN_INTERS; FORALL_IN_GSPEC; IN_ELIM_THM; IN_INTER] THEN
3312   EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN
3313   MATCH_MP_TAC lemma THEN X_GEN_TAC `i:real^N->bool` THEN STRIP_TAC THEN
3314   FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [th]) THEN
3315   MATCH_MP_TAC(SET_RULE
3316    `ae SUBSET as /\ ae SUBSET hs /\
3317     b INTER hs SUBSET fs
3318     ==> (b INTER ae) SUBSET (as INTER fs) INTER hs`) THEN
3319   REPEAT CONJ_TAC THENL
3320    [MATCH_MP_TAC HULL_MONO THEN
3321     REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_GSPEC] THEN ASM SET_TAC[];
3322     SIMP_TAC[SET_RULE `s SUBSET INTERS f <=> !t. t IN f ==> s SUBSET t`] THEN
3323     REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `j:real^N->bool` THEN
3324     STRIP_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN
3325     REWRITE_TAC[AFFINE_HYPERPLANE] THEN
3326     REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_GSPEC] THEN ASM SET_TAC[];
3327     ALL_TAC] THEN
3328   REWRITE_TAC[SET_RULE `s SUBSET INTERS f <=> !t. t IN f ==> s SUBSET t`] THEN
3329   X_GEN_TAC `j:real^N->bool` THEN DISCH_TAC THEN
3330   SUBGOAL_THEN `(a:(real^N->bool)->real^N) j dot z <= b j` MP_TAC THENL
3331    [ASM SET_TAC[]; REWRITE_TAC[REAL_LE_LT]] THEN
3332   STRIP_TAC THENL [ASM SET_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN
3333   MATCH_MP_TAC(SET_RULE
3334   `(?s. s IN f /\ s SUBSET t) ==> u INTER INTERS f SUBSET t`) THEN
3335   REWRITE_TAC[EXISTS_IN_GSPEC] THEN EXISTS_TAC `j:real^N->bool` THEN
3336   ASM SET_TAC[REAL_LE_REFL]);;
3337
3338 (* ------------------------------------------------------------------------- *)
3339 (* More general corollaries from the explicit representation.                *)
3340 (* ------------------------------------------------------------------------- *)
3341
3342 let FACET_OF_POLYHEDRON = prove
3343  (`!s:real^N->bool c.
3344         polyhedron s /\ c facet_of s
3345         ==> ?a b. ~(a = vec 0) /\
3346                   s SUBSET {x | a dot x <= b} /\
3347                   c = s INTER {x | a dot x = b}`,
3348   REPEAT STRIP_TAC THEN FIRST_ASSUM
3349    (MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_INTER_AFFINE_MINIMAL]) THEN
3350   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV)
3351    [RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN
3352   SIMP_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN
3353   MAP_EVERY X_GEN_TAC
3354    [`f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`;
3355     `b:(real^N->bool)->real`] THEN
3356   STRIP_TAC THEN
3357   MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`;
3358                  `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`]
3359         FACET_OF_POLYHEDRON_EXPLICIT) THEN
3360   ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
3361   DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
3362   DISCH_THEN(X_CHOOSE_THEN `i:real^N->bool` STRIP_ASSUME_TAC) THEN
3363   EXISTS_TAC `(a:(real^N->bool)->real^N) i` THEN
3364   EXISTS_TAC `(b:(real^N->bool)->real) i` THEN ASM_SIMP_TAC[] THEN
3365   FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN
3366   MATCH_MP_TAC(SET_RULE `t SUBSET u ==> (s INTER t) SUBSET u`) THEN
3367   MATCH_MP_TAC(SET_RULE `t IN f ==> INTERS f SUBSET t`) THEN ASM_MESON_TAC[]);;
3368
3369 let FACE_OF_POLYHEDRON = prove
3370  (`!s:real^N->bool c.
3371         polyhedron s /\ c face_of s /\ ~(c = {}) /\ ~(c = s)
3372         ==> c = INTERS {f | f facet_of s /\ c SUBSET f}`,
3373   REPEAT STRIP_TAC THEN FIRST_ASSUM
3374    (MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_INTER_AFFINE_MINIMAL]) THEN
3375   REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN
3376   SIMP_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN
3377   MAP_EVERY X_GEN_TAC
3378    [`f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`;
3379     `b:(real^N->bool)->real`] THEN
3380   STRIP_TAC THEN
3381   MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`;
3382                  `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`]
3383          FACET_OF_POLYHEDRON_EXPLICIT) THEN
3384   ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
3385   DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN
3386   MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`;
3387                  `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`]
3388          FACE_OF_POLYHEDRON_EXPLICIT) THEN
3389   ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
3390   DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
3391   DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN
3392   AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN
3393   X_GEN_TAC `h:real^N->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[]);;
3394
3395 let FACE_OF_POLYHEDRON_SUBSET_FACET = prove
3396  (`!s:real^N->bool c.
3397         polyhedron s /\ c face_of s /\ ~(c = {}) /\ ~(c = s)
3398         ==> ?f. f facet_of s /\ c SUBSET f`,
3399   REPEAT STRIP_TAC THEN
3400   FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN
3401   MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`] FACE_OF_POLYHEDRON) THEN
3402   ASM_CASES_TAC `{f:real^N->bool | f facet_of s /\ c SUBSET f} = {}` THEN
3403   ASM SET_TAC[]);;
3404
3405 let EXPOSED_FACE_OF_POLYHEDRON = prove
3406  (`!s f:real^N->bool. polyhedron s ==> (f exposed_face_of s <=> f face_of s)`,
3407   REPEAT STRIP_TAC THEN EQ_TAC THENL [SIMP_TAC[exposed_face_of]; ALL_TAC] THEN
3408   DISCH_TAC THEN ASM_CASES_TAC `f:real^N->bool = {}` THEN
3409   ASM_REWRITE_TAC[EMPTY_EXPOSED_FACE_OF] THEN
3410   ASM_CASES_TAC `f:real^N->bool = s` THEN
3411   ASM_SIMP_TAC[EXPOSED_FACE_OF_REFL; POLYHEDRON_IMP_CONVEX] THEN
3412   MP_TAC(ISPECL [`s:real^N->bool`; `f:real^N->bool`] FACE_OF_POLYHEDRON) THEN
3413   ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
3414   MATCH_MP_TAC EXPOSED_FACE_OF_INTERS THEN
3415   REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; FORALL_IN_GSPEC] THEN
3416   ASM_SIMP_TAC[FACE_OF_POLYHEDRON_SUBSET_FACET; IN_ELIM_THM] THEN
3417   ASM_SIMP_TAC[exposed_face_of; FACET_OF_IMP_FACE_OF] THEN
3418   ASM_MESON_TAC[FACET_OF_POLYHEDRON]);;
3419
3420 let FACE_OF_POLYHEDRON_POLYHEDRON = prove
3421  (`!s:real^N->bool c. polyhedron s /\ c face_of s ==> polyhedron c`,
3422   REPEAT STRIP_TAC THEN FIRST_ASSUM
3423    (MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_INTER_AFFINE_MINIMAL]) THEN
3424   REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN
3425   SIMP_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN
3426   MAP_EVERY X_GEN_TAC
3427    [`f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`;
3428     `b:(real^N->bool)->real`] THEN
3429   STRIP_TAC THEN
3430   MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`;
3431                  `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`]
3432          FACE_OF_POLYHEDRON_EXPLICIT) THEN
3433   ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
3434   DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
3435   ASM_CASES_TAC `c:real^N->bool = {}` THEN
3436   ASM_REWRITE_TAC[POLYHEDRON_EMPTY] THEN
3437   ASM_CASES_TAC `c:real^N->bool = s` THEN ASM_REWRITE_TAC[] THEN
3438   DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC POLYHEDRON_INTERS THEN
3439   REWRITE_TAC[FORALL_IN_GSPEC] THEN
3440   ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
3441   ASM_SIMP_TAC[FINITE_IMAGE; FINITE_RESTRICT] THEN
3442   REPEAT STRIP_TAC THEN REWRITE_TAC[IMAGE_ID] THEN
3443   MATCH_MP_TAC POLYHEDRON_INTER THEN
3444   ASM_REWRITE_TAC[POLYHEDRON_HYPERPLANE]);;
3445
3446 let FINITE_POLYHEDRON_FACES = prove
3447  (`!s:real^N->bool. polyhedron s ==> FINITE {f | f face_of s}`,
3448   REPEAT STRIP_TAC THEN FIRST_ASSUM
3449    (MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_INTER_AFFINE_MINIMAL]) THEN
3450   REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN
3451   SIMP_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN
3452   MAP_EVERY X_GEN_TAC
3453    [`f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`;
3454     `b:(real^N->bool)->real`] THEN
3455   STRIP_TAC THEN
3456   MATCH_MP_TAC(MESON[FINITE_DELETE]
3457    `!a b. FINITE (s DELETE a DELETE b) ==> FINITE s`) THEN
3458   MAP_EVERY EXISTS_TAC [`{}:real^N->bool`; `s:real^N->bool`] THEN
3459   MATCH_MP_TAC FINITE_SUBSET THEN
3460   EXISTS_TAC
3461    `{INTERS {s INTER {x:real^N | a(h:real^N->bool) dot x = b h} | h | h IN f'}
3462     |f'| f' SUBSET f}` THEN
3463   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SIMPLE_IMAGE_GEN] THEN
3464   ASM_SIMP_TAC[FINITE_POWERSET; FINITE_IMAGE] THEN
3465   GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[IN_DELETE; IN_ELIM_THM] THEN
3466   MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`;
3467                  `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`]
3468          FACE_OF_POLYHEDRON_EXPLICIT) THEN
3469   ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
3470   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `c:real^N->bool` THEN
3471   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
3472   DISCH_TAC THEN EXISTS_TAC
3473    `{h:real^N->bool |
3474      h IN f /\ c SUBSET s INTER {x:real^N | a h dot x = b h}}` THEN
3475   CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
3476   ASM_REWRITE_TAC[IN_ELIM_THM] THEN FIRST_ASSUM ACCEPT_TAC);;
3477
3478 let FINITE_POLYHEDRON_EXPOSED_FACES = prove
3479  (`!s:real^N->bool. polyhedron s ==> FINITE {f | f exposed_face_of s}`,
3480   SIMP_TAC[EXPOSED_FACE_OF_POLYHEDRON; FINITE_POLYHEDRON_FACES]);;
3481
3482 let FINITE_POLYHEDRON_EXTREME_POINTS = prove
3483  (`!s:real^N->bool. polyhedron s ==> FINITE {v | v extreme_point_of s}`,
3484   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FACE_OF_SING] THEN
3485   ONCE_REWRITE_TAC[SET_RULE `{v} face_of s <=> {v} IN {f | f face_of s}`] THEN
3486   MATCH_MP_TAC FINITE_FINITE_PREIMAGE THEN
3487   ASM_SIMP_TAC[FINITE_POLYHEDRON_FACES] THEN X_GEN_TAC `f:real^N->bool` THEN
3488   DISCH_TAC THEN ASM_CASES_TAC `!a:real^N. ~({a} = f)` THEN
3489   ASM_REWRITE_TAC[EMPTY_GSPEC; FINITE_EMPTY] THEN
3490   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN
3491   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
3492   GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
3493   REWRITE_TAC[SET_RULE `{v | {v} = {a}} = {a}`; FINITE_SING]);;
3494
3495 let FINITE_POLYHEDRON_FACETS = prove
3496  (`!s:real^N->bool. polyhedron s ==> FINITE {f | f facet_of s}`,
3497   REWRITE_TAC[facet_of] THEN ONCE_REWRITE_TAC[SET_RULE
3498    `{x | P x /\ Q x} = {x | x IN {x | P x} /\ Q x}`] THEN
3499   SIMP_TAC[FINITE_RESTRICT; FINITE_POLYHEDRON_FACES]);;
3500
3501 let RELATIVE_INTERIOR_OF_POLYHEDRON = prove
3502  (`!s:real^N->bool.
3503         polyhedron s
3504         ==> relative_interior s = s DIFF UNIONS {f | f facet_of s}`,
3505   REPEAT STRIP_TAC THEN FIRST_ASSUM
3506    (MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_INTER_AFFINE_MINIMAL]) THEN
3507   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV)
3508    [RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN
3509   SIMP_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN
3510   MAP_EVERY X_GEN_TAC
3511    [`f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`;
3512     `b:(real^N->bool)->real`] THEN
3513   STRIP_TAC THEN
3514   MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`;
3515                  `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`]
3516         FACET_OF_POLYHEDRON_EXPLICIT) THEN
3517   MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`;
3518                  `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`]
3519         RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN
3520   ASM_REWRITE_TAC[] THEN
3521   ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN
3522   ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_TAC] THEN
3523   ASM_REWRITE_TAC[] THEN
3524   MATCH_MP_TAC(SET_RULE
3525    `(!x. x IN s ==> P x \/ x IN t) /\ (!x. x IN t ==> ~P x)
3526     ==> {x | x IN s /\ P x} = s DIFF t`) THEN
3527   REWRITE_TAC[FORALL_IN_UNIONS] THEN
3528   REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN
3529   CONJ_TAC THENL
3530    [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
3531     REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN
3532     REWRITE_TAC[LEFT_AND_EXISTS_THM; TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN
3533     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
3534     ASM_REWRITE_TAC[UNWIND_THM2; IN_ELIM_THM; IN_INTER] THEN
3535     MATCH_MP_TAC(SET_RULE
3536      `(!x. P x ==> Q x \/ R x) ==> (!x. P x ==> Q x) \/ (?x. P x /\ R x)`) THEN
3537     X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN
3538     REWRITE_TAC[GSYM REAL_LE_LT] THEN
3539     SUBGOAL_THEN `(x:real^N) IN INTERS f` MP_TAC THENL
3540      [ASM SET_TAC[]; ALL_TAC] THEN
3541     REWRITE_TAC[IN_INTERS] THEN
3542     DISCH_THEN(MP_TAC o SPEC `h:real^N->bool`) THEN
3543     SUBGOAL_THEN `h = {x:real^N | a h dot x <= b h}` MP_TAC THENL
3544      [ASM_MESON_TAC[]; ASM_REWRITE_TAC[] THEN SET_TAC[]];
3545     X_GEN_TAC `h:real^N->bool` THEN
3546     DISCH_THEN(X_CHOOSE_THEN `g:real^N->bool` STRIP_ASSUME_TAC) THEN
3547     X_GEN_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
3548     ASM_MESON_TAC[REAL_LT_REFL]]);;
3549
3550 let RELATIVE_BOUNDARY_OF_POLYHEDRON = prove
3551  (`!s:real^N->bool.
3552         polyhedron s
3553         ==> s DIFF relative_interior s = UNIONS {f | f facet_of s}`,
3554   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_OF_POLYHEDRON] THEN
3555   MATCH_MP_TAC(SET_RULE `f SUBSET s ==> s DIFF (s DIFF f) = f`) THEN
3556   REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IN_ELIM_THM] THEN
3557   MESON_TAC[FACET_OF_IMP_SUBSET; SUBSET]);;
3558
3559 let RELATIVE_FRONTIER_OF_POLYHEDRON = prove
3560  (`!s:real^N->bool.
3561         polyhedron s ==> relative_frontier s = UNIONS {f | f facet_of s}`,
3562   SIMP_TAC[relative_frontier; POLYHEDRON_IMP_CLOSED; CLOSURE_CLOSED] THEN
3563   REWRITE_TAC[RELATIVE_BOUNDARY_OF_POLYHEDRON]);;
3564
3565 let RELATIVE_FRONTIER_OF_POLYHEDRON_ALT = prove
3566  (`!s:real^N->bool.
3567         polyhedron s
3568         ==> relative_frontier s = UNIONS {f | f face_of s /\ ~(f = s)}`,
3569   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
3570    [ASM_SIMP_TAC[RELATIVE_FRONTIER_OF_POLYHEDRON; facet_of] THEN
3571     MATCH_MP_TAC SUBSET_UNIONS THEN SIMP_TAC[SUBSET; IN_ELIM_THM] THEN
3572     MESON_TAC[INT_ARITH `~(f - &1:int = f)`];
3573     REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IN_ELIM_THM] THEN
3574     MESON_TAC[REWRITE_RULE[SUBSET] FACE_OF_SUBSET_RELATIVE_FRONTIER]]);;
3575
3576 let FACETS_OF_POLYHEDRON_EXPLICIT_DISTINCT = prove
3577  (`!s:real^N->bool f a b.
3578         FINITE f /\
3579         s = affine hull s INTER INTERS f /\
3580         (!h. h IN f ==> ~(a h = vec 0) /\ h = {x | a h dot x <= b h}) /\
3581         (!f'. f' PSUBSET f ==> s PSUBSET affine hull s INTER INTERS f')
3582         ==> !h1 h2. h1 IN f /\ h2 IN f /\
3583                     s INTER {x | a h1 dot x = b h1} =
3584                     s INTER {x | a h2 dot x = b h2}
3585                     ==> h1 = h2`,
3586   REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
3587    [ASM_REWRITE_TAC[AFFINE_HULL_EMPTY; INTER_EMPTY; PSUBSET_IRREFL] THEN
3588     ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN
3589     ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
3590     ASM_MESON_TAC[SET_RULE `~(s = {}) ==> {} PSUBSET s`];
3591     STRIP_TAC] THEN
3592   SUBGOAL_THEN `polyhedron(s:real^N->bool)` ASSUME_TAC THENL
3593    [REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN
3594     REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[];
3595     ALL_TAC] THEN
3596   SUBGOAL_THEN `~(relative_interior s:real^N->bool = {})` MP_TAC THENL
3597    [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY; POLYHEDRON_IMP_CONVEX];
3598     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
3599     DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC)] THEN
3600   DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
3601   MP_TAC(ISPECL
3602     [`s:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`;
3603      `b:(real^N->bool)->real`] RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN
3604   ANTS_TAC THENL
3605    [ASM_SIMP_TAC[] THEN ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN
3606   REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
3607   MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
3608   FIRST_ASSUM(MP_TAC o SPEC `f DELETE (h2:real^N->bool)`) THEN
3609   ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[PSUBSET_ALT]] THEN
3610   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `x:real^N` MP_TAC)) THEN
3611   REWRITE_TAC[IN_INTER; IN_INTERS; IN_DELETE] THEN STRIP_TAC THEN
3612   MP_TAC(ISPECL [`segment[x:real^N,z]`; `s:real^N->bool`]
3613         CONNECTED_INTER_RELATIVE_FRONTIER) THEN
3614   PURE_REWRITE_TAC[relative_frontier] THEN ANTS_TAC THENL
3615    [REWRITE_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY] THEN
3616     REPEAT CONJ_TAC THENL
3617      [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; AFFINE_AFFINE_HULL;
3618                     HULL_INC; AFFINE_IMP_CONVEX];
3619       EXISTS_TAC `z:real^N` THEN ASM_REWRITE_TAC[IN_INTER; ENDS_IN_SEGMENT];
3620       EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_DIFF; ENDS_IN_SEGMENT]];
3621     ALL_TAC] THEN
3622   PURE_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
3623   ASM_SIMP_TAC[POLYHEDRON_IMP_CLOSED; CLOSURE_CLOSED;
3624          LEFT_IMP_EXISTS_THM; IN_INTER] THEN
3625   X_GEN_TAC `y:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3626   DISCH_THEN(fun th -> STRIP_ASSUME_TAC(REWRITE_RULE[IN_DIFF] th) THEN
3627         MP_TAC th) THEN
3628   ASM_SIMP_TAC[RELATIVE_BOUNDARY_OF_POLYHEDRON] THEN
3629   MP_TAC(ISPECL
3630     [`s:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`;
3631      `b:(real^N->bool)->real`] FACET_OF_POLYHEDRON_EXPLICIT) THEN
3632   ANTS_TAC THENL
3633    [ASM_SIMP_TAC[] THEN ASM_MESON_TAC[];
3634     DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th])] THEN
3635   REWRITE_TAC[SET_RULE `{y | ?x. x IN s /\ y = f x} = IMAGE f s`] THEN
3636   REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_INTER] THEN
3637   DISCH_THEN(X_CHOOSE_THEN `h:real^N->bool` STRIP_ASSUME_TAC) THEN
3638   SUBGOAL_THEN
3639    `?k:real^N->bool. k IN f /\ ~(k = h2) /\ a k dot (y:real^N) = b k`
3640   STRIP_ASSUME_TAC THENL
3641    [ASM_CASES_TAC `h:real^N->bool = h2` THENL
3642      [EXISTS_TAC `h1:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
3643       UNDISCH_TAC `s INTER {x:real^N | a(h1:real^N->bool) dot x = b h1} =
3644                    s INTER {x | a h2 dot x = b h2}` THEN
3645       REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN ASM_MESON_TAC[];
3646       ASM_MESON_TAC[]];
3647     ALL_TAC] THEN
3648   SUBGOAL_THEN
3649    `(a:(real^N->bool)->real^N) k dot z < b k /\ a k dot x <= b k`
3650   STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN
3651   SUBGOAL_THEN `y IN segment(x:real^N,z)` MP_TAC THENL
3652    [ASM_REWRITE_TAC[IN_OPEN_SEGMENT_ALT] THEN ASM_MESON_TAC[];
3653     REWRITE_TAC[IN_SEGMENT] THEN STRIP_TAC] THEN
3654   UNDISCH_TAC `(a:(real^N->bool)->real^N) k dot y = b k` THEN
3655   ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN
3656   MATCH_MP_TAC(REAL_ARITH
3657    `(&1 - u) * x <= (&1 - u) * b /\ u * y < u * b
3658     ==> ~((&1 - u) * x + u * y = b)`) THEN
3659   ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LE_LMUL_EQ; REAL_SUB_LT]);;
3660
3661 (* ------------------------------------------------------------------------- *)
3662 (* A characterization of polyhedra as having finitely many faces.            *)
3663 (* ------------------------------------------------------------------------- *)
3664
3665 let POLYHEDRON_EQ_FINITE_EXPOSED_FACES = prove
3666  (`!s:real^N->bool.
3667     polyhedron s <=> closed s /\ convex s /\ FINITE {f | f exposed_face_of s}`,
3668   GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
3669   ASM_SIMP_TAC[POLYHEDRON_IMP_CLOSED; POLYHEDRON_IMP_CONVEX;
3670                FINITE_POLYHEDRON_EXPOSED_FACES] THEN
3671   ASM_CASES_TAC `s:real^N->bool = {}` THEN
3672   ASM_REWRITE_TAC[POLYHEDRON_EMPTY] THEN
3673   ABBREV_TAC
3674    `f = {h:real^N->bool | h exposed_face_of s /\ ~(h = {}) /\ ~(h = s)}` THEN
3675   SUBGOAL_THEN `FINITE(f:(real^N->bool)->bool)` ASSUME_TAC THENL
3676    [EXPAND_TAC "f" THEN
3677     ONCE_REWRITE_TAC[SET_RULE
3678      `{x | P x /\ Q x} = {x | x IN {x | P x} /\ Q x}`] THEN
3679     ASM_SIMP_TAC[FINITE_RESTRICT];
3680     ALL_TAC] THEN
3681   SUBGOAL_THEN
3682    `!h:real^N->bool.
3683         h IN f
3684         ==> h face_of s /\
3685             ?a b. ~(a = vec 0) /\
3686                   s SUBSET {x | a dot x <= b} /\
3687                   h = s INTER {x | a dot x = b}`
3688   MP_TAC THENL
3689    [EXPAND_TAC "f" THEN REWRITE_TAC[EXPOSED_FACE_OF; IN_ELIM_THM] THEN
3690     MESON_TAC[];
3691     ALL_TAC] THEN
3692   REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; FORALL_AND_THM;
3693               TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN
3694   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3695   DISCH_THEN(X_CHOOSE_THEN `a:(real^N->bool)->real^N` MP_TAC) THEN
3696   DISCH_THEN(X_CHOOSE_THEN `b:(real^N->bool)->real` STRIP_ASSUME_TAC) THEN
3697   SUBGOAL_THEN
3698    `s = affine hull s INTER
3699         INTERS {{x:real^N | a(h:real^N->bool) dot x <= b h} | h IN f}`
3700   SUBST1_TAC THENL
3701    [ALL_TAC;
3702     MATCH_MP_TAC POLYHEDRON_INTER THEN REWRITE_TAC[POLYHEDRON_AFFINE_HULL] THEN
3703     MATCH_MP_TAC POLYHEDRON_INTERS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
3704     ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; POLYHEDRON_HALFSPACE_LE]] THEN
3705   MATCH_MP_TAC SUBSET_ANTISYM THEN
3706   REWRITE_TAC[SUBSET_INTER; HULL_SUBSET;
3707               SET_RULE `s SUBSET INTERS f <=> !h. h IN f ==> s SUBSET h`] THEN
3708   ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN
3709   REWRITE_TAC[SUBSET; IN_INTER; IN_INTERS; FORALL_IN_GSPEC] THEN
3710   X_GEN_TAC `p:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN
3711   MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
3712   SUBGOAL_THEN `~(relative_interior(s:real^N->bool) = {})` MP_TAC THENL
3713    [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY];
3714     GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN
3715     DISCH_THEN(X_CHOOSE_TAC `c:real^N`)] THEN
3716   SUBGOAL_THEN
3717    `?x:real^N. x IN segment[c,p] /\ x IN (s DIFF relative_interior s)`
3718   MP_TAC THENL
3719    [MP_TAC(ISPEC `segment[c:real^N,p]` CONNECTED_OPEN_IN) THEN
3720     REWRITE_TAC[CONNECTED_SEGMENT; NOT_EXISTS_THM] THEN
3721     DISCH_THEN(MP_TAC o SPECL
3722      [`segment[c:real^N,p] INTER relative_interior s`;
3723       `segment[c:real^N,p] INTER (UNIV DIFF s)`]) THEN
3724     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
3725     REWRITE_TAC[IN_DIFF; NOT_EXISTS_THM] THEN DISCH_TAC THEN
3726     REPEAT CONJ_TAC THENL
3727      [MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
3728       EXISTS_TAC `affine hull s:real^N->bool` THEN
3729       SIMP_TAC[OPEN_IN_RELATIVE_INTERIOR; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY;
3730         OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; OPEN_IN_INTER;
3731         TOPSPACE_EUCLIDEAN] THEN
3732       REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
3733       SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL] THEN
3734       ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
3735       ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; HULL_INC; SUBSET];
3736       REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC `(:real^N) DIFF s` THEN
3737       ASM_REWRITE_TAC[GSYM closed];
3738      MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN ASM SET_TAC[];
3739      MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN SET_TAC[];
3740       REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
3741       ASM_MESON_TAC[ENDS_IN_SEGMENT];
3742       REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_DIFF; IN_INTER; IN_UNIV] THEN
3743       ASM_MESON_TAC[ENDS_IN_SEGMENT]];
3744     REWRITE_TAC[IN_SEGMENT; LEFT_AND_EXISTS_THM] THEN
3745     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
3746     REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN
3747     DISCH_THEN(X_CHOOSE_THEN `l:real` MP_TAC) THEN
3748     ASM_CASES_TAC `l = &0` THEN
3749     ASM_REWRITE_TAC[VECTOR_ADD_RID; VECTOR_MUL_LZERO; REAL_SUB_RZERO;
3750                     VECTOR_MUL_LID; IN_DIFF] THEN
3751     ASM_CASES_TAC `l = &1` THEN
3752     ASM_REWRITE_TAC[VECTOR_ADD_LID; VECTOR_MUL_LZERO; REAL_SUB_REFL;
3753                     VECTOR_MUL_LID; IN_DIFF] THEN
3754     ASM_REWRITE_TAC[REAL_LE_LT] THEN STRIP_TAC] THEN
3755   ABBREV_TAC `x:real^N = (&1 - l) % c + l % p` THEN
3756   SUBGOAL_THEN `?h:real^N->bool. h IN f /\ x IN h` STRIP_ASSUME_TAC THENL
3757    [MP_TAC(ISPECL [`s:real^N->bool`; `(&1 - l) % c + l % p:real^N`]
3758       SUPPORTING_HYPERPLANE_RELATIVE_FRONTIER) THEN
3759     ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN
3760     DISCH_THEN(X_CHOOSE_THEN `d:real^N` STRIP_ASSUME_TAC) THEN
3761     EXPAND_TAC "f" THEN
3762     EXISTS_TAC `s INTER {y:real^N | d dot y = d dot x}` THEN
3763     ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL
3764      [MATCH_MP_TAC EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE THEN
3765       ASM_SIMP_TAC[real_ge; REWRITE_RULE[SUBSET] CLOSURE_SUBSET];
3766       ASM SET_TAC[];
3767       REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN
3768       DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN
3769       ASM_MESON_TAC[SUBSET; REAL_LT_REFL; RELATIVE_INTERIOR_SUBSET]];
3770     ALL_TAC] THEN
3771   SUBGOAL_THEN `{y:real^N | a(h:real^N->bool) dot y = b h} face_of
3772                 {y | a h dot y <= b h}`
3773   MP_TAC THENL
3774    [MATCH_MP_TAC(MESON[]
3775      `(t INTER s) face_of t /\ t INTER s = s ==> s face_of t`) THEN
3776     CONJ_TAC THENL
3777      [MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN
3778       REWRITE_TAC[IN_ELIM_THM; CONVEX_HALFSPACE_LE];
3779       SET_TAC[REAL_LE_REFL]];
3780     ALL_TAC] THEN
3781   REWRITE_TAC[face_of] THEN
3782   DISCH_THEN(MP_TAC o SPECL [`c:real^N`; `p:real^N`; `x:real^N`] o
3783         CONJUNCT2 o CONJUNCT2) THEN
3784   ASM_SIMP_TAC[IN_ELIM_THM; NOT_IMP; GSYM CONJ_ASSOC] THEN
3785   FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET]
3786       RELATIVE_INTERIOR_SUBSET)) THEN
3787   REPEAT CONJ_TAC THENL
3788    [ASM SET_TAC[];
3789     ASM SET_TAC[];
3790     REWRITE_TAC[IN_SEGMENT] THEN ASM SET_TAC[];
3791     STRIP_TAC] THEN
3792   MP_TAC(ISPECL [`s:real^N->bool`; `h:real^N->bool`; `s:real^N->bool`]
3793         SUBSET_OF_FACE_OF) THEN
3794   ASM SET_TAC[]);;
3795
3796 let POLYHEDRON_EQ_FINITE_FACES = prove
3797  (`!s:real^N->bool.
3798         polyhedron s <=>
3799         closed s /\ convex s /\ FINITE {f | f face_of s}`,
3800   GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
3801   ASM_SIMP_TAC[POLYHEDRON_IMP_CLOSED; POLYHEDRON_IMP_CONVEX;
3802                FINITE_POLYHEDRON_FACES] THEN
3803   REWRITE_TAC[POLYHEDRON_EQ_FINITE_EXPOSED_FACES] THEN
3804   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FINITE_SUBSET THEN
3805   EXISTS_TAC `{f:real^N->bool | f face_of s}` THEN
3806   ASM_REWRITE_TAC[] THEN
3807   SIMP_TAC[SUBSET; IN_ELIM_THM; exposed_face_of]);;
3808
3809 let POLYHEDRON_TRANSLATION_EQ = prove
3810  (`!a s. polyhedron (IMAGE (\x:real^N. a + x) s) <=> polyhedron s`,
3811   REPEAT STRIP_TAC THEN REWRITE_TAC[POLYHEDRON_EQ_FINITE_FACES] THEN
3812   REWRITE_TAC[CLOSED_TRANSLATION_EQ] THEN AP_TERM_TAC THEN
3813   REWRITE_TAC[CONVEX_TRANSLATION_EQ] THEN AP_TERM_TAC THEN
3814   MP_TAC(ISPEC `IMAGE (\x:real^N. a + x)` QUANTIFY_SURJECTION_THM) THEN
3815   REWRITE_TAC[SURJECTIVE_IMAGE; EXISTS_REFL;
3816     VECTOR_ARITH `a + x:real^N = y <=> x = y - a`] THEN
3817   DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN
3818   REWRITE_TAC[FACE_OF_TRANSLATION_EQ] THEN
3819   MATCH_MP_TAC FINITE_IMAGE_INJ_EQ THEN
3820   MATCH_MP_TAC(MESON[]
3821    `(!x y. Q x y ==> R x y) ==> (!x y. P x /\ P y /\ Q x y ==> R x y)`) THEN
3822   REWRITE_TAC[INJECTIVE_IMAGE] THEN VECTOR_ARITH_TAC);;
3823
3824 add_translation_invariants [POLYHEDRON_TRANSLATION_EQ];;
3825
3826 let POLYHEDRON_LINEAR_IMAGE_EQ = prove
3827  (`!f:real^M->real^N s.
3828         linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
3829         ==> (polyhedron (IMAGE f s) <=> polyhedron s)`,
3830   REPEAT STRIP_TAC THEN REWRITE_TAC[POLYHEDRON_EQ_FINITE_FACES] THEN
3831   BINOP_TAC THENL
3832    [ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE_EQ]; ALL_TAC] THEN
3833   BINOP_TAC THENL [ASM_MESON_TAC[CONVEX_LINEAR_IMAGE_EQ]; ALL_TAC] THEN
3834   MP_TAC(ISPEC `IMAGE (f:real^M->real^N)` QUANTIFY_SURJECTION_THM) THEN
3835   ASM_REWRITE_TAC[SURJECTIVE_IMAGE] THEN
3836   DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN
3837   MP_TAC(ISPEC `f:real^M->real^N` FACE_OF_LINEAR_IMAGE) THEN
3838   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
3839   MATCH_MP_TAC FINITE_IMAGE_INJ_EQ THEN
3840   FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [GSYM INJECTIVE_IMAGE]) THEN
3841   ASM_REWRITE_TAC[IMP_CONJ]);;
3842
3843 add_linear_invariants [POLYHEDRON_LINEAR_IMAGE_EQ];;
3844
3845 let POLYHEDRON_NEGATIONS = prove
3846  (`!s:real^N->bool. polyhedron s ==> polyhedron(IMAGE (--) s)`,
3847   GEN_TAC THEN MATCH_MP_TAC EQ_IMP THEN CONV_TAC SYM_CONV THEN
3848   MATCH_MP_TAC POLYHEDRON_LINEAR_IMAGE_EQ THEN
3849   REWRITE_TAC[VECTOR_ARITH `--x:real^N = y <=> x = --y`; EXISTS_REFL] THEN
3850   REWRITE_TAC[LINEAR_NEGATION] THEN VECTOR_ARITH_TAC);;
3851
3852 (* ------------------------------------------------------------------------- *)
3853 (* Relation between polytopes and polyhedra.                                 *)
3854 (* ------------------------------------------------------------------------- *)
3855
3856 let POLYTOPE_EQ_BOUNDED_POLYHEDRON = prove
3857  (`!s:real^N->bool. polytope s <=> polyhedron s /\ bounded s`,
3858   GEN_TAC THEN EQ_TAC THENL
3859    [SIMP_TAC[FINITE_POLYTOPE_FACES; POLYHEDRON_EQ_FINITE_FACES;
3860              POLYTOPE_IMP_CLOSED; POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_BOUNDED];
3861     STRIP_TAC THEN REWRITE_TAC[polytope] THEN
3862     EXISTS_TAC `{v:real^N | v extreme_point_of s}` THEN
3863     ASM_SIMP_TAC[FINITE_POLYHEDRON_EXTREME_POINTS] THEN
3864     MATCH_MP_TAC KREIN_MILMAN_MINKOWSKI THEN
3865     ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; POLYHEDRON_IMP_CLOSED;
3866                  POLYHEDRON_IMP_CONVEX]]);;
3867
3868 let POLYTOPE_INTER = prove
3869  (`!s t. polytope s /\ polytope t ==> polytope(s INTER t)`,
3870   SIMP_TAC[POLYTOPE_EQ_BOUNDED_POLYHEDRON; POLYHEDRON_INTER; BOUNDED_INTER]);;
3871
3872 let POLYTOPE_INTER_POLYHEDRON = prove
3873  (`!s t:real^N->bool. polytope s /\ polyhedron t ==> polytope(s INTER t)`,
3874   SIMP_TAC[POLYTOPE_EQ_BOUNDED_POLYHEDRON; POLYHEDRON_INTER] THEN
3875   MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET]);;
3876
3877 let POLYHEDRON_INTER_POLYTOPE = prove
3878  (`!s t:real^N->bool. polyhedron s /\ polytope t ==> polytope(s INTER t)`,
3879   SIMP_TAC[POLYTOPE_EQ_BOUNDED_POLYHEDRON; POLYHEDRON_INTER] THEN
3880   MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET]);;
3881
3882 let POLYTOPE_IMP_POLYHEDRON = prove
3883  (`!p. polytope p ==> polyhedron p`,
3884   SIMP_TAC[POLYTOPE_EQ_BOUNDED_POLYHEDRON]);;
3885
3886 let POLYTOPE_FACET_EXISTS = prove
3887  (`!p:real^N->bool. polytope p /\ &0 < aff_dim p ==> ?f. f facet_of p`,
3888   GEN_TAC THEN ASM_CASES_TAC `p:real^N->bool = {}` THEN
3889   ASM_REWRITE_TAC[AFF_DIM_EMPTY] THEN CONV_TAC INT_REDUCE_CONV THEN
3890   STRIP_TAC THEN
3891   MP_TAC(ISPEC `p:real^N->bool` EXTREME_POINT_EXISTS_CONVEX) THEN
3892   ASM_SIMP_TAC[POLYTOPE_IMP_COMPACT; POLYTOPE_IMP_CONVEX] THEN
3893   DISCH_THEN(X_CHOOSE_TAC `v:real^N`) THEN
3894   MP_TAC(ISPECL [`p:real^N->bool`; `{v:real^N}`]
3895     FACE_OF_POLYHEDRON_SUBSET_FACET) THEN
3896   ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
3897   ASM_SIMP_TAC[POLYTOPE_IMP_POLYHEDRON; FACE_OF_SING; NOT_INSERT_EMPTY] THEN
3898   ASM_MESON_TAC[AFF_DIM_SING; INT_LT_REFL]);;
3899
3900 let POLYHEDRON_INTERVAL = prove
3901  (`!a b. polyhedron(interval[a,b])`,
3902   MESON_TAC[POLYTOPE_IMP_POLYHEDRON; POLYTOPE_INTERVAL]);;
3903
3904 let POLYHEDRON_CONVEX_HULL = prove
3905  (`!s. FINITE s ==> polyhedron(convex hull s)`,
3906   SIMP_TAC[POLYTOPE_CONVEX_HULL; POLYTOPE_IMP_POLYHEDRON]);;
3907
3908 (* ------------------------------------------------------------------------- *)
3909 (* Polytope is union of convex hulls of facets plus any point inside.        *)
3910 (* ------------------------------------------------------------------------- *)
3911
3912 let POLYTOPE_UNION_CONVEX_HULL_FACETS = prove
3913  (`!s p:real^N->bool.
3914         polytope p /\ &0 < aff_dim p /\ ~(s = {}) /\ s SUBSET p
3915         ==> p = UNIONS { convex hull (s UNION f) | f facet_of p}`,
3916   let lemma = SET_RULE `{f x | p x} = {y | ?x. p x /\ y = f x}` in
3917   MATCH_MP_TAC SET_PROVE_CASES THEN REWRITE_TAC[] THEN
3918   X_GEN_TAC `a:real^N` THEN ONCE_REWRITE_TAC[lemma] THEN
3919   GEOM_ORIGIN_TAC `a:real^N` THEN ONCE_REWRITE_TAC[GSYM lemma] THEN
3920   X_GEN_TAC `s:real^N->bool` THEN DISCH_THEN(K ALL_TAC) THEN
3921   MP_TAC(SET_RULE `(vec 0:real^N) IN (vec 0 INSERT s)`) THEN
3922   SPEC_TAC(`(vec 0:real^N) INSERT s`,`s:real^N->bool`) THEN
3923   X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN
3924   X_GEN_TAC `p:real^N->bool` THEN STRIP_TAC THEN
3925   FIRST_ASSUM(STRIP_ASSUME_TAC o
3926    GEN_REWRITE_RULE I [POLYTOPE_EQ_BOUNDED_POLYHEDRON]) THEN
3927   MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
3928    [ALL_TAC;
3929     REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IMP_CONJ] THEN
3930     REWRITE_TAC[FORALL_IN_GSPEC; RIGHT_FORALL_IMP_THM] THEN
3931     X_GEN_TAC `f:real^N->bool` THEN DISCH_TAC THEN
3932     REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN
3933     EXISTS_TAC `convex hull p:real^N->bool` THEN CONJ_TAC THENL
3934      [MATCH_MP_TAC HULL_MONO THEN
3935       FIRST_ASSUM(MP_TAC o MATCH_MP FACET_OF_IMP_SUBSET) THEN ASM SET_TAC[];
3936       ASM_MESON_TAC[CONVEX_HULL_EQ; POLYHEDRON_IMP_CONVEX; SUBSET_REFL]]] THEN
3937   REWRITE_TAC[SUBSET] THEN X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN
3938   ASM_CASES_TAC `v:real^N = vec 0` THENL
3939    [MP_TAC(ISPEC `p:real^N->bool` POLYTOPE_FACET_EXISTS) THEN
3940     ASM_REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC] THEN
3941     MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN
3942     ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[HULL_INC; IN_UNION];
3943     ALL_TAC] THEN
3944   SUBGOAL_THEN `?t. &1 < t /\ ~((t % v:real^N) IN p)` STRIP_ASSUME_TAC THENL
3945    [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
3946     DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
3947     EXISTS_TAC `max (&2) ((B + &1) / norm (v:real^N))` THEN
3948     CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN
3949     FIRST_X_ASSUM(MATCH_MP_TAC o
3950      GEN_REWRITE_RULE BINDER_CONV [GSYM CONTRAPOS_THM]) THEN
3951     ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LE_RDIV_EQ; NORM_POS_LT] THEN
3952     MATCH_MP_TAC(REAL_ARITH `a < b ==> ~(abs(max (&2) b) <= a)`) THEN
3953     ASM_SIMP_TAC[REAL_LT_DIV2_EQ; NORM_POS_LT] THEN REAL_ARITH_TAC;
3954     ALL_TAC] THEN
3955   SUBGOAL_THEN `(vec 0:real^N) IN p` ASSUME_TAC THENL
3956    [ASM SET_TAC[]; ALL_TAC] THEN
3957   MP_TAC(ISPECL [`segment[vec 0,t % v:real^N] INTER p`; `vec 0:real^N`]
3958         DISTANCE_ATTAINS_SUP) THEN
3959   ANTS_TAC THENL
3960    [ASM_SIMP_TAC[COMPACT_INTER_CLOSED; POLYHEDRON_IMP_CLOSED; COMPACT_SEGMENT;
3961                  GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
3962     ASM_MESON_TAC[ENDS_IN_SEGMENT];
3963     REWRITE_TAC[IN_INTER; GSYM CONJ_ASSOC; IMP_CONJ] THEN
3964     REWRITE_TAC[segment; FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN
3965     REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; DIST_0] THEN
3966     REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; NORM_MUL; REAL_MUL_ASSOC] THEN
3967     ASM_SIMP_TAC[REAL_LE_RMUL_EQ; NORM_POS_LT; LEFT_IMP_EXISTS_THM;
3968                  REAL_ARITH `&1 < t ==> &0 < abs t`] THEN
3969     X_GEN_TAC `u:real` THEN
3970     ASM_CASES_TAC `u = &1` THEN ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN
3971     REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
3972     ASM_SIMP_TAC[real_abs] THEN DISCH_TAC] THEN
3973   SUBGOAL_THEN `inv(t) <= u` ASSUME_TAC THENL
3974    [FIRST_X_ASSUM MATCH_MP_TAC THEN
3975     ASM_SIMP_TAC[REAL_INV_LE_1; REAL_LT_IMP_LE; REAL_LE_INV_EQ;
3976                  REAL_ARITH `&1 < t ==> &0 <= t`] THEN
3977     ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID;
3978                  REAL_ARITH `&1 < t ==> ~(t = &0)`];
3979     ALL_TAC] THEN
3980   FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_ARITH `&1 < t ==> &0 < t`)) THEN
3981   SUBGOAL_THEN `&0 < u /\ u < &1` STRIP_ASSUME_TAC THENL
3982    [ASM_REWRITE_TAC[REAL_LT_LE] THEN
3983     DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
3984     UNDISCH_TAC `inv t <= &0` THEN REWRITE_TAC[REAL_NOT_LE] THEN
3985     ASM_REWRITE_TAC[REAL_LT_INV_EQ];
3986     ALL_TAC] THEN
3987   MATCH_MP_TAC(SET_RULE `!t. t SUBSET s /\ x IN t ==> x IN s`) THEN
3988   EXISTS_TAC `convex hull {vec 0:real^N,u % t % v}` THEN CONJ_TAC THENL
3989    [ALL_TAC;
3990     REWRITE_TAC[CONVEX_HULL_2; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
3991     REWRITE_TAC[IN_ELIM_THM] THEN
3992     MAP_EVERY EXISTS_TAC [`&1 - inv(u * t)`; `inv(u * t):real`] THEN
3993     REWRITE_TAC[REAL_ARITH `&1 - x + x = &1`; REAL_SUB_LE; REAL_LE_INV_EQ] THEN
3994     ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; VECTOR_MUL_ASSOC] THEN
3995     ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_ENTIRE; REAL_MUL_LINV;
3996                  REAL_LT_IMP_NZ; VECTOR_MUL_LID] THEN
3997     MATCH_MP_TAC REAL_INV_LE_1 THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN
3998     ASM_REWRITE_TAC[real_div; REAL_MUL_LID]] THEN
3999   SUBGOAL_THEN
4000    `(u % t % v:real^N) IN (p DIFF relative_interior p)`
4001   MP_TAC THENL
4002    [ALL_TAC;
4003     ASM_SIMP_TAC[RELATIVE_INTERIOR_OF_POLYHEDRON] THEN
4004     DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
4005      `x IN s DIFF (s DIFF t) ==> x IN t`)) THEN
4006     REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC] THEN
4007     DISCH_THEN(X_CHOOSE_THEN `f:real^N->bool` STRIP_ASSUME_TAC) THEN
4008     MATCH_MP_TAC(SET_RULE
4009      `(?s. s IN f /\ t SUBSET s) ==> t SUBSET UNIONS f`) THEN
4010     REWRITE_TAC[EXISTS_IN_GSPEC] THEN EXISTS_TAC `f:real^N->bool` THEN
4011     ASM_SIMP_TAC[SUBSET_HULL; CONVEX_CONVEX_HULL] THEN
4012     ASM_SIMP_TAC[HULL_INC; IN_UNION; INSERT_SUBSET; EMPTY_SUBSET]] THEN
4013   ASM_REWRITE_TAC[IN_DIFF; IN_RELATIVE_INTERIOR] THEN
4014   DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4015   REWRITE_TAC[SUBSET; IN_BALL; IN_INTER; dist] THEN
4016   ABBREV_TAC `k = min (e / &2 / norm(t % v:real^N)) (&1 - u)` THEN
4017   SUBGOAL_THEN `&0 < k` ASSUME_TAC THENL
4018    [EXPAND_TAC "k" THEN REWRITE_TAC[REAL_LT_MIN] THEN
4019     ASM_REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_LT_DIV THEN
4020     ASM_SIMP_TAC[REAL_HALF; NORM_POS_LT; VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ];
4021     ALL_TAC] THEN
4022   DISCH_THEN(MP_TAC o SPEC `(u + k) % t % v:real^N`) THEN
4023   REWRITE_TAC[VECTOR_ARITH `u % x - (u + k) % x:real^N = --k % x`] THEN
4024   ONCE_REWRITE_TAC[NORM_MUL] THEN REWRITE_TAC[REAL_ABS_NEG; NOT_IMP] THEN
4025   REPEAT CONJ_TAC THENL
4026    [MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN
4027     ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_MUL_EQ_0;
4028                  REAL_LT_IMP_NZ] THEN
4029     ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN
4030     EXPAND_TAC "k" THEN REAL_ARITH_TAC;
4031     ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN
4032     REPEAT(MATCH_MP_TAC SPAN_MUL) THEN ASM_SIMP_TAC[SPAN_SUPERSET];
4033     DISCH_TAC THEN
4034     FIRST_X_ASSUM(MP_TAC o SPEC `u + k:real`) THEN
4035     ASM_REWRITE_TAC[NOT_IMP] THEN
4036     MATCH_MP_TAC(REAL_ARITH
4037      `&0 <= u /\ &0 < x /\ x <= &1 - u
4038       ==> (&0 <= u + x /\ u + x <= &1) /\ ~(u + x <= u)`) THEN
4039     ASM_REWRITE_TAC[] THEN EXPAND_TAC "k" THEN REAL_ARITH_TAC]);;
4040
4041 (* ------------------------------------------------------------------------- *)
4042 (* Finitely generated cone is polyhedral, and hence closed.                  *)
4043 (* ------------------------------------------------------------------------- *)
4044
4045 let POLYHEDRON_CONVEX_CONE_HULL = prove
4046  (`!s:real^N->bool. FINITE s ==> polyhedron(convex_cone hull s)`,
4047   GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN DISCH_TAC THENL
4048    [ASM_REWRITE_TAC[CONVEX_CONE_HULL_EMPTY] THEN
4049     ASM_SIMP_TAC[POLYTOPE_IMP_POLYHEDRON; POLYTOPE_SING];
4050     ALL_TAC] THEN
4051   SUBGOAL_THEN
4052     `polyhedron(convex hull ((vec 0:real^N) INSERT s))`
4053   MP_TAC THENL
4054    [MATCH_MP_TAC POLYTOPE_IMP_POLYHEDRON THEN
4055     REWRITE_TAC[polytope] THEN ASM_MESON_TAC[FINITE_INSERT];
4056     REWRITE_TAC[polyhedron] THEN
4057     DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
4058     RULE_ASSUM_TAC(REWRITE_RULE[SKOLEM_THM; RIGHT_IMP_EXISTS_THM]) THEN
4059     FIRST_X_ASSUM(X_CHOOSE_THEN `a:(real^N->bool)->real^N` MP_TAC) THEN
4060     DISCH_THEN(X_CHOOSE_TAC `b:(real^N->bool)->real`)] THEN
4061   SUBGOAL_THEN `~(f:(real^N->bool)->bool = {})` ASSUME_TAC THENL
4062    [DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o
4063      GEN_REWRITE_RULE RAND_CONV [INTERS_0]) THEN
4064     DISCH_THEN(MP_TAC o AP_TERM `bounded:(real^N->bool)->bool`) THEN
4065     ASM_SIMP_TAC[NOT_BOUNDED_UNIV; BOUNDED_CONVEX_HULL; FINITE_IMP_BOUNDED;
4066                  FINITE_INSERT; FINITE_EMPTY];
4067     ALL_TAC] THEN
4068   EXISTS_TAC `{h:real^N->bool | h IN f /\ b h = &0}` THEN
4069   ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM] THEN CONJ_TAC THENL
4070    [ALL_TAC;
4071     X_GEN_TAC `h:real^N->bool` THEN STRIP_TAC THEN
4072     FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN
4073     ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN
4074     MAP_EVERY EXISTS_TAC
4075      [`(a:(real^N->bool)->real^N) h`; `(b:(real^N->bool)->real) h`] THEN
4076     ASM_REWRITE_TAC[]] THEN
4077   MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
4078    [MATCH_MP_TAC HULL_MINIMAL THEN CONJ_TAC THENL
4079      [MATCH_MP_TAC SUBSET_TRANS THEN
4080       EXISTS_TAC `convex hull ((vec 0:real^N) INSERT s)` THEN CONJ_TAC THENL
4081        [SIMP_TAC[SUBSET; HULL_INC; IN_INSERT]; ASM_REWRITE_TAC[]] THEN
4082       MATCH_MP_TAC(SET_RULE `s SUBSET t ==> INTERS t SUBSET INTERS s`) THEN
4083       SET_TAC[];
4084       MATCH_MP_TAC CONVEX_CONE_INTERS THEN
4085       X_GEN_TAC `h:real^N->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN
4086       STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN
4087       ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o CONJUNCT2) THEN
4088       REWRITE_TAC[CONVEX_CONE_HALFSPACE_LE]];
4089     ALL_TAC] THEN
4090   REWRITE_TAC[SUBSET; IN_INTERS; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN
4091   DISCH_TAC THEN
4092   SUBGOAL_THEN `!h:real^N->bool. h IN f ==> ?t. &0 < t /\ (t % x) IN h`
4093   MP_TAC THENL
4094    [X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN
4095     ASM_CASES_TAC `(b:(real^N->bool)->real) h = &0` THENL
4096      [EXISTS_TAC `&1` THEN ASM_SIMP_TAC[REAL_LT_01; VECTOR_MUL_LID];
4097       ALL_TAC] THEN
4098     SUBGOAL_THEN `&0 < (b:(real^N->bool)->real) h` ASSUME_TAC THENL
4099      [ASM_REWRITE_TAC[REAL_LT_LE] THEN
4100       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN
4101       DISCH_THEN(MP_TAC o SPEC `vec 0:real^N`) THEN
4102       SIMP_TAC[HULL_INC; IN_INSERT; IN_INTERS] THEN
4103       DISCH_THEN(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
4104       SUBGOAL_THEN `h = {x:real^N | a h dot x <= b h}`
4105        (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th])
4106       THENL [ASM_MESON_TAC[]; REWRITE_TAC[IN_ELIM_THM; DOT_RZERO]];
4107       ALL_TAC] THEN
4108     SUBGOAL_THEN `(vec 0:real^N) IN interior h` MP_TAC THENL
4109      [SUBGOAL_THEN `h = {x:real^N | a h dot x <= b h}` SUBST1_TAC THENL
4110        [ASM_MESON_TAC[];
4111         ASM_SIMP_TAC[INTERIOR_HALFSPACE_LE; IN_ELIM_THM; DOT_RZERO]];
4112       REWRITE_TAC[IN_INTERIOR; SUBSET; IN_BALL_0; LEFT_IMP_EXISTS_THM] THEN
4113       X_GEN_TAC `e:real` THEN STRIP_TAC THEN
4114       ASM_CASES_TAC `x:real^N = vec 0` THENL
4115        [EXISTS_TAC `&1` THEN
4116         ASM_SIMP_TAC[VECTOR_MUL_RZERO; REAL_LT_01; NORM_0];
4117         EXISTS_TAC `e / &2 / norm(x:real^N)` THEN
4118         ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT] THEN
4119         FIRST_X_ASSUM MATCH_MP_TAC THEN
4120         REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_NORM] THEN
4121         ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN ASM_REAL_ARITH_TAC]];
4122     ALL_TAC] THEN
4123   REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
4124   X_GEN_TAC `t:(real^N->bool)->real` THEN DISCH_TAC THEN
4125   SUBGOAL_THEN `x:real^N = inv(inf(IMAGE t (f:(real^N->bool)->bool))) %
4126                            inf(IMAGE t f) % x`
4127   SUBST1_TAC THENL
4128    [GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_MUL_LID] THEN
4129     REWRITE_TAC[VECTOR_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
4130     CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MUL_LINV THEN
4131     MATCH_MP_TAC REAL_LT_IMP_NZ THEN
4132     ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN
4133     ASM_SIMP_TAC[FORALL_IN_IMAGE];
4134     ALL_TAC] THEN
4135   MATCH_MP_TAC(REWRITE_RULE[conic] CONIC_CONVEX_CONE_HULL) THEN
4136   ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LE_INF_FINITE; FINITE_IMAGE;
4137                IMAGE_EQ_EMPTY; REAL_LT_IMP_LE; FORALL_IN_IMAGE] THEN
4138   MATCH_MP_TAC(SET_RULE `!s t. s SUBSET t /\ x IN s ==> x IN t`) THEN
4139   EXISTS_TAC `convex hull ((vec 0:real^N) INSERT s)` THEN CONJ_TAC THENL
4140    [MATCH_MP_TAC HULL_MINIMAL THEN
4141     REWRITE_TAC[CONVEX_CONVEX_CONE_HULL] THEN
4142     ASM_SIMP_TAC[INSERT_SUBSET; HULL_SUBSET; CONVEX_CONE_HULL_CONTAINS_0];
4143     ASM_REWRITE_TAC[IN_INTERS] THEN X_GEN_TAC `h:real^N->bool` THEN
4144     DISCH_TAC THEN
4145     SUBGOAL_THEN `inf(IMAGE (t:(real^N->bool)->real) f) % x:real^N =
4146                   (&1 - inf(IMAGE t f) / t h) % vec 0 +
4147                   (inf(IMAGE t f) / t h) % t h % x`
4148     SUBST1_TAC THENL
4149      [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_RZERO; VECTOR_ADD_LID;
4150                    REAL_DIV_RMUL; REAL_LT_IMP_NZ];
4151       ALL_TAC] THEN
4152     MATCH_MP_TAC IN_CONVEX_SET THEN
4153     ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN
4154     REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN
4155     ASM_SIMP_TAC[REAL_INF_LE_FINITE; REAL_LE_INF_FINITE;
4156                  FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN
4157     ASM_REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN
4158     ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REPEAT CONJ_TAC THENL
4159      [SUBGOAL_THEN `h = {x:real^N | a h dot x <= b h}` SUBST1_TAC THENL
4160        [ASM_MESON_TAC[]; ASM_SIMP_TAC[CONVEX_HALFSPACE_LE]];
4161       SUBGOAL_THEN `(vec 0:real^N) IN convex hull (vec 0 INSERT s)` MP_TAC
4162       THENL [SIMP_TAC[HULL_INC; IN_INSERT]; ALL_TAC] THEN
4163       ASM_REWRITE_TAC[IN_INTERS] THEN ASM_MESON_TAC[];
4164       ASM SET_TAC[REAL_LE_REFL]]]);;
4165
4166 let CLOSED_CONVEX_CONE_HULL = prove
4167  (`!s:real^N->bool. FINITE s ==> closed(convex_cone hull s)`,
4168   MESON_TAC[POLYHEDRON_IMP_CLOSED; POLYHEDRON_CONVEX_CONE_HULL]);;
4169
4170 (* ------------------------------------------------------------------------- *)
4171 (* And conversely, a polyhedral cone is finitely generated.                  *)
4172 (* ------------------------------------------------------------------------- *)
4173
4174 let FINITELY_GENERATED_CONIC_POLYHEDRON = prove
4175  (`!s:real^N->bool.
4176         polyhedron s /\ conic s /\ ~(s = {})
4177         ==> ?c. FINITE c /\ s = convex_cone hull c`,
4178   REPEAT STRIP_TAC THEN
4179   SUBGOAL_THEN `?p:real^N->bool. polytope p /\ vec 0 IN interior p`
4180   STRIP_ASSUME_TAC THENL
4181    [EXISTS_TAC `interval[--vec 1:real^N,vec 1:real^N]` THEN
4182     REWRITE_TAC[POLYTOPE_INTERVAL; INTERIOR_CLOSED_INTERVAL] THEN
4183     SIMP_TAC[IN_INTERVAL; VECTOR_NEG_COMPONENT; VEC_COMPONENT] THEN
4184     CONV_TAC REAL_RAT_REDUCE_CONV;
4185     ALL_TAC] THEN
4186   SUBGOAL_THEN `polytope(s INTER p:real^N->bool)` MP_TAC THENL
4187    [REWRITE_TAC[POLYTOPE_EQ_BOUNDED_POLYHEDRON] THEN
4188     ASM_SIMP_TAC[BOUNDED_INTER; POLYTOPE_IMP_BOUNDED]THEN
4189     ASM_SIMP_TAC[POLYHEDRON_INTER; POLYTOPE_IMP_POLYHEDRON];
4190     REWRITE_TAC[polytope] THEN MATCH_MP_TAC MONO_EXISTS] THEN
4191   X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
4192   MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
4193    [ALL_TAC;
4194     ASM_SIMP_TAC[SUBSET_HULL; POLYHEDRON_IMP_CONVEX; convex_cone] THEN
4195     MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `s INTER p:real^N->bool` THEN
4196     REWRITE_TAC[INTER_SUBSET] THEN ASM_REWRITE_TAC[HULL_SUBSET]] THEN
4197   REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
4198   SUBGOAL_THEN `?t. &0 < t /\ (t % x:real^N) IN p` STRIP_ASSUME_TAC THENL
4199    [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR]) THEN
4200     REWRITE_TAC[SUBSET; IN_BALL_0; LEFT_IMP_EXISTS_THM] THEN
4201     X_GEN_TAC `e:real` THEN STRIP_TAC THEN
4202     ASM_CASES_TAC `x:real^N = vec 0` THENL
4203      [EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO; REAL_LT_01] THEN
4204       ASM_SIMP_TAC[NORM_0];
4205       EXISTS_TAC `e / &2 / norm(x:real^N)` THEN
4206       ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT] THEN
4207       FIRST_X_ASSUM MATCH_MP_TAC THEN
4208       REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_NUM] THEN
4209       ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN ASM_REAL_ARITH_TAC];
4210     ALL_TAC] THEN
4211   SUBGOAL_THEN `x:real^N = inv t % t % x` SUBST1_TAC THENL
4212    [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID;
4213                  REAL_LT_IMP_NZ];
4214     ALL_TAC] THEN
4215   MATCH_MP_TAC(REWRITE_RULE[conic] CONIC_CONVEX_CONE_HULL) THEN
4216   ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE] THEN
4217   MATCH_MP_TAC(SET_RULE `!s. x IN s /\ s SUBSET t ==> x IN t`) THEN
4218   EXISTS_TAC `convex hull c:real^N->bool` THEN
4219   REWRITE_TAC[CONVEX_HULL_SUBSET_CONVEX_CONE_HULL] THEN
4220   FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[IN_INTER] THEN
4221   FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [conic]) THEN
4222   ASM_SIMP_TAC[REAL_LT_IMP_LE]);;
4223
4224 (* ------------------------------------------------------------------------- *)
4225 (* Decomposition of polyhedron into cone plus polytope and more corollaries. *)
4226 (* ------------------------------------------------------------------------- *)
4227
4228 let POLYHEDRON_POLYTOPE_SUMS = prove
4229  (`!s t:real^N->bool.
4230     polyhedron s /\ polytope t ==> polyhedron {x + y | x IN s /\ y IN t}`,
4231   REPEAT STRIP_TAC THEN
4232   REWRITE_TAC[POLYHEDRON_EQ_FINITE_EXPOSED_FACES] THEN REPEAT CONJ_TAC THENL
4233    [MATCH_MP_TAC CLOSED_COMPACT_SUMS THEN
4234     ASM_SIMP_TAC[POLYHEDRON_IMP_CLOSED; POLYTOPE_IMP_COMPACT];
4235     MATCH_MP_TAC CONVEX_SUMS THEN
4236     ASM_SIMP_TAC[POLYHEDRON_IMP_CONVEX; POLYTOPE_IMP_CONVEX];
4237     MATCH_MP_TAC FINITE_SUBSET THEN
4238     EXISTS_TAC `{ {x + y:real^N | x IN k /\ y IN l} |
4239                   k exposed_face_of s /\ l exposed_face_of t}` THEN
4240     CONJ_TAC THENL
4241      [ONCE_REWRITE_TAC[SET_RULE `k exposed_face_of s <=>
4242                                  k IN {f | f exposed_face_of s}`] THEN
4243       MATCH_MP_TAC FINITE_PRODUCT_DEPENDENT THEN
4244       ASM_SIMP_TAC[FINITE_POLYHEDRON_EXPOSED_FACES;
4245                    POLYTOPE_IMP_POLYHEDRON];
4246       REWRITE_TAC[SUBSET; IN_ELIM_THM; GSYM CONJ_ASSOC] THEN
4247       REPEAT STRIP_TAC THEN MATCH_MP_TAC EXPOSED_FACE_OF_SUMS THEN
4248       ASM_SIMP_TAC[POLYHEDRON_IMP_CONVEX; POLYTOPE_IMP_CONVEX]]]);;
4249
4250 let POLYHEDRON_AS_CONE_PLUS_CONV = prove
4251  (`!s:real^N->bool.
4252         polyhedron s <=> ?t u. FINITE t /\ FINITE u /\
4253                                s = {x + y | x IN convex_cone hull t /\
4254                                             y IN convex hull u}`,
4255   REPEAT GEN_TAC THEN EQ_TAC THENL
4256    [REWRITE_TAC[polyhedron; LEFT_IMP_EXISTS_THM];
4257     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
4258     MATCH_MP_TAC POLYHEDRON_POLYTOPE_SUMS THEN
4259     ASM_SIMP_TAC[POLYTOPE_CONVEX_HULL; POLYHEDRON_CONVEX_CONE_HULL]] THEN
4260   REWRITE_TAC[polyhedron; LEFT_IMP_EXISTS_THM] THEN
4261   X_GEN_TAC `f:(real^N->bool)->bool` THEN
4262   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
4263   DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) MP_TAC) THEN
4264   GEN_REWRITE_TAC (LAND_CONV o REDEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
4265   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC
4266    [`a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] THEN
4267   ONCE_REWRITE_TAC[MESON[] `h = {x | P x} <=> {x | P x} = h`] THEN
4268   DISCH_TAC THEN
4269   ABBREV_TAC
4270    `s':real^(N,1)finite_sum->bool =
4271         {x | &0 <= drop(sndcart x) /\
4272              !h:real^N->bool.
4273                 h IN f ==> a h dot (fstcart x) <= b h * drop(sndcart x)}` THEN
4274   SUBGOAL_THEN
4275    `?t u. FINITE t /\ FINITE u /\
4276           (!y:real^(N,1)finite_sum. y IN t ==> drop(sndcart y) = &0) /\
4277           (!y. y IN u ==> drop(sndcart y) = &1) /\
4278           s' = convex_cone hull (t UNION u)`
4279   STRIP_ASSUME_TAC THENL
4280    [MP_TAC(ISPEC `s':real^(N,1)finite_sum->bool`
4281         FINITELY_GENERATED_CONIC_POLYHEDRON) THEN
4282     ANTS_TAC THENL
4283      [EXPAND_TAC "s'" THEN REPEAT CONJ_TAC THENL
4284        [REWRITE_TAC[polyhedron] THEN
4285         EXISTS_TAC
4286          `{ x:real^(N,1)finite_sum |
4287             pastecart (vec 0) (--vec 1) dot x <= &0} INSERT
4288           { {x | pastecart (a h) (--lift(b h)) dot x <= &0} |
4289             (h:real^N->bool) IN f}` THEN
4290         REWRITE_TAC[FINITE_INSERT; INTERS_INSERT; SIMPLE_IMAGE] THEN
4291         ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_INSERT; FORALL_IN_IMAGE] THEN
4292         REPEAT CONJ_TAC THENL
4293          [EXPAND_TAC "s'" THEN
4294           REWRITE_TAC[EXTENSION; IN_ELIM_THM; FORALL_PASTECART; IN_INTER;
4295            DOT_PASTECART; INTERS_IMAGE; FSTCART_PASTECART;
4296            SNDCART_PASTECART; DOT_1; GSYM drop; DROP_NEG; LIFT_DROP] THEN
4297           REWRITE_TAC[DROP_VEC; DOT_LZERO; REAL_MUL_LNEG; GSYM real_sub] THEN
4298           REWRITE_TAC[REAL_MUL_LID; REAL_ARITH `x - y <= &0 <=> x <= y`];
4299           EXISTS_TAC `pastecart (vec 0) (--vec 1):real^(N,1)finite_sum` THEN
4300           EXISTS_TAC `&0` THEN
4301           REWRITE_TAC[PASTECART_EQ_VEC; VECTOR_NEG_EQ_0; VEC_EQ] THEN
4302           ARITH_TAC;
4303           X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC
4304            [`pastecart (a(h:real^N->bool)) (--lift(b h)):real^(N,1)finite_sum`;
4305             `&0`] THEN
4306           ASM_SIMP_TAC[PASTECART_EQ_VEC]];
4307         REWRITE_TAC[conic; IN_ELIM_THM; FSTCART_CMUL; SNDCART_CMUL] THEN
4308         SIMP_TAC[DROP_CMUL; DOT_RMUL; REAL_LE_MUL] THEN
4309         MESON_TAC[REAL_LE_LMUL; REAL_MUL_AC];
4310         REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
4311         EXISTS_TAC `vec 0:real^(N,1)finite_sum` THEN
4312         REWRITE_TAC[IN_ELIM_THM; FSTCART_VEC; SNDCART_VEC] THEN
4313         REWRITE_TAC[DROP_VEC; DOT_RZERO; REAL_LE_REFL; REAL_MUL_RZERO]];
4314       DISCH_THEN(X_CHOOSE_THEN `c:real^(N,1)finite_sum->bool`
4315         STRIP_ASSUME_TAC) THEN
4316       MAP_EVERY EXISTS_TAC
4317        [`{x:real^(N,1)finite_sum | x IN c /\ drop(sndcart x) = &0}`;
4318         `IMAGE (\x. inv(drop(sndcart x)) % x)
4319            {x:real^(N,1)finite_sum | x IN c /\ ~(drop(sndcart x) = &0)}`] THEN
4320       ASM_SIMP_TAC[FINITE_IMAGE; FINITE_RESTRICT; FORALL_IN_IMAGE] THEN
4321       SIMP_TAC[IN_ELIM_THM; SNDCART_CMUL; DROP_CMUL; REAL_MUL_LINV] THEN
4322       SUBGOAL_THEN
4323        `!x:real^(N,1)finite_sum. x IN c ==> &0 <= drop(sndcart x)`
4324       ASSUME_TAC THENL
4325        [GEN_TAC THEN DISCH_TAC THEN
4326         SUBGOAL_THEN `(x:real^(N,1)finite_sum) IN s'` MP_TAC THENL
4327          [ASM_MESON_TAC[HULL_INC]; EXPAND_TAC "s'"] THEN
4328         SIMP_TAC[IN_ELIM_THM];
4329         ALL_TAC] THEN
4330       MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN
4331       MATCH_MP_TAC HULL_MINIMAL THEN
4332       REWRITE_TAC[CONVEX_CONE_CONVEX_CONE_HULL; UNION_SUBSET] THEN
4333       SIMP_TAC[SUBSET; IN_ELIM_THM; HULL_INC; FORALL_IN_IMAGE] THEN
4334       X_GEN_TAC `x:real^(N,1)finite_sum` THEN DISCH_TAC THEN
4335       FIRST_X_ASSUM(MP_TAC o SPEC `x:real^(N,1)finite_sum`) THEN
4336       ASM_SIMP_TAC[CONVEX_CONE_HULL_MUL; HULL_INC; REAL_LE_INV_EQ] THEN
4337       ASM_REWRITE_TAC[REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN
4338       STRIP_TAC THENL
4339        [MATCH_MP_TAC HULL_INC THEN ASM_REWRITE_TAC[IN_UNION; IN_ELIM_THM];
4340         SUBGOAL_THEN
4341          `x:real^(N,1)finite_sum =
4342                 drop(sndcart x) % inv(drop(sndcart x)) % x`
4343         SUBST1_TAC THENL
4344          [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN
4345           REWRITE_TAC[VECTOR_MUL_LID];
4346           MATCH_MP_TAC CONVEX_CONE_HULL_MUL THEN
4347           ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC HULL_INC THEN
4348           REWRITE_TAC[IN_UNION] THEN DISJ2_TAC THEN
4349           REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `x:real^(N,1)finite_sum` THEN
4350           ASM_SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_NZ]]]];
4351     EXISTS_TAC `IMAGE fstcart (t:real^(N,1)finite_sum->bool)` THEN
4352     EXISTS_TAC `IMAGE fstcart (u:real^(N,1)finite_sum->bool)` THEN
4353     ASM_SIMP_TAC[FINITE_IMAGE] THEN
4354     SUBGOAL_THEN `s = {x:real^N | pastecart x (vec 1:real^1) IN s'}`
4355     SUBST1_TAC THENL
4356      [MAP_EVERY EXPAND_TAC ["s"; "s'"] THEN
4357       REWRITE_TAC[IN_ELIM_THM; SNDCART_PASTECART; DROP_VEC; REAL_POS] THEN
4358       GEN_REWRITE_TAC I [EXTENSION] THEN
4359       REWRITE_TAC[FSTCART_PASTECART; IN_ELIM_THM; IN_INTERS; REAL_MUL_RID] THEN
4360       ASM SET_TAC[];
4361       ASM_REWRITE_TAC[CONVEX_CONE_HULL_UNION]] THEN
4362     REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `z:real^N` THEN
4363     SIMP_TAC[CONVEX_CONE_HULL_LINEAR_IMAGE; CONVEX_HULL_LINEAR_IMAGE;
4364              LINEAR_FSTCART] THEN
4365     REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN
4366     REWRITE_TAC[EXISTS_IN_IMAGE] THEN
4367     AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN
4368     X_GEN_TAC `a:real^(N,1)finite_sum` THEN REWRITE_TAC[] THEN
4369     MATCH_MP_TAC(TAUT `(p ==> (q <=> r)) ==> (p /\ q <=> p /\ r)`) THEN
4370     DISCH_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN
4371     X_GEN_TAC `b:real^(N,1)finite_sum` THEN REWRITE_TAC[PASTECART_EQ] THEN
4372     REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; FSTCART_ADD;
4373                 SNDCART_ADD] THEN
4374     ASM_CASES_TAC `fstcart(a:real^(N,1)finite_sum) +
4375                    fstcart(b:real^(N,1)finite_sum) = z` THEN
4376     ASM_REWRITE_TAC[] THEN
4377     SUBGOAL_THEN `sndcart(a:real^(N,1)finite_sum) = vec 0` SUBST1_TAC THENL
4378      [UNDISCH_TAC `(a:real^(N,1)finite_sum) IN convex_cone hull t` THEN
4379       SPEC_TAC(`a:real^(N,1)finite_sum`,`a:real^(N,1)finite_sum`) THEN
4380       MATCH_MP_TAC HULL_INDUCT THEN ASM_SIMP_TAC[GSYM DROP_EQ; DROP_VEC] THEN
4381       REWRITE_TAC[convex_cone; convex; conic; IN_ELIM_THM] THEN
4382       SIMP_TAC[SNDCART_ADD; SNDCART_CMUL; DROP_ADD; DROP_CMUL] THEN
4383       REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID; GSYM MEMBER_NOT_EMPTY] THEN
4384       EXISTS_TAC `vec 0:real^(N,1)finite_sum` THEN
4385       REWRITE_TAC[IN_ELIM_THM; SNDCART_VEC; DROP_VEC];
4386       REWRITE_TAC[VECTOR_ADD_LID]] THEN
4387     ASM_CASES_TAC `u:real^(N,1)finite_sum->bool = {}` THENL
4388      [ASM_REWRITE_TAC[CONVEX_CONE_HULL_EMPTY; CONVEX_HULL_EMPTY] THEN
4389       REWRITE_TAC[IN_SING; NOT_IN_EMPTY] THEN
4390       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
4391       ASM_REWRITE_TAC[SNDCART_VEC; VEC_EQ] THEN ARITH_TAC;
4392       ALL_TAC] THEN
4393     ASM_SIMP_TAC[CONVEX_CONE_HULL_CONVEX_HULL_NONEMPTY; IN_ELIM_THM] THEN
4394     SUBGOAL_THEN
4395      `!y:real^(N,1)finite_sum. y IN convex hull u ==> sndcart y = vec 1`
4396      (LABEL_TAC "*")
4397     THENL
4398      [MATCH_MP_TAC HULL_INDUCT THEN ASM_SIMP_TAC[GSYM DROP_EQ; DROP_VEC] THEN
4399       REWRITE_TAC[convex; IN_ELIM_THM] THEN
4400       SIMP_TAC[SNDCART_ADD; SNDCART_CMUL; DROP_ADD; DROP_CMUL] THEN
4401       SIMP_TAC[REAL_MUL_RID];
4402       ALL_TAC] THEN
4403     EQ_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THENL
4404      [MAP_EVERY X_GEN_TAC [`c:real`; `d:real^(N,1)finite_sum`] THEN
4405       DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
4406       ASM_SIMP_TAC[SNDCART_CMUL; VECTOR_MUL_EQ_0; VECTOR_ARITH
4407        `x:real^N = c % x <=> (c - &1) % x = vec 0`] THEN
4408       ASM_SIMP_TAC[REAL_SUB_0; VEC_EQ; ARITH_EQ; VECTOR_MUL_LID];
4409       DISCH_TAC THEN ASM_SIMP_TAC[] THEN EXISTS_TAC `&1` THEN
4410       ASM_REWRITE_TAC[REAL_POS; VECTOR_MUL_LID] THEN ASM_MESON_TAC[]]]);;
4411
4412 let POLYHEDRON_LINEAR_IMAGE = prove
4413  (`!f:real^M->real^N s.
4414         linear f /\ polyhedron s ==> polyhedron(IMAGE f s)`,
4415   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
4416   REWRITE_TAC[POLYHEDRON_AS_CONE_PLUS_CONV; LEFT_IMP_EXISTS_THM] THEN
4417   MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `u:real^M->bool`] THEN STRIP_TAC THEN
4418   EXISTS_TAC `IMAGE (f:real^M->real^N) t` THEN
4419   EXISTS_TAC `IMAGE (f:real^M->real^N) u` THEN
4420   ASM_SIMP_TAC[FINITE_IMAGE] THEN
4421   ASM_SIMP_TAC[CONVEX_CONE_HULL_LINEAR_IMAGE; CONVEX_HULL_LINEAR_IMAGE] THEN
4422   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN
4423   FIRST_X_ASSUM(MP_TAC o MATCH_MP LINEAR_ADD) THEN MESON_TAC[]);;
4424
4425 let POLYHEDRON_SUMS = prove
4426  (`!s t:real^N->bool.
4427     polyhedron s /\ polyhedron t ==> polyhedron {x + y | x IN s /\ y IN t}`,
4428   REPEAT GEN_TAC THEN REWRITE_TAC[POLYHEDRON_AS_CONE_PLUS_CONV] THEN
4429   REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
4430   REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
4431   MAP_EVERY X_GEN_TAC
4432    [`t1:real^N->bool`; `u1:real^N->bool`;
4433     `t2:real^N->bool`; `u2:real^N->bool`] THEN
4434   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
4435   EXISTS_TAC `t1 UNION t2:real^N->bool` THEN
4436   EXISTS_TAC `{u + v:real^N | u IN u1 /\ v IN u2}` THEN
4437   REWRITE_TAC[CONVEX_CONE_HULL_UNION; CONVEX_HULL_SUMS] THEN
4438   ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT; FINITE_UNION] THEN
4439   REWRITE_TAC[SET_RULE
4440    `{h x y | x IN {f a b | P a /\ Q b} /\
4441              y IN {g a b | R a /\ S b}} =
4442     {h (f a b) (g c d) | P a /\ Q b /\ R c /\ S d}`] THEN
4443   REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_AC]);;
4444
4445 let POLYHEDRAL_CONVEX_CONE = prove
4446  (`!s:real^N->bool.
4447         polyhedron s /\ convex_cone s <=>
4448         ?k. FINITE k /\ s = convex_cone hull k`,
4449   GEN_TAC THEN EQ_TAC THENL
4450    [ALL_TAC; MESON_TAC[POLYHEDRON_CONVEX_CONE_HULL;
4451                        CONVEX_CONE_CONVEX_CONE_HULL]] THEN
4452   STRIP_TAC THEN
4453   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_AS_CONE_PLUS_CONV]) THEN
4454   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
4455   MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `c:real^N->bool`] THEN
4456   ASM_CASES_TAC `c:real^N->bool = {}` THENL
4457    [ASM_REWRITE_TAC[CONVEX_HULL_EMPTY; NOT_IN_EMPTY] THEN
4458     REWRITE_TAC[SET_RULE `{f x y | x,y | F} = {}`] THEN
4459     ASM_MESON_TAC[CONVEX_CONE_NONEMPTY];
4460     DISCH_THEN(STRIP_ASSUME_TAC o GSYM)] THEN
4461   EXISTS_TAC `k UNION c:real^N->bool` THEN
4462   ASM_REWRITE_TAC[FINITE_UNION] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
4463   CONJ_TAC THENL
4464    [EXPAND_TAC "s" THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN
4465     REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVEX_CONE_HULL_ADD THEN
4466     CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
4467      `x IN s ==> s SUBSET t ==> x IN t`)) THEN
4468     MESON_TAC[HULL_MONO; SUBSET_UNION; SUBSET_TRANS;
4469         CONVEX_HULL_SUBSET_CONVEX_CONE_HULL];
4470     MATCH_MP_TAC HULL_MINIMAL THEN
4471     CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]]] THEN
4472   REWRITE_TAC[UNION_SUBSET] THEN REWRITE_TAC[SUBSET] THEN
4473   CONJ_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THENL
4474    [ALL_TAC;
4475     EXPAND_TAC "s" THEN REWRITE_TAC[IN_ELIM_THM] THEN
4476     MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `x:real^N`] THEN
4477     ASM_SIMP_TAC[HULL_INC; VECTOR_ADD_LID; CONVEX_CONE_HULL_CONTAINS_0]] THEN
4478   FIRST_ASSUM(MP_TAC o MATCH_MP POLYHEDRON_IMP_CLOSED) THEN
4479   DISCH_THEN(MP_TAC o MATCH_MP CLOSED_APPROACHABLE) THEN
4480   DISCH_THEN(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN
4481   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
4482   DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN
4483   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
4484   EXISTS_TAC `e / (norm y + &1) % ((norm y + &1) / e % x + y):real^N` THEN
4485   CONJ_TAC THENL
4486    [MATCH_MP_TAC CONVEX_CONE_MUL THEN
4487     ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_ADD; NORM_POS_LE; REAL_POS;
4488                  REAL_LT_IMP_LE] THEN
4489     EXPAND_TAC "s" THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC
4490      [`(norm(y:real^N) + &1) / e % x:real^N`; `y:real^N`] THEN
4491     ASM_SIMP_TAC[HULL_INC] THEN MATCH_MP_TAC CONVEX_CONE_HULL_MUL THEN
4492     ASM_SIMP_TAC[HULL_INC] THEN MATCH_MP_TAC REAL_LE_DIV THEN
4493     ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN CONV_TAC NORM_ARITH;
4494     REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN
4495     ASM_SIMP_TAC[NORM_POS_LE; VECTOR_MUL_LID; REAL_FIELD
4496      `&0 <= y /\ &0 < e ==> e / (y + &1) * (y + &1) / e = &1`] THEN
4497     REWRITE_TAC[NORM_ARITH `dist(x + e:real^N,x) = norm e`] THEN
4498     REWRITE_TAC[NORM_MUL; REAL_ABS_DIV] THEN
4499     MATCH_MP_TAC(REAL_ARITH
4500      `&0 < e /\ e * z / y < e * &1 ==> abs e / y * z < e`) THEN
4501     ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LT_LDIV_EQ;
4502                  NORM_ARITH `&0 < abs(norm(y:real^N) + &1)`] THEN
4503     REAL_ARITH_TAC]);;
4504
4505 (* ------------------------------------------------------------------------- *)
4506 (* Farkas's lemma (2 variants) and stronger separation for polyhedra.        *)
4507 (* ------------------------------------------------------------------------- *)
4508
4509 let FARKAS_LEMMA = prove
4510  (`!A:real^N^M b.
4511         (?x:real^N.
4512             A ** x = b /\
4513             (!i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i)) <=>
4514         ~(?y:real^M.
4515             b dot y < &0 /\
4516             (!i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= (transp A ** y)$i))`,
4517   REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT
4518    `(q ==> ~p) /\ (~p ==> q) ==> (p <=> ~q)`) THEN
4519   CONJ_TAC THENL
4520    [REPEAT STRIP_TAC THEN
4521     SUBGOAL_THEN `y dot ((A:real^N^M) ** x - b) = &0` MP_TAC THENL
4522      [ASM_REWRITE_TAC[VECTOR_SUB_REFL; DOT_RZERO]; ALL_TAC] THEN
4523     RULE_ASSUM_TAC(ONCE_REWRITE_RULE[DOT_SYM]) THEN
4524     REWRITE_TAC[DOT_RSUB; REAL_SUB_0] THEN
4525     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
4526      `y < &0 ==> &0 <= x ==> ~(x = y)`)) THEN
4527     ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN
4528     REWRITE_TAC[VECTOR_MATRIX_MUL_TRANSP; dot] THEN
4529     MATCH_MP_TAC SUM_POS_LE THEN
4530     ASM_SIMP_TAC[REAL_LE_MUL; IN_NUMSEG; FINITE_NUMSEG];
4531     DISCH_TAC THEN MP_TAC(ISPECL
4532      [`{(A:real^N^M) ** (x:real^N) |
4533         !i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i}`;
4534       `b:real^M`] SEPARATING_HYPERPLANE_CLOSED_POINT) THEN
4535     REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL
4536      [REWRITE_TAC[IN_ELIM_THM; CONJ_ASSOC] THEN
4537       CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
4538       ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
4539       SIMP_TAC[CONVEX_POSITIVE_ORTHANT; CONVEX_LINEAR_IMAGE;
4540                MATRIX_VECTOR_MUL_LINEAR] THEN
4541       MATCH_MP_TAC POLYHEDRON_IMP_CLOSED THEN
4542       MATCH_MP_TAC POLYHEDRON_LINEAR_IMAGE THEN
4543       REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; POLYHEDRON_POSITIVE_ORTHANT];
4544       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^M` THEN
4545       DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN
4546       ONCE_REWRITE_TAC[DOT_SYM] THEN
4547       FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N`) THEN
4548       REWRITE_TAC[MATRIX_VECTOR_MUL_RZERO; DOT_RZERO] THEN
4549       REWRITE_TAC[real_gt; VEC_COMPONENT; REAL_LE_REFL] THEN
4550       DISCH_TAC THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
4551       X_GEN_TAC `k:num` THEN STRIP_TAC THEN
4552       ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
4553       FIRST_X_ASSUM(MP_TAC o SPEC
4554        `c / (transp(A:real^N^M) ** (y:real^M))$k % basis k:real^N`) THEN
4555       ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN
4556       ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN
4557       ASM_SIMP_TAC[DOT_RMUL; DOT_BASIS; VECTOR_MATRIX_MUL_TRANSP] THEN
4558       ASM_SIMP_TAC[REAL_FIELD `y < &0 ==> x / y * y = x`] THEN
4559       REWRITE_TAC[REAL_LT_REFL; real_gt] THEN
4560       GEN_TAC THEN COND_CASES_TAC THEN
4561       ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_LE_REFL; REAL_MUL_RID] THEN
4562       ONCE_REWRITE_TAC[REAL_ARITH `x / y:real = --x * -- inv y`] THEN
4563       MATCH_MP_TAC REAL_LE_MUL THEN
4564       REWRITE_TAC[REAL_ARITH `&0 <= --x <=> ~(&0 < x)`; REAL_LT_INV_EQ] THEN
4565       ASM_REAL_ARITH_TAC]]);;
4566
4567 let FARKAS_LEMMA_ALT = prove
4568  (`!A:real^N^M b.
4569         (?x:real^N.
4570             (!i. 1 <= i /\ i <= dimindex(:M) ==> (A ** x)$i <= b$i)) <=>
4571         ~(?y:real^M.
4572             (!i. 1 <= i /\ i <= dimindex(:M) ==> &0 <= y$i) /\
4573             y ** A = vec 0 /\ b dot y < &0)`,
4574   REPEAT GEN_TAC THEN
4575   MATCH_MP_TAC(TAUT `~(p /\ q) /\ (~p ==> q) ==> (p <=> ~q)`) THEN
4576   REPEAT STRIP_TAC THENL
4577    [SUBGOAL_THEN `&0 <= (b - (A:real^N^M) ** x) dot y` MP_TAC THENL
4578      [REWRITE_TAC[dot] THEN MATCH_MP_TAC SUM_POS_LE THEN
4579       REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
4580       REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN
4581       ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; REAL_SUB_LE];
4582       REWRITE_TAC[DOT_LSUB; REAL_SUB_LE] THEN REWRITE_TAC[REAL_NOT_LE] THEN
4583       GEN_REWRITE_TAC RAND_CONV [DOT_SYM] THEN
4584       REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN
4585       ASM_REWRITE_TAC[DOT_LZERO]];
4586     MP_TAC(ISPECL
4587      [`{(A:real^N^M) ** (x:real^N) + s |x,s|
4588         !i. 1 <= i /\ i <= dimindex(:M) ==> &0 <= s$i}`;
4589       `b:real^M`] SEPARATING_HYPERPLANE_CLOSED_POINT) THEN
4590     REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL
4591      [REWRITE_TAC[IN_ELIM_THM; CONJ_ASSOC] THEN CONJ_TAC THENL
4592        [ONCE_REWRITE_TAC[SET_RULE
4593          `{f x + y | x,y | P y} =
4594           {z + y | z,y | z IN IMAGE (f:real^M->real^N) (:real^M) /\
4595                          y IN {w | P w}}`] THEN
4596         SIMP_TAC[CONVEX_SUMS; CONVEX_POSITIVE_ORTHANT; CONVEX_LINEAR_IMAGE;
4597                  MATRIX_VECTOR_MUL_LINEAR; CONVEX_UNIV] THEN
4598         MATCH_MP_TAC POLYHEDRON_IMP_CLOSED THEN
4599         MATCH_MP_TAC POLYHEDRON_SUMS THEN
4600         ASM_SIMP_TAC[POLYHEDRON_LINEAR_IMAGE; POLYHEDRON_UNIV;
4601           MATRIX_VECTOR_MUL_LINEAR; POLYHEDRON_POSITIVE_ORTHANT];
4602         POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN
4603         MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN
4604         ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; REAL_LE_ADDR]];
4605       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^M` THEN
4606       DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN
4607       ONCE_REWRITE_TAC[DOT_SYM] THEN
4608       FIRST_ASSUM(MP_TAC o SPECL [`vec 0:real^N`; `vec 0:real^M`]) THEN
4609       REWRITE_TAC[MATRIX_VECTOR_MUL_RZERO; VECTOR_ADD_RID; DOT_RZERO] THEN
4610       REWRITE_TAC[real_gt; VEC_COMPONENT; REAL_LE_REFL] THEN
4611       DISCH_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN
4612       CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN CONJ_TAC THENL
4613        [X_GEN_TAC `k:num` THEN STRIP_TAC THEN
4614         ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
4615         FIRST_X_ASSUM(MP_TAC o SPECL
4616          [`vec 0:real^N`; `--c / --((y:real^M)$k) % basis k:real^M`]) THEN
4617         ASM_SIMP_TAC[MATRIX_VECTOR_MUL_RZERO; VECTOR_ADD_LID;
4618                      DOT_RMUL; DOT_BASIS; REAL_FIELD
4619                       `y < &0 ==> c / --y * y = --c`] THEN
4620         SIMP_TAC[REAL_NEG_NEG; REAL_LT_REFL; VECTOR_MUL_COMPONENT; real_gt] THEN
4621         ASM_SIMP_TAC[BASIS_COMPONENT] THEN REPEAT STRIP_TAC THEN
4622         COND_CASES_TAC THEN
4623         ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID; REAL_LE_REFL] THEN
4624         MATCH_MP_TAC REAL_LE_DIV THEN ASM_REAL_ARITH_TAC;
4625         FIRST_X_ASSUM(MP_TAC o SPECL
4626          [`c / norm((y:real^M) ** (A:real^N^M)) pow 2 %
4627            (transp A ** y)`; `vec 0:real^M`]) THEN
4628         SIMP_TAC[VEC_COMPONENT; REAL_LE_REFL; VECTOR_ADD_RID] THEN
4629         ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN
4630         REWRITE_TAC[GSYM VECTOR_MATRIX_MUL_TRANSP; DOT_RMUL] THEN
4631         ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
4632         ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_POW_2; DOT_EQ_0] THEN
4633         REAL_ARITH_TAC]]]);;
4634
4635 let SEPARATING_HYPERPLANE_POLYHEDRA = prove
4636  (`!s t:real^N->bool.
4637         polyhedron s /\ polyhedron t /\ ~(s = {}) /\ ~(t = {}) /\ DISJOINT s t
4638         ==> ?a b. ~(a = vec 0) /\
4639                   (!x. x IN s ==> a dot x < b) /\
4640                   (!x. x IN t ==> a dot x > b)`,
4641   REPEAT STRIP_TAC THEN
4642   MP_TAC(ISPEC `{x + y:real^N | x IN s /\ y IN IMAGE (--) t}`
4643         SEPARATING_HYPERPLANE_CLOSED_0) THEN
4644   ANTS_TAC THENL
4645    [ASM_SIMP_TAC[CONVEX_SUMS; CONVEX_NEGATIONS; POLYHEDRON_IMP_CONVEX] THEN
4646     CONJ_TAC THENL
4647      [MATCH_MP_TAC POLYHEDRON_IMP_CLOSED THEN
4648       MATCH_MP_TAC POLYHEDRON_SUMS THEN ASM_SIMP_TAC[POLYHEDRON_NEGATIONS];
4649       REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN
4650       REWRITE_TAC[VECTOR_ARITH `y = --x:real^N <=> --y = x`] THEN
4651       REWRITE_TAC[UNWIND_THM1] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
4652       REWRITE_TAC[VECTOR_ARITH `vec 0:real^N = x + y <=> y = --x`] THEN
4653       REWRITE_TAC[UNWIND_THM2; VECTOR_NEG_NEG] THEN ASM SET_TAC[]];
4654     REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
4655     REWRITE_TAC[FORALL_IN_IMAGE; GSYM VECTOR_SUB; LEFT_IMP_EXISTS_THM] THEN
4656     MAP_EVERY X_GEN_TAC [`a:real^N`; `k:real`] THEN
4657     REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; DOT_RSUB] THEN STRIP_TAC THEN
4658     EXISTS_TAC `--a:real^N` THEN ASM_REWRITE_TAC[VECTOR_NEG_EQ_0] THEN
4659     MP_TAC(ISPEC `IMAGE (\x:real^N. a dot x) s` INF) THEN
4660     MP_TAC(ISPEC `IMAGE (\x:real^N. a dot x) t` SUP) THEN
4661     ASM_REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN
4662     MAP_EVERY ABBREV_TAC
4663      [`u = inf(IMAGE (\x:real^N. a dot x) s)`;
4664       `v = sup(IMAGE (\x:real^N. a dot x) t)`] THEN
4665     ANTS_TAC THENL
4666      [MP_TAC(GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]
4667         (ASSUME `~(s:real^N->bool = {})`)) THEN
4668       DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN
4669       EXISTS_TAC `a dot (z:real^N) - k` THEN
4670       X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
4671       FIRST_X_ASSUM(MP_TAC o SPECL [`z:real^N`; `x:real^N`]) THEN
4672       ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
4673       STRIP_TAC] THEN
4674     ANTS_TAC THENL
4675      [MP_TAC(GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]
4676         (ASSUME `~(t:real^N->bool = {})`)) THEN
4677       DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN
4678       EXISTS_TAC `a dot (z:real^N) + k` THEN
4679       X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
4680       FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `z:real^N`]) THEN
4681       ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
4682       STRIP_TAC] THEN
4683     SUBGOAL_THEN `k <= u - v` ASSUME_TAC THENL
4684      [REWRITE_TAC[REAL_LE_SUB_LADD] THEN EXPAND_TAC "u" THEN
4685       MATCH_MP_TAC REAL_LE_INF THEN
4686       ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN
4687       GEN_TAC THEN DISCH_TAC THEN
4688       ONCE_REWRITE_TAC[REAL_ARITH `k + v <= u <=> v <= u - k`] THEN
4689       EXPAND_TAC "v" THEN MATCH_MP_TAC REAL_SUP_LE THEN
4690       ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN
4691       ASM_MESON_TAC[REAL_ARITH `x - y > k ==> y <= x - k`];
4692       EXISTS_TAC `--((u + v) / &2)` THEN REWRITE_TAC[real_gt] THEN
4693       REWRITE_TAC[DOT_LNEG; REAL_LT_NEG2] THEN REPEAT STRIP_TAC THENL
4694        [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `u:real`;
4695         MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `v:real`] THEN
4696       ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC]]);;
4697
4698 (* ------------------------------------------------------------------------- *)
4699 (* Relative and absolute frontier of a polytope.                             *)
4700 (* ------------------------------------------------------------------------- *)
4701
4702 let RELATIVE_BOUNDARY_OF_CONVEX_HULL = prove
4703  (`!s:real^N->bool.
4704         ~affine_dependent s
4705         ==> (convex hull s) DIFF relative_interior(convex hull s) =
4706             UNIONS { convex hull (s DELETE a) | a | a IN s}`,
4707   REPEAT STRIP_TAC THEN
4708   FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN
4709   REPEAT_TCL DISJ_CASES_THEN MP_TAC (ARITH_RULE
4710     `CARD(s:real^N->bool) = 0 \/ CARD s = 1 \/ 2 <= CARD s`)
4711   THENL
4712    [ASM_SIMP_TAC[CARD_EQ_0; CONVEX_HULL_EMPTY] THEN SET_TAC[];
4713     DISCH_TAC THEN MP_TAC(HAS_SIZE_CONV `(s:real^N->bool) HAS_SIZE 1`) THEN
4714     ASM_SIMP_TAC[HAS_SIZE; LEFT_IMP_EXISTS_THM; CONVEX_HULL_SING] THEN
4715     REWRITE_TAC[RELATIVE_INTERIOR_SING; DIFF_EQ_EMPTY] THEN
4716     REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[EMPTY_UNIONS] THEN
4717     REWRITE_TAC[FORALL_IN_GSPEC; IN_SING; FORALL_UNWIND_THM2] THEN
4718     REWRITE_TAC[CONVEX_HULL_EQ_EMPTY] THEN SET_TAC[];
4719     DISCH_TAC THEN
4720     ASM_SIMP_TAC[POLYHEDRON_CONVEX_HULL; RELATIVE_BOUNDARY_OF_POLYHEDRON] THEN
4721     ASM_SIMP_TAC[FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT_ALT] THEN
4722     SET_TAC[]]);;
4723
4724 let RELATIVE_FRONTIER_OF_CONVEX_HULL = prove
4725  (`!s:real^N->bool.
4726         ~affine_dependent s
4727         ==> relative_frontier(convex hull s) =
4728             UNIONS { convex hull (s DELETE a) | a | a IN s}`,
4729   REPEAT STRIP_TAC THEN
4730   FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN
4731   ASM_SIMP_TAC[relative_frontier; GSYM RELATIVE_BOUNDARY_OF_CONVEX_HULL] THEN
4732   AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC CLOSURE_CLOSED THEN
4733   ASM_SIMP_TAC[COMPACT_IMP_CLOSED; FINITE_IMP_COMPACT; COMPACT_CONVEX_HULL]);;
4734
4735 let FRONTIER_OF_CONVEX_HULL = prove
4736  (`!s:real^N->bool.
4737         s HAS_SIZE (dimindex(:N) + 1)
4738         ==> frontier(convex hull s) =
4739                UNIONS { convex hull (s DELETE a) | a | a IN s}`,
4740   REWRITE_TAC[HAS_SIZE] THEN REPEAT STRIP_TAC THEN
4741   ASM_CASES_TAC `affine_dependent(s:real^N->bool)` THENL
4742    [REWRITE_TAC[frontier] THEN MATCH_MP_TAC EQ_TRANS THEN
4743     EXISTS_TAC `(convex hull s:real^N->bool) DIFF {}` THEN CONJ_TAC THENL
4744      [BINOP_TAC THEN
4745       ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_EQ_EMPTY; frontier; HAS_SIZE] THEN
4746       MATCH_MP_TAC CLOSURE_CLOSED THEN
4747       ASM_SIMP_TAC[CLOSURE_CLOSED; COMPACT_IMP_CLOSED; COMPACT_CONVEX_HULL;
4748                    FINITE_IMP_COMPACT; FINITE_INSERT; FINITE_EMPTY];
4749       REWRITE_TAC[DIFF_EMPTY] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
4750       CONJ_TAC THENL
4751        [GEN_REWRITE_TAC LAND_CONV [CARATHEODORY_AFF_DIM] THEN
4752         ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
4753         GEN_REWRITE_TAC I [SUBSET] THEN
4754         REWRITE_TAC[IN_ELIM_THM; UNIONS_IMAGE] THEN
4755         X_GEN_TAC `x:real^N` THEN
4756         DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
4757         MP_TAC(ISPEC `s:real^N->bool` AFFINE_INDEPENDENT_IFF_CARD) THEN
4758         ASM_REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN
4759         REWRITE_TAC[INT_ARITH `(x + &1) - &1:int = x`] THEN DISCH_TAC THEN
4760         SUBGOAL_THEN `(t:real^N->bool) PSUBSET s` ASSUME_TAC THENL
4761          [ASM_REWRITE_TAC[PSUBSET] THEN
4762           DISCH_THEN(MP_TAC o AP_TERM `CARD:(real^N->bool)->num`) THEN
4763           MATCH_MP_TAC(ARITH_RULE `t:num < s ==> t = s ==> F`) THEN
4764           ASM_REWRITE_TAC[ARITH_RULE `x < n + 1 <=> x <= n`] THEN
4765           REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN MATCH_MP_TAC INT_LE_TRANS THEN
4766           EXISTS_TAC `aff_dim(s:real^N->bool) + &1` THEN
4767           ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(INT_ARITH
4768            `s:int <= n /\ ~(s = n) ==> s + &1 <= n`) THEN
4769           ASM_REWRITE_TAC[AFF_DIM_LE_UNIV];
4770           SUBGOAL_THEN `?a:real^N. a IN s /\ ~(a IN t)` MP_TAC THENL
4771            [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
4772           X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
4773           SUBGOAL_THEN
4774            `(convex hull t) SUBSET convex hull (s DELETE (a:real^N))`
4775           MP_TAC THENL
4776            [MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]; ASM SET_TAC[]]];
4777         ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[UNIONS_IMAGE] THEN
4778         REWRITE_TAC[SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
4779         ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
4780         REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; GSYM SUBSET] THEN
4781         REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]]];
4782     MATCH_MP_TAC EQ_TRANS THEN
4783     EXISTS_TAC
4784      `(convex hull s) DIFF relative_interior(convex hull s):real^N->bool` THEN
4785     CONJ_TAC THENL
4786      [ASM_SIMP_TAC[GSYM RELATIVE_BOUNDARY_OF_CONVEX_HULL; frontier] THEN
4787       BINOP_TAC THENL
4788        [MATCH_MP_TAC CLOSURE_CLOSED THEN
4789         ASM_SIMP_TAC[CLOSURE_CLOSED; COMPACT_IMP_CLOSED; COMPACT_CONVEX_HULL;
4790                      FINITE_IMP_COMPACT; FINITE_INSERT; FINITE_EMPTY];
4791         CONV_TAC SYM_CONV THEN MATCH_MP_TAC RELATIVE_INTERIOR_INTERIOR THEN
4792         REWRITE_TAC[AFFINE_HULL_CONVEX_HULL] THEN
4793         REWRITE_TAC[GSYM AFF_DIM_EQ_FULL] THEN
4794         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
4795           [AFFINE_INDEPENDENT_IFF_CARD]) THEN
4796         ASM_REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN INT_ARITH_TAC];
4797       ASM_SIMP_TAC[RELATIVE_BOUNDARY_OF_POLYHEDRON;
4798                    POLYHEDRON_CONVEX_HULL; FINITE_INSERT; FINITE_EMPTY] THEN
4799       ASM_SIMP_TAC[FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT_ALT] THEN
4800       REWRITE_TAC[ARITH_RULE `2 <= n + 1 <=> 1 <= n`; DIMINDEX_GE_1] THEN
4801       ASM SET_TAC[]]]);;
4802
4803 (* ------------------------------------------------------------------------- *)
4804 (* Special case of a triangle.                                               *)
4805 (* ------------------------------------------------------------------------- *)
4806
4807 let RELATIVE_BOUNDARY_OF_TRIANGLE = prove
4808  (`!a b c:real^N.
4809         ~collinear {a,b,c}
4810         ==> convex hull {a,b,c} DIFF relative_interior(convex hull {a,b,c}) =
4811             segment[a,b] UNION segment[b,c] UNION segment[c,a]`,
4812   REPEAT STRIP_TAC THEN
4813   ONCE_REWRITE_TAC[SET_RULE `s UNION t UNION u = t UNION u UNION s`] THEN
4814   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV
4815    [COLLINEAR_3_EQ_AFFINE_DEPENDENT]) THEN
4816   REWRITE_TAC[DE_MORGAN_THM; SEGMENT_CONVEX_HULL] THEN STRIP_TAC THEN
4817   ASM_SIMP_TAC[RELATIVE_BOUNDARY_OF_CONVEX_HULL] THEN
4818   ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
4819   REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT; UNIONS_0; UNION_EMPTY] THEN
4820   REPEAT BINOP_TAC THEN REWRITE_TAC[] THEN ASM SET_TAC[]);;
4821
4822 let RELATIVE_FRONTIER_OF_TRIANGLE = prove
4823  (`!a b c:real^N.
4824         ~collinear {a,b,c}
4825         ==> relative_frontier(convex hull {a,b,c}) =
4826             segment[a,b] UNION segment[b,c] UNION segment[c,a]`,
4827   REPEAT STRIP_TAC THEN
4828   ASM_SIMP_TAC[GSYM RELATIVE_BOUNDARY_OF_TRIANGLE; relative_frontier] THEN
4829   AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC CLOSURE_CLOSED THEN
4830   ASM_SIMP_TAC[COMPACT_IMP_CLOSED; FINITE_IMP_COMPACT; COMPACT_CONVEX_HULL;
4831                FINITE_INSERT; FINITE_EMPTY]);;
4832
4833 let FRONTIER_OF_TRIANGLE = prove
4834  (`!a b c:real^2.
4835         frontier(convex hull {a,b,c}) =
4836             segment[a,b] UNION segment[b,c] UNION segment[c,a]`,
4837   REPEAT STRIP_TAC THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN
4838   ONCE_REWRITE_TAC[SET_RULE `s UNION t UNION u = t UNION u UNION s`] THEN
4839   MAP_EVERY (fun t -> ASM_CASES_TAC t THENL
4840    [ASM_REWRITE_TAC[INSERT_AC; UNION_ACI] THEN
4841     SIMP_TAC[GSYM SEGMENT_CONVEX_HULL; frontier; CLOSURE_SEGMENT;
4842              INTERIOR_SEGMENT; DIMINDEX_2; LE_REFL; DIFF_EMPTY] THEN
4843     REWRITE_TAC[CONVEX_HULL_SING] THEN
4844     REWRITE_TAC[SET_RULE `s = s UNION {a} <=> a IN s`;
4845                 SET_RULE `s = {a} UNION s <=> a IN s`] THEN
4846     REWRITE_TAC[ENDS_IN_SEGMENT];
4847     ALL_TAC])
4848    [`b:real^2 = a`; `c:real^2 = a`; `c:real^2 = b`] THEN
4849   SUBGOAL_THEN `{a:real^2,b,c} HAS_SIZE (dimindex(:2) + 1)` ASSUME_TAC THENL
4850    [SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN
4851     ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DIMINDEX_2] THEN
4852     CONV_TAC NUM_REDUCE_CONV;
4853     ASM_SIMP_TAC[FRONTIER_OF_CONVEX_HULL] THEN
4854     ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
4855     REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT; UNIONS_0; UNION_EMPTY] THEN
4856     REPEAT BINOP_TAC THEN REWRITE_TAC[] THEN ASM SET_TAC[]]);;
4857
4858 let INSIDE_OF_TRIANGLE = prove
4859  (`!a b c:real^2.
4860         inside(segment[a,b] UNION segment[b,c] UNION segment[c,a]) =
4861                 interior(convex hull {a,b,c})`,
4862   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM FRONTIER_OF_TRIANGLE] THEN
4863   MATCH_MP_TAC INSIDE_FRONTIER_EQ_INTERIOR THEN
4864   REWRITE_TAC[CONVEX_CONVEX_HULL] THEN MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN
4865   MATCH_MP_TAC FINITE_IMP_BOUNDED THEN
4866   REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]);;
4867
4868 let INTERIOR_OF_TRIANGLE = prove
4869  (`!a b c:real^2.
4870         interior(convex hull {a,b,c}) =
4871         (convex hull {a,b,c}) DIFF
4872         (segment[a,b] UNION segment[b,c] UNION segment[c,a])`,
4873   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM FRONTIER_OF_TRIANGLE; frontier] THEN
4874   MATCH_MP_TAC(SET_RULE `i SUBSET s /\ c = s ==> i = s DIFF (c DIFF i)`) THEN
4875   REWRITE_TAC[INTERIOR_SUBSET] THEN MATCH_MP_TAC CLOSURE_CONVEX_HULL THEN
4876   SIMP_TAC[FINITE_IMP_COMPACT; FINITE_INSERT; FINITE_EMPTY]);;
4877
4878 (* ------------------------------------------------------------------------- *)
4879 (* A ridge is the intersection of precisely two facets.                      *)
4880 (* ------------------------------------------------------------------------- *)
4881
4882 let POLYHEDRON_RIDGE_TWO_FACETS = prove
4883  (`!p:real^N->bool r.
4884     polyhedron p /\ r face_of p /\ ~(r = {}) /\ aff_dim r = aff_dim p - &2
4885     ==> ?f1 f2. f1 face_of p /\ aff_dim f1 = aff_dim p - &1 /\
4886                 f2 face_of p /\ aff_dim f2 = aff_dim p - &1 /\
4887                  ~(f1 = f2) /\ r SUBSET f1 /\ r SUBSET f2 /\ f1 INTER f2 = r /\
4888                 !f. f face_of p /\ aff_dim f = aff_dim p - &1 /\ r SUBSET f
4889                     ==> f = f1 \/ f = f2`,
4890   REPEAT STRIP_TAC THEN
4891   MP_TAC(ISPECL [`p:real^N->bool`; `r:real^N->bool`] FACE_OF_POLYHEDRON) THEN
4892   ANTS_TAC THENL [ASM_MESON_TAC[INT_ARITH `~(p:int = p - &2)`]; ALL_TAC] THEN
4893   SUBGOAL_THEN `&2 <= aff_dim(p:real^N->bool)` ASSUME_TAC THENL
4894    [MP_TAC(ISPEC `r:real^N->bool` AFF_DIM_GE) THEN
4895     MP_TAC(ISPEC `r:real^N->bool` AFF_DIM_EQ_MINUS1) THEN
4896     ASM_REWRITE_TAC[] THEN INT_ARITH_TAC;
4897     ALL_TAC] THEN
4898   SUBGOAL_THEN
4899    `{f:real^N->bool | f facet_of p /\ r SUBSET f} =
4900     {f | f face_of p /\ aff_dim f = aff_dim p - &1 /\ r SUBSET f}`
4901   SUBST1_TAC THENL
4902    [GEN_REWRITE_TAC I [EXTENSION] THEN
4903     ASM_REWRITE_TAC[IN_ELIM_THM; facet_of] THEN
4904     X_GEN_TAC `f:real^N->bool` THEN
4905     ASM_CASES_TAC `f:real^N->bool = {}` THEN
4906     ASM_REWRITE_TAC[AFF_DIM_EMPTY; GSYM CONJ_ASSOC] THEN ASM_INT_ARITH_TAC;
4907     DISCH_THEN(MP_TAC o SYM)] THEN
4908   ASM_CASES_TAC
4909    `{f:real^N->bool | f face_of p /\ aff_dim f = aff_dim p - &1 /\ r SUBSET f}
4910     = {}`
4911   THENL
4912    [ASM_REWRITE_TAC[INTERS_0] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN
4913     UNDISCH_TAC `aff_dim(r:real^N->bool) = aff_dim(p:real^N->bool) - &2` THEN
4914     ASM_REWRITE_TAC[AFF_DIM_UNIV; DIMINDEX_3] THEN
4915     MP_TAC(ISPEC `p:real^N->bool` AFF_DIM_LE_UNIV) THEN INT_ARITH_TAC;
4916     ALL_TAC] THEN
4917   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
4918   REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN
4919   X_GEN_TAC `f1:real^N->bool` THEN STRIP_TAC THEN
4920   ASM_CASES_TAC
4921    `{f:real^N->bool | f face_of p /\ aff_dim f = aff_dim p - &1 /\ r SUBSET f}
4922     = {f1}`
4923   THENL
4924    [ASM_REWRITE_TAC[INTERS_1] THEN
4925     ASM_MESON_TAC[INT_ARITH `~(x - &2:int = x - &1)`];
4926     ALL_TAC] THEN
4927   FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
4928    `~(s = {a}) ==> a IN s ==> ?b. ~(b = a) /\ b IN s`)) THEN
4929   ASM_REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
4930   X_GEN_TAC `f2:real^N->bool` THEN STRIP_TAC THEN
4931   ASM_CASES_TAC
4932    `{f:real^N->bool | f face_of p /\ aff_dim f = aff_dim p - &1 /\ r SUBSET f}
4933     = {f1,f2}`
4934   THENL
4935    [ASM_REWRITE_TAC[INTERS_2] THEN DISCH_TAC THEN
4936     MAP_EVERY EXISTS_TAC [`f1:real^N->bool`; `f2:real^N->bool`] THEN
4937     ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
4938     ALL_TAC] THEN
4939   FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
4940    `~(s = {a,b})
4941     ==> a IN s /\ b IN s ==> ?c. ~(c = a) /\ ~(c = b) /\ c IN s`)) THEN
4942   ASM_REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
4943   X_GEN_TAC `f3:real^N->bool` THEN STRIP_TAC THEN DISCH_TAC THEN
4944   UNDISCH_TAC `aff_dim(r:real^N->bool) = aff_dim(p:real^N->bool) - &2` THEN
4945   MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN
4946   MATCH_MP_TAC(INT_ARITH `~(p - &2:int <= x:int) ==> ~(x = p - &2)`) THEN
4947   DISCH_TAC THEN SUBGOAL_THEN
4948    `~(f1:real^N->bool = {}) /\
4949     ~(f2:real^N->bool = {}) /\
4950     ~(f3:real^N->bool = {})`
4951   STRIP_ASSUME_TAC THENL
4952    [REPEAT CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN
4953     RULE_ASSUM_TAC(REWRITE_RULE[AFF_DIM_EMPTY]) THEN ASM_INT_ARITH_TAC;
4954     ALL_TAC] THEN
4955   MP_TAC(ISPEC `p:real^N->bool` POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL) THEN
4956   REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN
4957   REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN
4958   ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC
4959    [`f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`;
4960     `b:(real^N->bool)->real`] THEN
4961   ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
4962   REWRITE_TAC[VECTOR_ARITH `vec 0:real^N = v <=> v = vec 0`] THEN
4963   STRIP_TAC THEN MP_TAC(ISPECL
4964    [`p:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`;
4965     `b:(real^N->bool)->real`] FACET_OF_POLYHEDRON_EXPLICIT) THEN
4966   ASM_SIMP_TAC[] THEN DISCH_THEN(fun th ->
4967     MP_TAC(SPEC `f1:real^N->bool` th) THEN
4968     MP_TAC(SPEC `f2:real^N->bool` th) THEN
4969     MP_TAC(SPEC `f3:real^N->bool` th)) THEN
4970   ASM_REWRITE_TAC[facet_of] THEN
4971   DISCH_THEN(X_CHOOSE_THEN `h3:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN
4972   DISCH_THEN(X_CHOOSE_THEN `h2:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN
4973   DISCH_THEN(X_CHOOSE_THEN `h1:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN
4974   SUBGOAL_THEN `~((a:(real^N->bool)->real^N) h1 = a h2) /\
4975                  ~(a h2 = a h3) /\ ~(a h1 = a h3)`
4976   STRIP_ASSUME_TAC THENL
4977    [REPEAT CONJ_TAC THENL
4978      [DISJ_CASES_TAC(REAL_ARITH
4979        `b(h1:real^N->bool) <= b h2 \/ b h2 <= b h1`)
4980       THENL
4981        [FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h2:real^N->bool)`);
4982         FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h1:real^N->bool)`)] THEN
4983       (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
4984        MATCH_MP_TAC(SET_RULE `(p ==> s = t) ==> s PSUBSET t ==> ~p`) THEN
4985        DISCH_TAC THEN
4986        FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN
4987        AP_TERM_TAC)
4988       THENL
4989        [SUBGOAL_THEN `f DELETE h2 = h1 INSERT (f DIFF {h1,h2}) /\
4990                       f = (h2:real^N->bool) INSERT h1 INSERT (f DIFF {h1,h2})`
4991          (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC];
4992         SUBGOAL_THEN `f DELETE h1 = h2 INSERT (f DIFF {h1,h2}) /\
4993                       f = (h1:real^N->bool) INSERT h2 INSERT (f DIFF {h1,h2})`
4994          (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]] THEN
4995       REWRITE_TAC[INTERS_INSERT] THEN MATCH_MP_TAC(SET_RULE
4996        `b SUBSET a ==> a INTER b INTER s = b INTER s`) THEN
4997       FIRST_X_ASSUM(fun th ->
4998        MP_TAC(SPEC `h1:real^N->bool` th) THEN
4999        MP_TAC(SPEC `h2:real^N->bool` th)) THEN
5000       ASM_REWRITE_TAC[IMP_IMP] THEN
5001       DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN
5002       REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC;
5003       DISJ_CASES_TAC(REAL_ARITH
5004        `b(h2:real^N->bool) <= b h3 \/ b h3 <= b h2`)
5005       THENL
5006        [FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h3:real^N->bool)`);
5007         FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h2:real^N->bool)`)] THEN
5008       (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5009        MATCH_MP_TAC(SET_RULE `(p ==> s = t) ==> s PSUBSET t ==> ~p`) THEN
5010        DISCH_TAC THEN
5011        FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN
5012        AP_TERM_TAC)
5013       THENL
5014        [SUBGOAL_THEN `f DELETE h3 = h2 INSERT (f DIFF {h2,h3}) /\
5015                       f = (h3:real^N->bool) INSERT h2 INSERT (f DIFF {h2,h3})`
5016          (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC];
5017         SUBGOAL_THEN `f DELETE h2 = h3 INSERT (f DIFF {h2,h3}) /\
5018                       f = (h2:real^N->bool) INSERT h3 INSERT (f DIFF {h2,h3})`
5019          (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]] THEN
5020       REWRITE_TAC[INTERS_INSERT] THEN MATCH_MP_TAC(SET_RULE
5021        `b SUBSET a ==> a INTER b INTER s = b INTER s`) THEN
5022       FIRST_X_ASSUM(fun th ->
5023        MP_TAC(SPEC `h2:real^N->bool` th) THEN
5024        MP_TAC(SPEC `h3:real^N->bool` th)) THEN
5025       ASM_REWRITE_TAC[IMP_IMP] THEN
5026       DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN
5027       REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC;
5028       DISJ_CASES_TAC(REAL_ARITH
5029        `b(h1:real^N->bool) <= b h3 \/ b h3 <= b h1`)
5030       THENL
5031        [FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h3:real^N->bool)`);
5032         FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h1:real^N->bool)`)] THEN
5033       (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5034        MATCH_MP_TAC(SET_RULE `(p ==> s = t) ==> s PSUBSET t ==> ~p`) THEN
5035        DISCH_TAC THEN
5036        FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN
5037        AP_TERM_TAC)
5038       THENL
5039        [SUBGOAL_THEN `f DELETE h3 = h1 INSERT (f DIFF {h1,h3}) /\
5040                       f = (h3:real^N->bool) INSERT h1 INSERT (f DIFF {h1,h3})`
5041          (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC];
5042         SUBGOAL_THEN `f DELETE h1 = h3 INSERT (f DIFF {h1,h3}) /\
5043                       f = (h1:real^N->bool) INSERT h3 INSERT (f DIFF {h1,h3})`
5044          (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]] THEN
5045       REWRITE_TAC[INTERS_INSERT] THEN MATCH_MP_TAC(SET_RULE
5046        `b SUBSET a ==> a INTER b INTER s = b INTER s`) THEN
5047       FIRST_X_ASSUM(fun th ->
5048        MP_TAC(SPEC `h1:real^N->bool` th) THEN
5049        MP_TAC(SPEC `h3:real^N->bool` th)) THEN
5050       ASM_REWRITE_TAC[IMP_IMP] THEN
5051       DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN
5052       REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC];
5053     ALL_TAC] THEN
5054   SUBGOAL_THEN
5055    `~({x | a h1 dot x <= b h1} INTER {x | a h2 dot x <= b h2}
5056       SUBSET {x | a h3 dot x <= b h3}) /\
5057     ~({x | a h1 dot x <= b h1} INTER {x | a h3 dot x <= b h3}
5058       SUBSET {x | a h2 dot x <= b h2}) /\
5059     ~({x | a h2 dot x <= b h2} INTER {x | a h3 dot x <= b h3}
5060       SUBSET {x:real^N | a(h1:real^N->bool) dot x <= b h1})`
5061   MP_TAC THENL
5062    [ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THENL
5063      [FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h3:real^N->bool)`);
5064       FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h2:real^N->bool)`);
5065       FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h1:real^N->bool)`)] THEN
5066     (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5067      FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC
5068        (LAND_CONV o LAND_CONV) [SYM th]) THEN
5069      MATCH_MP_TAC(SET_RULE `s = t ==> s PSUBSET t ==> F`) THEN
5070      AP_TERM_TAC)
5071     THENL
5072      [SUBGOAL_THEN
5073        `f DELETE (h3:real^N->bool) = h1 INSERT h2 INSERT (f DELETE h3) /\
5074         f =  h1 INSERT h2 INSERT h3 INSERT (f DELETE h3)`
5075        (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC];
5076       SUBGOAL_THEN
5077        `f DELETE (h2:real^N->bool) = h1 INSERT h3 INSERT (f DELETE h2) /\
5078         f =  h2 INSERT h1 INSERT h3 INSERT (f DELETE h2)`
5079        (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC];
5080       SUBGOAL_THEN
5081        `f DELETE (h1:real^N->bool) = h2 INSERT h3 INSERT (f DELETE h1) /\
5082         f =  h1 INSERT h2 INSERT h3 INSERT (f DELETE h1)`
5083        (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]] THEN
5084     REWRITE_TAC[INTERS_INSERT] THEN REWRITE_TAC[GSYM INTER_ASSOC] THEN
5085     AP_THM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[];
5086     ALL_TAC] THEN
5087   SUBGOAL_THEN
5088    `?w. (a:(real^N->bool)->real^N) h1 dot w < b h1 /\
5089         a h2 dot w < b h2 /\ a h3 dot w < b h3`
5090    (CHOOSE_THEN MP_TAC)
5091   THENL
5092    [SUBGOAL_THEN `~(relative_interior p :real^N->bool = {})` MP_TAC THENL
5093      [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY; POLYHEDRON_IMP_CONVEX] THEN
5094       ASM SET_TAC[];
5095       ALL_TAC] THEN
5096     MP_TAC(ISPECL
5097      [`p:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`;
5098       `b:(real^N->bool)->real`] RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN
5099     ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN
5100     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
5101     MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
5102     DISCH_THEN(MP_TAC o CONJUNCT2) THEN ASM_SIMP_TAC[];
5103     ALL_TAC] THEN
5104   SUBGOAL_THEN
5105    `!x. x IN r ==> (a h1) dot (x:real^N) = b h1 /\
5106                    (a h2) dot x = b h2 /\
5107                    (a (h3:real^N->bool)) dot x = b h3`
5108   MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5109   SUBGOAL_THEN `?z:real^N. z IN r` CHOOSE_TAC THENL
5110    [ASM SET_TAC[]; ALL_TAC] THEN
5111   MAP_EVERY UNDISCH_TAC
5112    [`~((a:(real^N->bool)->real^N) h1 = a h2)`;
5113     `~((a:(real^N->bool)->real^N) h1 = a h3)`;
5114     `~((a:(real^N->bool)->real^N) h2 = a h3)`;
5115     `aff_dim(p:real^N->bool) - &2 <= aff_dim(r:real^N->bool)`] THEN
5116   MAP_EVERY (fun t ->
5117     FIRST_X_ASSUM(fun th -> MP_TAC(SPEC t th) THEN ASM_REWRITE_TAC[] THEN
5118                             ASSUME_TAC th) THEN
5119     DISCH_THEN(MP_TAC o SPEC `z:real^N` o CONJUNCT2 o CONJUNCT2))
5120    [`h1:real^N->bool`; `h2:real^N->bool`; `h3:real^N->bool`] THEN
5121   SUBGOAL_THEN `(z:real^N) IN (affine hull p)` ASSUME_TAC THENL
5122    [MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[];
5123     ASM_REWRITE_TAC[]] THEN
5124   UNDISCH_TAC `(z:real^N) IN (affine hull p)` THEN
5125   SUBGOAL_THEN `(a h1) dot (z:real^N) = b h1 /\
5126                 (a h2) dot z = b h2 /\
5127                 (a (h3:real^N->bool)) dot z = b h3`
5128   (REPEAT_TCL CONJUNCTS_THEN (SUBST1_TAC o SYM))
5129   THENL [ASM SET_TAC[]; ALL_TAC] THEN
5130   SUBGOAL_THEN `(r:real^N->bool) SUBSET affine hull p` MP_TAC THENL
5131    [ASM_MESON_TAC[FACE_OF_IMP_SUBSET; HULL_SUBSET; SUBSET_TRANS]; ALL_TAC] THEN
5132   SUBGOAL_THEN
5133    `~((a:(real^N->bool)->real^N) h1 = vec 0) /\
5134     ~((a:(real^N->bool)->real^N) h2 = vec 0) /\
5135     ~((a:(real^N->bool)->real^N) h3 = vec 0)`
5136   MP_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN
5137   UNDISCH_TAC `(z:real^N) IN r` THEN POP_ASSUM_LIST(K ALL_TAC) THEN
5138   MAP_EVERY SPEC_TAC
5139    [`(a:(real^N->bool)->real^N) h1`,`a1:real^N`;
5140     `(a:(real^N->bool)->real^N) h2`,`a2:real^N`;
5141     `(a:(real^N->bool)->real^N) h3`,`a3:real^N`] THEN
5142   REPEAT GEN_TAC THEN
5143   GEN_GEOM_ORIGIN_TAC `z:real^N` ["a1"; "a2"; "a3"] THEN
5144   REWRITE_TAC[VECTOR_ADD_RID; VECTOR_ADD_LID] THEN
5145   REWRITE_TAC[DOT_RADD; IMAGE_CLAUSES;
5146    REAL_ARITH `a + b:real <= a <=> b <= &0`;
5147    REAL_ARITH `a + b:real < a <=> b < &0`;
5148    REAL_ARITH `a + b:real = a <=> b = &0`] THEN
5149
5150   REPEAT STRIP_TAC THEN
5151   SUBGOAL_THEN `aff_dim(p:real^N->bool) = &(dim p)` SUBST_ALL_TAC THENL
5152    [ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC]; ALL_TAC] THEN
5153   SUBGOAL_THEN `aff_dim(r:real^N->bool) = &(dim r)` SUBST_ALL_TAC THENL
5154    [ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC]; ALL_TAC] THEN
5155   RULE_ASSUM_TAC(REWRITE_RULE[INT_OF_NUM_ADD; INT_OF_NUM_LE;
5156     INT_ARITH `p - &2:int <= q <=> p <= q + &2`]) THEN
5157   MP_TAC(ISPECL
5158    [`{a1:real^N,a2,a3}`; `r:real^N->bool`] DIM_ORTHOGONAL_SUM) THEN
5159   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
5160   ASM_SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN
5161   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE
5162     `p <= r + 2 ==> u <= p /\ 3 <= t ==> ~(u = t + r)`)) THEN
5163   SUBGOAL_THEN `affine hull p :real^N->bool = span p` SUBST_ALL_TAC THENL
5164    [ASM_MESON_TAC[AFFINE_HULL_EQ_SPAN]; ALL_TAC] THEN
5165   CONJ_TAC THENL
5166    [GEN_REWRITE_TAC RAND_CONV [GSYM DIM_SPAN] THEN
5167     MATCH_MP_TAC DIM_SUBSET THEN ASM SET_TAC[];
5168     ALL_TAC] THEN
5169   MP_TAC(ISPEC `{a1:real^N,a2,a3}` DEPENDENT_BIGGERSET_GENERAL) THEN
5170   SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; ARITH] THEN
5171   ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN
5172   GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN
5173   REWRITE_TAC[ARITH_RULE `~(3 > x) <=> 3 <= x`] THEN
5174   DISCH_THEN MATCH_MP_TAC THEN
5175   REWRITE_TAC[dependent; EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN
5176   ASM_REWRITE_TAC[DELETE_INSERT; EMPTY_DELETE] THEN
5177   REWRITE_TAC[SPAN_2; IN_ELIM_THM; IN_UNIV] THEN
5178   POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
5179   W(fun (asl,w) -> let fv = frees w
5180                    and av = [`a1:real^N`; `a2:real^N`; `a3:real^N`] in
5181      MAP_EVERY (fun t -> SPEC_TAC(t,t)) (subtract fv av @ av)) THEN
5182   REWRITE_TAC[LEFT_FORALL_IMP_THM] THEN
5183   MATCH_MP_TAC(MESON[]
5184    `(!a1 a2 a3. P a1 a2 a3 ==> P a2 a1 a3 /\ P a3 a1 a2) /\
5185     (!a1 a2 a3. Q a1 a2 a3 ==> ~(P a1 a2 a3))
5186     ==> !a3 a2 a1. P a1 a2 a3
5187                    ==> ~(Q a1 a2 a3 \/ Q a2 a1 a3 \/ Q a3 a1 a2)`) THEN
5188   CONJ_TAC THENL
5189    [REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT
5190      `(p ==> q) /\ (p ==> r) ==> p ==> q /\ r`) THEN
5191     CONJ_TAC THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
5192     REWRITE_TAC[CONJ_ACI] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
5193     ASM SET_TAC[];
5194     ALL_TAC] THEN
5195   REPEAT GEN_TAC THEN DISCH_THEN
5196    (X_CHOOSE_THEN `u:real` (X_CHOOSE_TAC `v:real`)) THEN
5197   REWRITE_TAC[NOT_EXISTS_THM] THEN REPEAT GEN_TAC THEN
5198   ASM_CASES_TAC `u = &0` THENL
5199    [ASM_REWRITE_TAC[VECTOR_ADD_LID; VECTOR_MUL_LZERO] THEN
5200     REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH
5201      `v = &0 \/ &0 < v \/ &0 < --v`)
5202     THENL
5203      [ASM_REWRITE_TAC[VECTOR_MUL_LZERO];
5204       REWRITE_TAC[DOT_LMUL; REAL_ARITH `a * b <= &0 <=> &0 <= a * --b`] THEN
5205       ASM_SIMP_TAC[REAL_LE_MUL_EQ] THEN
5206       REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTER] THEN REAL_ARITH_TAC;
5207       REWRITE_TAC[DOT_LMUL; REAL_ARITH `a * b < &0 <=> &0 < --a * b`] THEN
5208       ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN REAL_ARITH_TAC];
5209     ALL_TAC] THEN
5210   ASM_CASES_TAC `v = &0` THENL
5211    [ASM_REWRITE_TAC[VECTOR_ADD_RID; VECTOR_MUL_LZERO] THEN
5212     REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH
5213      `u = &0 \/ &0 < u \/ &0 < --u`)
5214     THENL
5215      [ASM_REWRITE_TAC[VECTOR_MUL_LZERO];
5216       REWRITE_TAC[DOT_LMUL; REAL_ARITH `a * b <= &0 <=> &0 <= a * --b`] THEN
5217       ASM_SIMP_TAC[REAL_LE_MUL_EQ] THEN
5218       REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTER] THEN REAL_ARITH_TAC;
5219       REWRITE_TAC[DOT_LMUL; REAL_ARITH `a * b < &0 <=> &0 < --a * b`] THEN
5220       ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN REAL_ARITH_TAC];
5221     ALL_TAC] THEN
5222   STRIP_TAC THEN
5223   SUBGOAL_THEN
5224    `&0 < u /\ &0 < v \/ &0 < u /\ &0 < --v \/
5225     &0 < --u /\ &0 < v \/ &0 < --u /\ &0 < --v`
5226   STRIP_ASSUME_TAC THENL
5227    [ASM_REAL_ARITH_TAC;
5228     UNDISCH_TAC
5229      `~({x | a2 dot x <= &0} INTER {x | a3 dot x <= &0} SUBSET
5230         {x:real^N | a1 dot x <= &0})` THEN
5231     ASM_REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN
5232     REWRITE_TAC[DOT_LADD; DOT_LMUL] THEN
5233     REWRITE_TAC[REAL_ARITH `x <= &0 <=> &0 <= --x`] THEN
5234     REWRITE_TAC[REAL_NEG_ADD; GSYM REAL_MUL_RNEG] THEN
5235     ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_ADD; REAL_LT_IMP_LE];
5236     UNDISCH_TAC
5237      `~({x | a1 dot x <= &0} INTER {x | a3 dot x <= &0} SUBSET
5238         {x:real^N | a2 dot x <= &0})` THEN
5239     ASM_REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN
5240     GEN_TAC THEN REWRITE_TAC[DOT_LADD; DOT_LMUL] THEN
5241     MATCH_MP_TAC(REAL_ARITH
5242      `(&0 < u * a2 <=> &0 < a2) /\ (&0 < --v * a3 <=> &0 < a3)
5243       ==> u * a2 + v * a3 <= &0 /\ a3 <= &0 ==> a2 <= &0`) THEN
5244     ASM_SIMP_TAC[REAL_LT_MUL_EQ];
5245     UNDISCH_TAC
5246      `~({x | a1 dot x <= &0} INTER {x | a2 dot x <= &0} SUBSET
5247         {x:real^N | a3 dot x <= &0})` THEN
5248     ASM_REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN
5249     GEN_TAC THEN REWRITE_TAC[DOT_LADD; DOT_LMUL] THEN
5250     MATCH_MP_TAC(REAL_ARITH
5251      `(&0 < --u * a2 <=> &0 < a2) /\ (&0 < v * a3 <=> &0 < a3)
5252       ==> u * a2 + v * a3 <= &0 /\ a2 <= &0 ==> a3 <= &0`) THEN
5253     ASM_SIMP_TAC[REAL_LT_MUL_EQ];
5254     UNDISCH_TAC `(a1:real^N) dot w < &0` THEN
5255     ASM_REWRITE_TAC[DOT_LADD; DOT_LMUL] THEN
5256     MATCH_MP_TAC(REAL_ARITH
5257      `&0 < --u * --a /\ &0 < --v * --b ==> ~(u * a + v * b < &0)`) THEN
5258     CONJ_TAC THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC]);;
5259
5260 (* ------------------------------------------------------------------------- *)
5261 (* Lower bounds on then number of 0 and n-1 dimensional faces.               *)
5262 (* ------------------------------------------------------------------------- *)
5263
5264 let POLYTOPE_VERTEX_LOWER_BOUND = prove
5265  (`!p:real^N->bool.
5266         polytope p ==> aff_dim p + &1 <= &(CARD {v | v extreme_point_of p})`,
5267   REPEAT STRIP_TAC THEN
5268   MATCH_MP_TAC INT_LE_TRANS THEN
5269   EXISTS_TAC `aff_dim(convex hull {v:real^N | v extreme_point_of p}) + &1` THEN
5270   CONJ_TAC THENL
5271    [ASM_SIMP_TAC[GSYM KREIN_MILMAN_MINKOWSKI; POLYTOPE_IMP_CONVEX;
5272                  POLYTOPE_IMP_COMPACT; INT_LE_REFL];
5273     REWRITE_TAC[AFF_DIM_CONVEX_HULL; GSYM INT_LE_SUB_LADD] THEN
5274     MATCH_MP_TAC AFF_DIM_LE_CARD THEN
5275     MATCH_MP_TAC FINITE_POLYHEDRON_EXTREME_POINTS THEN
5276     ASM_SIMP_TAC[POLYTOPE_IMP_POLYHEDRON]]);;
5277
5278 let POLYTOPE_FACET_LOWER_BOUND = prove
5279  (`!p:real^N->bool.
5280         polytope p /\ ~(aff_dim p = &0)
5281         ==> aff_dim p + &1 <= &(CARD {f | f facet_of p})`,
5282   GEN_TAC THEN ASM_CASES_TAC `p:real^N->bool = {}` THEN
5283   ASM_SIMP_TAC[AFF_DIM_EMPTY; FACET_OF_EMPTY; EMPTY_GSPEC; CARD_CLAUSES] THEN
5284   CONV_TAC INT_REDUCE_CONV THEN STRIP_TAC THEN
5285   SUBGOAL_THEN
5286    `?n. {f:real^N->bool | f facet_of p} HAS_SIZE n /\ aff_dim p + &1 <= &n`
5287     (fun th -> MESON_TAC[th; HAS_SIZE]) THEN
5288   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
5289   DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN
5290   POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
5291   GEOM_ORIGIN_TAC `z:real^N` THEN REPEAT GEN_TAC THEN REPEAT STRIP_TAC THEN
5292   EXISTS_TAC `CARD {f:real^N->bool | f facet_of p}` THEN
5293   ASM_SIMP_TAC[FINITE_POLYTOPE_FACETS; HAS_SIZE] THEN
5294   UNDISCH_TAC `~(aff_dim(p:real^N->bool) = &0)` THEN
5295   ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; INT_OF_NUM_ADD; INT_OF_NUM_LE] THEN
5296   REWRITE_TAC[INT_OF_NUM_EQ] THEN DISCH_TAC THEN
5297   MP_TAC(ISPEC `p:real^N->bool` POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL) THEN
5298   ASM_SIMP_TAC[POLYTOPE_IMP_POLYHEDRON] THEN
5299   REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN
5300   REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN
5301   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC
5302    [`H:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`;
5303     `b:(real^N->bool)->real`] THEN
5304   ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
5305   REWRITE_TAC[VECTOR_ARITH `vec 0:real^N = v <=> v = vec 0`] THEN
5306   ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN
5307   STRIP_TAC THEN MP_TAC(ISPECL
5308    [`p:real^N->bool`; `H:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`;
5309     `b:(real^N->bool)->real`] FACET_OF_POLYHEDRON_EXPLICIT) THEN
5310   ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN DISCH_THEN(K ALL_TAC) THEN
5311   SUBGOAL_THEN `!h:real^N->bool. h IN H ==> &0 <= b h` ASSUME_TAC THENL
5312    [UNDISCH_TAC `(vec 0:real^N) IN p` THEN EXPAND_TAC "p" THEN
5313     REWRITE_TAC[IN_INTER; IN_INTERS] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN
5314     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `h:real^N->bool` THEN
5315     ASM_CASES_TAC `(h:real^N->bool) IN H` THEN ASM_REWRITE_TAC[] THEN
5316     FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
5317     DISCH_THEN(fun t -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM t]) THEN
5318     REWRITE_TAC[IN_ELIM_THM; DOT_RZERO];
5319     ALL_TAC] THEN
5320   MATCH_MP_TAC LE_TRANS THEN
5321   EXISTS_TAC `(CARD(H:(real^N->bool)->bool))` THEN CONJ_TAC THENL
5322    [MATCH_MP_TAC(ARITH_RULE `~(h <= a) ==> a + 1 <= h`) THEN DISCH_TAC THEN
5323     ASM_CASES_TAC `H:(real^N->bool)->bool = {}` THENL
5324      [UNDISCH_THEN `H:(real^N->bool)->bool = {}` SUBST_ALL_TAC THEN
5325       RULE_ASSUM_TAC(REWRITE_RULE[INTERS_0; INTER_UNIV]) THEN
5326       UNDISCH_TAC `~(dim(p:real^N->bool) = 0)` THEN
5327       REWRITE_TAC[DIM_EQ_0] THEN EXPAND_TAC "p" THEN
5328       REWRITE_TAC[ASSUME `H:(real^N->bool)->bool = {}`; INTERS_0] THEN
5329       REWRITE_TAC[INTER_UNIV] THEN
5330       ASM_CASES_TAC `?n:real^N. n IN span p /\ ~(n = vec 0)` THENL
5331        [ALL_TAC; ASM SET_TAC[]] THEN
5332       FIRST_X_ASSUM(CHOOSE_THEN STRIP_ASSUME_TAC) THEN
5333       FIRST_ASSUM(MP_TAC o MATCH_MP POLYTOPE_IMP_BOUNDED) THEN
5334       REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(X_CHOOSE_THEN `B:real`
5335        (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5336       DISCH_THEN(MP_TAC o SPEC `(B + &1) / norm n % n:real^N`) THEN
5337       ANTS_TAC THENL [ASM_MESON_TAC[SPAN_MUL]; ALL_TAC] THEN
5338       REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
5339       ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN REAL_ARITH_TAC;
5340       ALL_TAC] THEN
5341     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
5342     DISCH_THEN(X_CHOOSE_TAC `h:real^N->bool`) THEN
5343     SUBGOAL_THEN
5344      `span(IMAGE (a:(real^N->bool)->real^N) (H DELETE h))
5345       PSUBSET span(p)`
5346     MP_TAC THENL
5347      [REWRITE_TAC[PSUBSET] THEN CONJ_TAC THENL
5348        [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN
5349         REWRITE_TAC[SUBSPACE_SPAN; SUBSET; FORALL_IN_IMAGE; IN_DELETE] THEN
5350         ASM_MESON_TAC[SPAN_ADD; SPAN_SUPERSET; VECTOR_ADD_LID];
5351         DISCH_THEN(MP_TAC o AP_TERM `dim:(real^N->bool)->num`) THEN
5352         REWRITE_TAC[DIM_SPAN] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
5353          (ARITH_RULE `h <= p ==> h':num < h ==> ~(h' = p)`)) THEN
5354         MATCH_MP_TAC LET_TRANS THEN
5355         EXISTS_TAC `CARD(IMAGE (a:(real^N->bool)->real^N) (H DELETE h))` THEN
5356         ASM_SIMP_TAC[DIM_LE_CARD; FINITE_DELETE; FINITE_IMAGE] THEN
5357         MATCH_MP_TAC LET_TRANS THEN
5358         EXISTS_TAC `CARD(H DELETE (h:real^N->bool))` THEN
5359         ASM_SIMP_TAC[CARD_IMAGE_LE; FINITE_DELETE] THEN
5360         ASM_SIMP_TAC[CARD_DELETE; ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN
5361         ASM_SIMP_TAC[CARD_EQ_0] THEN ASM SET_TAC[]];
5362       DISCH_THEN(MP_TAC o MATCH_MP ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN)] THEN
5363     REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `n:real^N` THEN STRIP_TAC THEN
5364     FIRST_ASSUM(MP_TAC o MATCH_MP POLYTOPE_IMP_BOUNDED) THEN
5365     REWRITE_TAC[BOUNDED_POS] THEN
5366     DISCH_THEN(X_CHOOSE_THEN `B:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5367     DISJ_CASES_TAC(REAL_ARITH
5368      `&0 <= (a:(real^N->bool)->real^N) h dot n \/
5369       &0 <= --((a:(real^N->bool)->real^N) h dot n)`)
5370     THENL
5371      [DISCH_THEN(MP_TAC o SPEC `--(B + &1) / norm(n) % n:real^N`);
5372       DISCH_THEN(MP_TAC o SPEC `(B + &1) / norm(n) % n:real^N`)] THEN
5373     (ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM;
5374                   REAL_DIV_RMUL; NORM_EQ_0; REAL_ABS_NEG;
5375                   REAL_ARITH `~(abs(B + &1) <= B)`] THEN
5376      EXPAND_TAC "p" THEN REWRITE_TAC[IN_INTER; IN_INTERS] THEN
5377      ASM_SIMP_TAC[SPAN_MUL] THEN X_GEN_TAC `k:real^N->bool` THEN
5378      DISCH_TAC THEN
5379      SUBGOAL_THEN `k = {x:real^N | a k dot x <= b k}` SUBST1_TAC THENL
5380       [ASM_SIMP_TAC[]; ALL_TAC] THEN
5381      ASM_CASES_TAC `k:real^N->bool = h` THEN
5382      ASM_REWRITE_TAC[IN_ELIM_THM; DOT_RMUL] THENL
5383       [ALL_TAC;
5384        MATCH_MP_TAC(REAL_ARITH `x = &0 /\ &0 <= y ==> x <= y`) THEN
5385        ASM_SIMP_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN
5386        FIRST_X_ASSUM(MP_TAC o SPEC `(a:(real^N->bool)->real^N) k`) THEN
5387        REWRITE_TAC[orthogonal; DOT_SYM] THEN DISCH_THEN MATCH_MP_TAC THEN
5388        MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]]) THENL
5389      [MATCH_MP_TAC(REAL_ARITH `&0 <= --x * y /\ &0 <= z ==> x * y <= z`);
5390       MATCH_MP_TAC(REAL_ARITH `&0 <= x * --y /\ &0 <= z ==> x * y <= z`)] THEN
5391     ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN
5392     REWRITE_TAC[REAL_ARITH `--a / b:real = --(a / b)`; REAL_NEG_NEG] THEN
5393     ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT] THEN ASM_REAL_ARITH_TAC;
5394     REWRITE_TAC[SET_RULE `{f | ?h. h IN s /\ f = g h} = IMAGE g s`] THEN
5395     MATCH_MP_TAC(ARITH_RULE `m:num = n ==> n <= m`) THEN
5396     MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN
5397     MATCH_MP_TAC FACETS_OF_POLYHEDRON_EXPLICIT_DISTINCT THEN
5398     ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC]]);;
5399
5400 (* ------------------------------------------------------------------------- *)
5401 (* The notion of n-simplex where n is an integer >= -1.                      *)
5402 (* ------------------------------------------------------------------------- *)
5403
5404 parse_as_infix("simplex",(12,"right"));;
5405
5406 let simplex = new_definition
5407  `n simplex s <=> ?c. ~(affine_dependent c) /\
5408                       &(CARD c):int = n + &1 /\
5409                       s = convex hull c`;;
5410
5411 let SIMPLEX = prove
5412  (`n simplex s <=> ?c. FINITE c /\
5413                        ~(affine_dependent c) /\
5414                        &(CARD c):int = n + &1 /\
5415                        s = convex hull c`,
5416   REWRITE_TAC[simplex] THEN MESON_TAC[AFFINE_INDEPENDENT_IMP_FINITE]);;
5417
5418 let CONVEX_SIMPLEX = prove
5419  (`!n s. n simplex s ==> convex s`,
5420   REWRITE_TAC[simplex] THEN MESON_TAC[CONVEX_CONVEX_HULL]);;
5421
5422 let COMPACT_SIMPLEX = prove
5423  (`!n s. n simplex s ==> compact s`,
5424   REWRITE_TAC[SIMPLEX] THEN
5425   MESON_TAC[FINITE_IMP_COMPACT; COMPACT_CONVEX_HULL]);;
5426
5427 let CLOSED_SIMPLEX = prove
5428  (`!s n. n simplex s ==> closed s`,
5429   MESON_TAC[COMPACT_SIMPLEX; COMPACT_IMP_CLOSED]);;
5430
5431 let SIMPLEX_IMP_POLYTOPE = prove
5432  (`!n s. n simplex s ==> polytope s`,
5433   REWRITE_TAC[simplex; polytope] THEN
5434   MESON_TAC[AFFINE_INDEPENDENT_IMP_FINITE]);;
5435
5436 let SIMPLEX_DIM_GE = prove
5437  (`!n s. n simplex s ==> -- &1 <= n`,
5438   REWRITE_TAC[simplex] THEN INT_ARITH_TAC);;
5439
5440 let SIMPLEX_EMPTY = prove
5441  (`!n. n simplex {} <=> n = -- &1`,
5442   GEN_TAC THEN REWRITE_TAC[SIMPLEX] THEN
5443   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
5444   REWRITE_TAC[CONVEX_HULL_EQ_EMPTY; CONJ_ASSOC] THEN
5445   ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM2] THEN
5446   REWRITE_TAC[FINITE_EMPTY; CARD_CLAUSES; AFFINE_INDEPENDENT_EMPTY] THEN
5447   INT_ARITH_TAC);;
5448
5449 let SIMPLEX_MINUS_1 = prove
5450  (`!s. (-- &1) simplex s <=> s = {}`,
5451   GEN_TAC THEN REWRITE_TAC[SIMPLEX; INT_ADD_LINV; INT_OF_NUM_EQ] THEN
5452   ONCE_REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`] THEN
5453   SIMP_TAC[CARD_EQ_0] THEN REWRITE_TAC[NOT_IMP] THEN
5454   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> c /\ a /\ b /\ d`] THEN
5455   REWRITE_TAC[UNWIND_THM2; FINITE_EMPTY; AFFINE_INDEPENDENT_EMPTY] THEN
5456   REWRITE_TAC[CONVEX_HULL_EMPTY]);;
5457
5458 let AFF_DIM_SIMPLEX = prove
5459  (`!s n. n simplex s ==> aff_dim s = n`,
5460   REWRITE_TAC[simplex; INT_ARITH `x:int = n + &1 <=> n = x - &1`] THEN
5461   REPEAT STRIP_TAC THEN
5462   ASM_SIMP_TAC[AFF_DIM_CONVEX_HULL; AFF_DIM_AFFINE_INDEPENDENT]);;
5463
5464 let SIMPLEX_EXTREME_POINTS = prove
5465  (`!n s:real^N->bool.
5466        n simplex s
5467        ==> FINITE {v | v extreme_point_of s} /\
5468            ~(affine_dependent {v | v extreme_point_of s}) /\
5469            &(CARD {v | v extreme_point_of s}) = n + &1 /\
5470            s = convex hull {v | v extreme_point_of s}`,
5471   REPEAT GEN_TAC THEN REWRITE_TAC[SIMPLEX; LEFT_IMP_EXISTS_THM] THEN
5472   X_GEN_TAC `c:real^N->bool` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
5473   SUBGOAL_THEN `{v:real^N | v extreme_point_of s} = c`
5474    (fun th -> ASM_REWRITE_TAC[th]) THEN
5475   FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
5476   MATCH_MP_TAC(SET_RULE `s SUBSET t /\ ~(s PSUBSET t) ==> s = t`) THEN
5477   REWRITE_TAC[SUBSET; IN_ELIM_THM; EXTREME_POINT_OF_CONVEX_HULL] THEN
5478   ABBREV_TAC `c' = {v:real^N | v extreme_point_of (convex hull c)}` THEN
5479   DISCH_TAC THEN
5480   SUBGOAL_THEN `convex hull c:real^N->bool = convex hull c'` ASSUME_TAC THENL
5481    [EXPAND_TAC "c'" THEN MATCH_MP_TAC KREIN_MILMAN_MINKOWSKI THEN
5482     REWRITE_TAC[CONVEX_CONVEX_HULL] THEN MATCH_MP_TAC COMPACT_CONVEX_HULL THEN
5483     ASM_MESON_TAC[HAS_SIZE; FINITE_IMP_COMPACT];
5484     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [PSUBSET_MEMBER]) THEN
5485     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5486     DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
5487     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [affine_dependent]) THEN
5488     REWRITE_TAC[] THEN EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN
5489     SUBGOAL_THEN `(a:real^N) IN convex hull c'` MP_TAC THENL
5490      [ASM_MESON_TAC[HULL_INC]; ALL_TAC] THEN
5491     DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET]
5492       CONVEX_HULL_SUBSET_AFFINE_HULL)) THEN
5493     SUBGOAL_THEN `c' SUBSET (c DELETE (a:real^N))` MP_TAC THENL
5494      [ASM SET_TAC[]; ASM_MESON_TAC[HULL_MONO; SUBSET]]]);;
5495
5496 let SIMPLEX_FACE_OF_SIMPLEX = prove
5497  (`!n s f:real^N->bool.
5498         n simplex s /\ f face_of s ==> ?m. m <= n /\ m simplex f`,
5499   REPEAT STRIP_TAC THEN
5500   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SIMPLEX]) THEN
5501   REWRITE_TAC[HAS_SIZE; LEFT_IMP_EXISTS_THM] THEN
5502   X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN
5503   FIRST_X_ASSUM SUBST_ALL_TAC THEN
5504   SUBGOAL_THEN `?c':real^N->bool. c' SUBSET c /\ f = convex hull c'`
5505   STRIP_ASSUME_TAC THENL
5506    [ASM_SIMP_TAC[FACE_OF_CONVEX_HULL_SUBSET; FINITE_IMP_COMPACT]; ALL_TAC] THEN
5507   EXISTS_TAC `&(CARD(c':real^N->bool)) - &1:int` THEN ASM_REWRITE_TAC[] THEN
5508   CONJ_TAC THENL
5509    [FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CARD_SUBSET)) THEN
5510     ASM_REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN INT_ARITH_TAC;
5511     REWRITE_TAC[simplex] THEN EXISTS_TAC `c':real^N->bool` THEN
5512     ASM_REWRITE_TAC[INT_ARITH `a - &1 + &1:int = a`] THEN
5513     ASM_MESON_TAC[AFFINE_DEPENDENT_MONO]]);;
5514
5515 let FACE_OF_SIMPLEX_SUBSET = prove
5516  (`!n s f:real^N->bool.
5517         n simplex s /\ f face_of s
5518         ==> ?c. c SUBSET {x | x extreme_point_of s} /\ f = convex hull c`,
5519   REPEAT STRIP_TAC THEN
5520   FIRST_ASSUM(MP_TAC o MATCH_MP SIMPLEX_EXTREME_POINTS) THEN
5521   ABBREV_TAC `c = {x:real^N | x extreme_point_of s}` THEN
5522   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5523   DISCH_THEN SUBST_ALL_TAC THEN
5524   RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
5525   ASM_MESON_TAC[FACE_OF_CONVEX_HULL_SUBSET; FINITE_IMP_COMPACT]);;
5526
5527 let SUBSET_FACE_OF_SIMPLEX = prove
5528  (`!s n c:real^N->bool.
5529       n simplex s /\ c SUBSET {x | x extreme_point_of s}
5530       ==> (convex hull c) face_of s`,
5531   REPEAT STRIP_TAC THEN
5532   FIRST_ASSUM(MP_TAC o MATCH_MP SIMPLEX_EXTREME_POINTS) THEN
5533   REWRITE_TAC[HAS_SIZE] THEN
5534   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN
5535   DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC FACE_OF_CONVEX_HULLS THEN
5536   ASM_REWRITE_TAC[] THEN
5537   MATCH_MP_TAC(SET_RULE `!t. u SUBSET t /\ DISJOINT s t ==> DISJOINT s u`) THEN
5538   EXISTS_TAC `affine hull ({v:real^N | v extreme_point_of s} DIFF c)` THEN
5539   REWRITE_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL] THEN
5540   MATCH_MP_TAC DISJOINT_AFFINE_HULL THEN
5541   EXISTS_TAC `{v:real^N | v extreme_point_of s}` THEN
5542   ASM_REWRITE_TAC[] THEN SET_TAC[]);;
5543
5544 let FACES_OF_SIMPLEX = prove
5545  (`!n s. n simplex s
5546          ==> {f | f face_of s} =
5547              {convex hull c | c SUBSET {v | v extreme_point_of s}}`,
5548   REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN
5549   REWRITE_TAC[IN_ELIM_THM] THEN
5550   ASM_MESON_TAC[FACE_OF_SIMPLEX_SUBSET; SUBSET_FACE_OF_SIMPLEX]);;
5551
5552 let HAS_SIZE_FACES_OF_SIMPLEX = prove
5553  (`!n s:real^N->bool.
5554         n simplex s
5555         ==> {f | f face_of s} HAS_SIZE 2 EXP (num_of_int(n + &1))`,
5556   REPEAT GEN_TAC THEN DISCH_TAC THEN
5557   FIRST_ASSUM(SUBST1_TAC o MATCH_MP FACES_OF_SIMPLEX) THEN
5558   FIRST_X_ASSUM(STRIP_ASSUME_TAC o GSYM o MATCH_MP SIMPLEX_EXTREME_POINTS) THEN
5559   ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN
5560   REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL
5561    [REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ];
5562     MATCH_MP_TAC HAS_SIZE_POWERSET THEN
5563     ASM_REWRITE_TAC[HAS_SIZE; NUM_OF_INT_OF_NUM]] THEN
5564   SUBGOAL_THEN
5565    `!a b. a SUBSET {v:real^N | v extreme_point_of s} /\
5566           b SUBSET {v | v extreme_point_of s} /\
5567           convex hull a SUBSET convex hull b
5568           ==> a SUBSET b`
5569    (fun th -> MESON_TAC[th]) THEN
5570   REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN
5571   DISCH_TAC THEN
5572   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [affine_dependent]) THEN
5573   REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
5574   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[] THEN
5575   CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5576   MATCH_MP_TAC(SET_RULE
5577    `!s t u. x IN s /\ s SUBSET t /\ t SUBSET u /\ u SUBSET v ==> x IN v`) THEN
5578   MAP_EVERY EXISTS_TAC
5579    [`convex hull a:real^N->bool`; `convex hull b:real^N->bool`;
5580     `affine hull b:real^N->bool`] THEN
5581   ASM_SIMP_TAC[HULL_INC; CONVEX_HULL_SUBSET_AFFINE_HULL] THEN
5582   MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]);;
5583
5584 let FINITE_FACES_OF_SIMPLEX = prove
5585  (`!n s. n simplex s ==> FINITE {f | f face_of s}`,
5586   REPEAT GEN_TAC THEN
5587   DISCH_THEN(MP_TAC o MATCH_MP HAS_SIZE_FACES_OF_SIMPLEX) THEN
5588   SIMP_TAC[HAS_SIZE]);;
5589
5590 let CARD_FACES_OF_SIMPLEX = prove
5591  (`!n s. n simplex s ==> CARD {f | f face_of s} = 2 EXP (num_of_int(n + &1))`,
5592   REPEAT GEN_TAC THEN
5593   DISCH_THEN(MP_TAC o MATCH_MP HAS_SIZE_FACES_OF_SIMPLEX) THEN
5594   SIMP_TAC[HAS_SIZE]);;
5595
5596 let CHOOSE_SIMPLEX = prove
5597  (`!n. --(&1) <= n /\ n <= &(dimindex(:N)) ==> ?s:real^N->bool. n simplex s`,
5598   X_GEN_TAC `d:int` THEN
5599   REWRITE_TAC[INT_ARITH `--(&1):int <= n <=> n = --(&1) \/ &0 <= n`] THEN
5600   DISCH_THEN(CONJUNCTS_THEN2 DISJ_CASES_TAC MP_TAC) THENL
5601    [ASM_MESON_TAC[SIMPLEX_EMPTY]; ALL_TAC] THEN
5602   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM INT_OF_NUM_EXISTS]) THEN
5603   DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN
5604   REWRITE_TAC[INT_OF_NUM_LE; GSYM DIM_UNIV] THEN DISCH_TAC THEN
5605   FIRST_ASSUM(MP_TAC o MATCH_MP CHOOSE_SUBSPACE_OF_SUBSPACE) THEN
5606   DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN
5607   MP_TAC(ISPEC `s:real^N->bool` BASIS_EXISTS) THEN
5608   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
5609   X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN
5610   EXISTS_TAC `convex hull ((vec 0:real^N) INSERT c)` THEN
5611   REWRITE_TAC[simplex] THEN EXISTS_TAC `(vec 0:real^N) INSERT c` THEN
5612   FIRST_ASSUM(ASSUME_TAC o MATCH_MP INDEPENDENT_NONZERO) THEN
5613   FIRST_ASSUM(ASSUME_TAC o MATCH_MP INDEPENDENT_IMP_FINITE) THEN
5614   ASM_SIMP_TAC[CARD_CLAUSES; GSYM INT_OF_NUM_SUC] THEN
5615   ASM_SIMP_TAC[INDEPENDENT_IMP_AFFINE_DEPENDENT_0] THEN
5616   ASM_MESON_TAC[HAS_SIZE]);;
5617
5618 let CHOOSE_POLYTOPE = prove
5619  (`!n. --(&1) <= n /\ n <= &(dimindex(:N))
5620        ==> ?s:real^N->bool. polytope s /\ aff_dim s = n`,
5621   MESON_TAC[CHOOSE_SIMPLEX; SIMPLEX_IMP_POLYTOPE; AFF_DIM_SIMPLEX]);;
5622
5623 (* ------------------------------------------------------------------------- *)
5624 (* Simplicial complexes and triangulations.                                  *)
5625 (* ------------------------------------------------------------------------- *)
5626
5627 let simplicial_complex = new_definition
5628  `simplicial_complex c <=>
5629         FINITE c /\
5630         (!s. s IN c ==> ?n. n simplex s) /\
5631         (!f s. s IN c /\ f face_of s ==> f IN c) /\
5632         (!s s'. s IN c /\ s' IN c
5633                 ==> (s INTER s') face_of s /\ (s INTER s') face_of s')`;;
5634
5635 let triangulation = new_definition
5636  `triangulation(tr:(real^N->bool)->bool) <=>
5637         FINITE tr /\
5638         (!t. t IN tr ==> ?n. n simplex t) /\
5639         (!t t'. t IN tr /\ t' IN tr
5640                 ==> (t INTER t') face_of t /\ (t INTER t') face_of t')`;;
5641
5642 let SIMPLICIAL_COMPLEX_IMP_TRIANGULATION = prove
5643  (`!tr. simplicial_complex tr ==> triangulation tr`,
5644   REWRITE_TAC[triangulation; simplicial_complex] THEN MESON_TAC[]);;
5645
5646 let TRIANGULATION_SUBSET = prove
5647  (`!tr:(real^N->bool)->bool tr'.
5648         triangulation tr /\ tr' SUBSET tr ==> triangulation tr'`,
5649   REWRITE_TAC[triangulation] THEN
5650   MESON_TAC[SUBSET; FINITE_SUBSET]);;
5651
5652 let TRIANGULATION_UNION = prove
5653  (`!tr1 tr2.
5654         triangulation(tr1 UNION tr2) <=>
5655         triangulation tr1 /\ triangulation tr2 /\
5656         (!s t. s IN tr1 /\ t IN tr2
5657                ==> s INTER t face_of s /\ s INTER t face_of t)`,
5658   REWRITE_TAC[triangulation; FINITE_UNION; IN_UNION] THEN
5659   MESON_TAC[INTER_COMM]);;
5660
5661 let TRIANGULATION_INTER_SIMPLEX = prove
5662  (`!tr t t':real^N->bool.
5663         triangulation tr /\ t IN tr /\ t' IN tr
5664         ==> t INTER t' = convex hull ({x | x extreme_point_of t} INTER
5665                                       {x | x extreme_point_of t'})`,
5666   REWRITE_TAC[triangulation] THEN REPEAT STRIP_TAC THEN
5667   FIRST_X_ASSUM(MP_TAC o SPECL [`t:real^N->bool`; `t':real^N->bool`]) THEN
5668   ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
5669   FIRST_X_ASSUM(fun th -> MAP_EVERY (MP_TAC o C SPEC th)
5670    [`t:real^N->bool`; `t':real^N->bool`]) THEN
5671   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
5672   X_GEN_TAC `m:int` THEN DISCH_TAC THEN X_GEN_TAC `n:int` THEN DISCH_TAC THEN
5673   MP_TAC(ISPECL [`m:int`; `t':real^N->bool`;
5674                  `t INTER t':real^N->bool`] FACE_OF_SIMPLEX_SUBSET) THEN
5675   MP_TAC(ISPECL [`n:int`; `t:real^N->bool`;
5676                  `t INTER t':real^N->bool`] FACE_OF_SIMPLEX_SUBSET) THEN
5677   ASM_SIMP_TAC[] THEN
5678   DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN
5679   DISCH_THEN(X_CHOOSE_THEN `d':real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN
5680   MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
5681    [ALL_TAC;
5682     MATCH_MP_TAC HULL_MINIMAL THEN
5683     CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[CONVEX_INTER; CONVEX_SIMPLEX]] THEN
5684     SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM; extreme_point_of]] THEN
5685   MATCH_MP_TAC SUBSET_TRANS THEN
5686   EXISTS_TAC `convex hull {x:real^N | x extreme_point_of (t INTER t')}` THEN
5687   CONJ_TAC THENL
5688    [MATCH_MP_TAC(SET_RULE `s = t ==> s SUBSET t`) THEN
5689     MATCH_MP_TAC KREIN_MILMAN_MINKOWSKI THEN
5690     ASM_MESON_TAC[COMPACT_INTER; CONVEX_INTER; COMPACT_SIMPLEX; CONVEX_SIMPLEX];
5691     MATCH_MP_TAC HULL_MONO THEN REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THENL
5692      [SUBST1_TAC(SYM(ASSUME `convex hull d:real^N->bool = t INTER t'`));
5693       SUBST1_TAC(SYM(ASSUME `convex hull d':real^N->bool = t INTER t'`))] THEN
5694     REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN
5695     DISCH_THEN(MP_TAC o MATCH_MP EXTREME_POINT_OF_CONVEX_HULL) THEN
5696     ASM SET_TAC[]]);;
5697
5698 let TRIANGULATION_SIMPLICIAL_COMPLEX = prove
5699  (`!tr. triangulation tr
5700         ==> simplicial_complex {f:real^N->bool | ?t. t IN tr /\ f face_of t}`,
5701   let lemma = prove
5702    (`{f | ?t. t IN tr /\ P f t} = UNIONS (IMAGE (\t. {f | P f t}) tr)`,
5703     GEN_REWRITE_TAC I [EXTENSION] THEN
5704     REWRITE_TAC[IN_ELIM_THM; IN_UNIONS; IN_IMAGE; LEFT_AND_EXISTS_THM] THEN
5705     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
5706     REWRITE_TAC[GSYM CONJ_ASSOC; UNWIND_THM2; IN_ELIM_THM]) in
5707   REWRITE_TAC[triangulation; simplicial_complex] THEN
5708   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN
5709   REWRITE_TAC[IN_ELIM_THM] THEN GEN_TAC THEN
5710   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
5711   REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN STRIP_TAC THEN
5712   REPEAT CONJ_TAC THENL
5713    [REWRITE_TAC[lemma] THEN ASM_SIMP_TAC[FINITE_UNIONS; FINITE_IMAGE] THEN
5714     ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN
5715     ASM_MESON_TAC[FINITE_FACES_OF_SIMPLEX];
5716     ASM_MESON_TAC[SIMPLEX_FACE_OF_SIMPLEX];
5717     ASM_MESON_TAC[FACE_OF_TRANS];
5718     ASM_MESON_TAC[FACE_OF_INTER_SUBFACE]]);;
5719
5720 (* ------------------------------------------------------------------------- *)
5721 (* Subdividing a cell complex (not necessarily simplicial).                  *)
5722 (* ------------------------------------------------------------------------- *)
5723
5724 let CELL_COMPLEX_SUBDIVISION_EXISTS = prove
5725  (`!m:(real^N->bool)->bool d e.
5726      &0 < e /\
5727      FINITE m /\
5728      (!c. c IN m ==> polytope c) /\
5729      (!c. c IN m ==> aff_dim c <= d) /\
5730      (!c1 c2. c1 IN m /\ c2 IN m
5731               ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2)
5732      ==> ?m'. (!c. c IN m' ==> diameter c < e) /\
5733               UNIONS m' = UNIONS m /\
5734               FINITE m' /\
5735               (!c. c IN m' ==> polytope c) /\
5736               (!c. c IN m' ==> aff_dim c <= d) /\
5737               (!c1 c2. c1 IN m' /\ c2 IN m'
5738                        ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2)`,
5739   let lemma1 = prove
5740    (`a < abs(x - y)
5741      ==> &0 < a
5742          ==> ?n. integer n /\ (x < n * a /\ n * a < y \/
5743                                y <  n * a /\ n * a < x)`,
5744     REPEAT STRIP_TAC THEN
5745     ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; GSYM REAL_LT_RDIV_EQ] THEN
5746     MATCH_MP_TAC INTEGER_EXISTS_BETWEEN_ABS_LT THEN
5747     REWRITE_TAC[real_div; GSYM REAL_SUB_RDISTRIB; REAL_ABS_MUL] THEN
5748     ASM_SIMP_TAC[REAL_ABS_INV; REAL_ARITH `&0 < x ==> abs x = x`] THEN
5749     ASM_SIMP_TAC[GSYM real_div; REAL_LT_RDIV_EQ;
5750                  REAL_MUL_LID; REAL_LT_IMP_LE])
5751   and lemma2 = prove
5752    (`!m:(real^N->bool)->bool d.
5753         FINITE m /\
5754         (!c. c IN m ==> polytope c) /\
5755         (!c. c IN m ==> aff_dim c <= d) /\
5756         (!c1 c2. c1 IN m /\ c2 IN m
5757                  ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2)
5758         ==> !i. FINITE i
5759                 ==> ?m'. UNIONS m' = UNIONS m /\
5760                          FINITE m' /\
5761                          (!c. c IN m' ==> polytope c) /\
5762                          (!c. c IN m' ==> aff_dim c <= d) /\
5763                          (!c1 c2. c1 IN m' /\ c2 IN m'
5764                                   ==> c1 INTER c2 face_of c1 /\
5765                                       c1 INTER c2 face_of c2) /\
5766                          (!c x y. c IN m' /\ x IN c /\ y IN c
5767                                   ==> !a b. (a,b) IN i
5768                                             ==> a dot x <= b /\ a dot y <= b \/
5769                                                 a dot x >= b /\ a dot y >= b)`,
5770     REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
5771     REWRITE_TAC[NOT_IN_EMPTY; FORALL_PAIR_THM] THEN CONJ_TAC THENL
5772      [EXISTS_TAC `m:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
5773     MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`; `i:(real^N#real)->bool`] THEN
5774     GEN_REWRITE_TAC I [IMP_CONJ] THEN
5775     DISCH_THEN(X_CHOOSE_THEN `n:(real^N->bool)->bool` MP_TAC) THEN
5776     DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) MP_TAC) THEN
5777     POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT STRIP_TAC THEN
5778     EXISTS_TAC `{c INTER {x:real^N | a dot x <= b} | c IN n} UNION
5779                 {c INTER {x:real^N | a dot x >= b} | c IN n}` THEN
5780     REPEAT CONJ_TAC THENL
5781      [REWRITE_TAC[UNIONS_UNION; GSYM INTER_UNIONS; GSYM UNION_OVER_INTER] THEN
5782       MATCH_MP_TAC(SET_RULE `(!x. x IN s) ==> t INTER s = t`) THEN
5783       REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC;
5784       ASM_SIMP_TAC[FINITE_UNION; SIMPLE_IMAGE; FINITE_IMAGE];
5785       REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
5786       ASM_SIMP_TAC[POLYTOPE_INTER_POLYHEDRON; POLYHEDRON_HALFSPACE_LE;
5787                    POLYHEDRON_HALFSPACE_GE];
5788       REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
5789       ASM_MESON_TAC[INT_LE_TRANS; AFF_DIM_SUBSET; INTER_SUBSET];
5790       REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
5791       ASM_REWRITE_TAC[] THEN
5792       ONCE_REWRITE_TAC[SET_RULE
5793       `(s INTER t) INTER (s' INTER t') = (s INTER s') INTER (t INTER t')`] THEN
5794       MATCH_MP_TAC FACE_OF_INTER_INTER THEN ASM_SIMP_TAC[] THEN
5795       SIMP_TAC[SET_RULE `s INTER s = s`; FACE_OF_REFL; CONVEX_HALFSPACE_LE;
5796                CONVEX_HALFSPACE_GE] THEN
5797       REWRITE_TAC[INTER; IN_ELIM_THM; HYPERPLANE_FACE_OF_HALFSPACE_LE;
5798                   HYPERPLANE_FACE_OF_HALFSPACE_GE;
5799                   REAL_ARITH `a <= b /\ a >= b <=> a = b`;
5800                   REAL_ARITH `a >= b /\ a <= b <=> a = b`];
5801       REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_UNION; FORALL_AND_THM;
5802                   IN_INSERT;
5803                   TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN
5804       REWRITE_TAC[FORALL_IN_GSPEC; IN_INTER; IN_ELIM_THM; PAIR_EQ] THEN
5805       SIMP_TAC[] THEN ASM_MESON_TAC[]]) in
5806   REPEAT STRIP_TAC THEN
5807   SUBGOAL_THEN `bounded(UNIONS m:real^N->bool)` MP_TAC THENL
5808    [ASM_SIMP_TAC[BOUNDED_UNIONS; POLYTOPE_IMP_BOUNDED]; ALL_TAC] THEN
5809   REWRITE_TAC[BOUNDED_POS_LT; LEFT_IMP_EXISTS_THM] THEN
5810   X_GEN_TAC `B:real` THEN REWRITE_TAC[] THEN STRIP_TAC THEN
5811   MP_TAC(ISPECL [`--B / (e / &2 / &(dimindex(:N)))`;
5812                  `B / (e / &2 / &(dimindex(:N)))`] FINITE_INTSEG) THEN
5813   ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_HALF;
5814                REAL_LT_DIV; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN
5815   REWRITE_TAC[REAL_BOUNDS_LE] THEN ABBREV_TAC
5816    `k = {i | integer i /\ abs(i * e / &2 / &(dimindex(:N))) <= B}` THEN
5817   DISCH_TAC THEN
5818   MP_TAC(ISPECL [`m:(real^N->bool)->bool`; `d:int`] lemma2) THEN
5819   ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC
5820    `{ (basis i:real^N,j * e / &2 / &(dimindex(:N))) |
5821       i IN 1..dimindex(:N) /\ j IN k}`) THEN
5822   ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT; FINITE_NUMSEG] THEN
5823   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:(real^N->bool)->bool` THEN
5824   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5825   X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN
5826   MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN
5827   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIAMETER_LE THEN
5828   CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
5829   MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
5830   W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
5831   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
5832   MATCH_MP_TAC SUM_BOUND_GEN THEN
5833   REWRITE_TAC[FINITE_NUMSEG; CARD_NUMSEG_1; NUMSEG_EMPTY] THEN
5834   REWRITE_TAC[NOT_LT; DIMINDEX_GE_1; IN_NUMSEG; VECTOR_SUB_COMPONENT] THEN
5835   X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN
5836   DISCH_THEN(MP_TAC o MATCH_MP lemma1) THEN
5837   ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV;
5838                REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN
5839   DISCH_THEN(X_CHOOSE_THEN `j:real` (CONJUNCTS_THEN ASSUME_TAC)) THEN
5840   FIRST_X_ASSUM(MP_TAC o SPECL [`c:real^N->bool`; `x:real^N`; `y:real^N`]) THEN
5841   ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o
5842     SPECL [`basis i:real^N`; `j * e / &2 / &(dimindex(:N))`]) THEN
5843   ASM_SIMP_TAC[DOT_BASIS; IN_ELIM_THM; NOT_IMP] THEN
5844   CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
5845   MAP_EVERY EXISTS_TAC [`i:num`; `j:real`] THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN
5846   EXPAND_TAC "k" THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN
5847   FIRST_X_ASSUM DISJ_CASES_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
5848    (REAL_ARITH `a < x /\ x < b
5849                 ==> abs a <= c /\ abs b <= c ==> abs x <= c`)) THEN
5850   CONJ_TAC THEN
5851   W(MP_TAC o PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN
5852   ASM_REWRITE_TAC[] THEN
5853   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
5854   MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5855   ASM SET_TAC[]);;