text_formalization/packing/Rogers.hl

   1 (* ========================================================================== *)
   2 (* FLYSPECK - BOOK FORMALIZATION                                              *)
   3 (*                                                                            *)
   4 (* Chapter: Packing/Rogers simplex                                            *)
   5 (* Author: Alexey Solovyev                                                    *)
   6 (* Date: 2010-08-12                                                           *)
   7 (* ========================================================================== *)
   8
   9
  10 flyspeck_needs "packing/pack3.hl";;
  11 flyspeck_needs "fan/HypermapAndFan.hl";;
  12
  13
  14 module Rogers = struct
  15
  16 open Pack_defs;;
  17 open Sphere;;
  18 open Packing3;;
  19
  20
  21
  22 (*****************************************************************)
  23
  24 (*****************************************)
  25 (* Faces                                 *)
  26 (*****************************************)
  27
  28
  29 (*********************************************)
  30 (* KHEJKCI                                   *)
  31 (*********************************************)
  32
  33
  34 (* A(u, v) is a face of A+(u, v) *)
  35 let BIS_FACE_OF_BIS_LE = prove(`!(u:real^N) v. bis u v face_of bis_le u v`,
  36    REPEAT GEN_TAC THEN
  37     SUBGOAL_THEN `bis (u:real^N) v = bis_le u v INTER bis u v` (fun th -> ONCE_REWRITE_TAC[th]) THENL
  38     [
  39       REWRITE_TAC[bis; bis_le; EXTENSION; IN_INTER; IN_ELIM_THM] THEN
  40         REAL_ARITH_TAC;
  41       ALL_TAC
  42     ] THEN
  43     REWRITE_TAC[BIS_EQ_HYPERPLANE] THEN
  44     MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN
  45     REWRITE_TAC[CONVEX_BIS_LE; BIS_LE_EQ_HALFSPACE; IN_ELIM_THM]);;
  46
  47
  48
  49
  50
  51 (* Generalized version of the target theorem *)
  52 let KHEJKCI_GEN = prove(`!V k r ul vl. saturated V /\ packing V /\ barV V k ul /\ barV V r vl /\ initial_sublist ul vl ==>
  53    (voronoi_list V vl) face_of (voronoi_list V ul) `,
  54   REWRITE_TAC[INITIAL_SUBLIST] THEN
  55     REPEAT STRIP_TAC THEN
  56     SUBGOAL_THEN `?h tl. ul = CONS (h:real^3) tl` MP_TAC THENL
  57     [
  58       ASM_MESON_TAC[BARV_CONS];
  59       ALL_TAC
  60     ] THEN
  61
  62     STRIP_TAC THEN
  63     SUBGOAL_THEN `voronoi_list (V:real^3->bool) ul = voronoi_closed V h INTER INTERS {bis h u | u IN set_of_list tl}` (fun th -> REWRITE_TAC[th]) THENL
  64     [
  65       MATCH_MP_TAC VORONOI_LIST_BIS THEN
  66         ASM_MESON_TAC[BARV_SUBSET];
  67       ALL_TAC
  68     ] THEN
  69
  70     SUBGOAL_THEN `voronoi_list (V:real^3->bool) vl = voronoi_closed V h INTER INTERS {bis h u | u IN set_of_list (APPEND tl yl)}` (fun th -> REWRITE_TAC[th]) THENL
  71     [
  72       MATCH_MP_TAC VORONOI_LIST_BIS THEN
  73         ASM_MESON_TAC[BARV_SUBSET; APPEND];
  74       ALL_TAC
  75     ] THEN
  76
  77     REWRITE_TAC[face_of; IN_SET_OF_LIST; MEM_APPEND] THEN
  78     REPEAT CONJ_TAC THENL
  79     [
  80       SET_TAC[];
  81       MATCH_MP_TAC CONVEX_INTER THEN CONJ_TAC THENL
  82         [
  83           ASM_MESON_TAC[DRUQUFE];
  84           ALL_TAC
  85         ] THEN
  86
  87         MATCH_MP_TAC CONVEX_INTERS THEN
  88         REWRITE_TAC[IN_ELIM_THM] THEN
  89         MESON_TAC[CONVEX_BIS];
  90
  91       ALL_TAC
  92     ] THEN
  93
  94
  95     REPEAT GEN_TAC THEN
  96     SIMP_TAC[IN_INTER; IN_INTERS; IN_ELIM_THM] THEN
  97     REPLICATE_TAC 2 (DISCH_THEN (CONJUNCTS_THEN2 (ASSUME_TAC o CONJUNCT1) MP_TAC)) THEN
  98     STRIP_TAC THEN
  99     SUBGOAL_THEN `!u:real^3. u IN V ==> a:real^3 IN bis_le h u /\ b:real^3 IN bis_le h u` ASSUME_TAC THENL
 100     [
 101       REPLICATE_TAC 3 (POP_ASSUM (fun th -> ALL_TAC)) THEN GEN_TAC THEN
 102         POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
 103         REWRITE_TAC[voronoi_closed; bis_le; IN_ELIM_THM; IN] THEN
 104         MESON_TAC[];
 105       ALL_TAC
 106     ] THEN
 107
 108     SUBGOAL_THEN `!u:real^3. (MEM u tl ==> u IN V) /\ (MEM u yl ==> u IN V)` ASSUME_TAC THENL
 109     [
 110       GEN_TAC THEN REPLICATE_TAC 6 (POP_ASSUM (fun th -> ALL_TAC)) THEN
 111         REPLICATE_TAC 2 (POP_ASSUM MP_TAC) THEN
 112         POP_ASSUM (MP_TAC o (fun th -> MATCH_MP BARV_SUBSET th)) THEN
 113         POP_ASSUM (MP_TAC o (fun th -> MATCH_MP BARV_SUBSET th)) THEN
 114         REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
 115         REWRITE_TAC[IMP_CONJ_ALT] THEN
 116         REPLICATE_TAC 2 (DISCH_THEN (fun th -> REWRITE_TAC[th])) THEN
 117         REWRITE_TAC[SUBSET; IN_SET_OF_LIST; MEM_APPEND; MEM] THEN
 118         SIMP_TAC[];
 119       ALL_TAC
 120     ] THEN
 121
 122     SUBGOAL_THEN `!u:real^3. u IN V /\ x IN bis h u ==> a IN bis h u /\ b IN bis h u` ASSUME_TAC THENL
 123     [
 124       POP_ASSUM (fun th -> ALL_TAC) THEN GEN_TAC THEN
 125         STRIP_TAC THEN
 126         FIRST_X_ASSUM (MP_TAC o (SPEC `u:real^3`)) THEN
 127         ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
 128         MP_TAC (ISPECL [`h:real^3`; `u:real^3`] BIS_FACE_OF_BIS_LE) THEN
 129         REWRITE_TAC[face_of] THEN
 130         DISCH_THEN (CONJUNCTS_THEN2 (fun th -> ALL_TAC) (MP_TAC o CONJUNCT2)) THEN
 131         DISCH_THEN (MP_TAC o ISPECL [`a:real^3`; `b:real^3`; `x:real^3`]) THEN
 132         ASM_SIMP_TAC[];
 133       ALL_TAC
 134     ] THEN
 135
 136     ASM_MESON_TAC[]);;
 137
 138
 139
 140
 141 (* vor_list -> barV *)
 142 let KHEJKCI = prove(`!V k ul. saturated V /\ packing V /\ barV V k ul ==>
 143    ((voronoi_list V ul)   face_of (voronoi_closed V (HD ul)) )`,
 144   REPEAT STRIP_TAC THEN
 145     FIRST_ASSUM (MP_TAC o (fun th -> MATCH_MP BARV_CONS th)) THEN
 146     STRIP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
 147     REWRITE_TAC[GSYM VORONOI_LIST_SING] THEN
 148     MATCH_MP_TAC KHEJKCI_GEN THEN
 149     EXISTS_TAC `0` THEN EXISTS_TAC `k:num` THEN
 150     SUBGOAL_THEN `initial_sublist [h:real^3] ul` ASSUME_TAC THENL
 151     [
 152       ASM_REWRITE_TAC[INITIAL_SUBLIST; APPEND] THEN MESON_TAC[];
 153       ALL_TAC
 154     ] THEN
 155     ASM_REWRITE_TAC[] THEN
 156     MP_TAC (SPECL [`V:real^3->bool`; `k:num`; `ul:(real^3)list`; `[h:real^3]`] BARV_INITIAL_SUBLIST) THEN
 157     ASM_REWRITE_TAC[LENGTH; ARITH_RULE `0 < SUC 0`; ARITH_RULE `SUC 0 - 1 = 0`]);;
 158
 159
 160
 161
 162
 163
 164 (*********************************************)
 165 (* IDBEZAL                                   *)
 166 (* Characterization of facets of Omega(V,W)  *)
 167 (*********************************************)
 168
 169
 170
 171 (* Canonical representation for Omega(V, barV(k)) *)
 172 let VORONOI_BARV_CANONICAL = prove(`!V k ul. packing V /\ saturated V /\ barV V k ul
 173     ==> ?K. FINITE K /\ voronoi_list V ul = affine hull (voronoi_list V ul) INTER INTERS K /\
 174         (!a. a IN K ==> (?v. v IN V /\ ~(v = HD ul) /\ (a = bis_le v (HD ul) \/ a = bis_le (HD ul) v))) /\
 175         (!K'. K' PSUBSET K ==> (voronoi_list V ul) PSUBSET (affine hull (voronoi_list V ul) INTER INTERS K'))`,
 176   REPEAT STRIP_TAC THEN
 177     MP_TAC (SPECL [`V:real^3->bool`; `k:num`; `ul:(real^3)list`] BARV_CONS) THEN
 178     MP_TAC (SPECL [`V:real^3->bool`; `k:num`; `ul:(real^3)list`] BARV_SUBSET) THEN
 179     ASM_REWRITE_TAC[] THEN
 180     REPEAT STRIP_TAC THEN
 181     MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `h:real^3`; `t:(real^3)list`] VORONOI_LIST_CANONICAL) THEN
 182     POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
 183     DISCH_THEN (LABEL_TAC "A") THEN
 184     DISCH_TAC THEN REMOVE_THEN "A" MP_TAC THEN
 185     POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
 186     ASM_REWRITE_TAC[] THEN
 187     DISCH_THEN (fun th -> REWRITE_TAC[th]));;
 188
 189
 190
 191
 192 let REAL_LINE_BOUNDED = prove(`!a b. (!t. t * a <= b) ==> a = &0`,
 193   REPEAT STRIP_TAC THEN
 194     DISJ_CASES_TAC (TAUT `a = &0 \/ ~(a = &0)`) THEN ASM_REWRITE_TAC[] THEN
 195     FIRST_X_ASSUM (MP_TAC o SPEC `(b + &1) * inv(a)`) THEN
 196     ASM_REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
 197     ASM_SIMP_TAC[REAL_MUL_LINV] THEN
 198     REAL_ARITH_TAC);;
 199
 200
 201
 202 let REAL_NEG_LE_RMUL = prove(`!x y z. z < &0 ==> (x <= y <=> y * z <= x * z)`,
 203                              REPEAT STRIP_TAC THEN
 204                                MP_TAC (SPECL [`x:real`; `y:real`; `--z:real`] REAL_LE_LMUL_EQ) THEN
 205                                ASM_REWRITE_TAC[REAL_NEG_GT0] THEN
 206                                REWRITE_TAC[REAL_MUL_LNEG; REAL_LE_NEG; REAL_MUL_AC] THEN
 207                                SIMP_TAC[]);;
 208
 209
 210
 211
 212 let HALFSPACE_EQ = prove(`!(a:real^N) b c d. {x | a dot x <= b} = {x | c dot x <= d} <=> (?t. c = t % a /\ d = t * b /\ &0 < t) \/ (a = vec 0 /\ c = vec 0 /\ ((&0 <= b /\ &0 <= d) \/ (b < &0 /\ d < &0)))`,
 213    REPEAT STRIP_TAC THEN
 214      REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
 215      EQ_TAC THENL
 216      [
 217        DISCH_TAC THEN
 218        DISJ_CASES_TAC (TAUT `(a:real^N) = vec 0 \/ ~(a = vec 0)`) THENL
 219          [
 220            DISJ2_TAC THEN
 221              ASM_REWRITE_TAC[] THEN
 222              DISJ_CASES_TAC (TAUT `(c:real^N) = vec 0 \/ ~(c = vec 0)`) THEN ASM_REWRITE_TAC[] THENL
 223              [
 224                FIRST_X_ASSUM (MP_TAC o check (is_forall o concl)) THEN
 225                  ASM_REWRITE_TAC[DOT_LZERO] THEN
 226                  REAL_ARITH_TAC;
 227                ALL_TAC
 228              ] THEN
 229
 230
 231              SUBGOAL_TAC "A" `~((c:real^N) dot c = &0)` [ ASM_REWRITE_TAC[DOT_EQ_0] ] THEN
 232              DISJ_CASES_TAC (REAL_ARITH `&0 <= b \/ b < &0`) THENL
 233              [
 234                FIRST_X_ASSUM (MP_TAC o SPEC `((d + &1) * inv((c:real^N) dot c)) % c`) THEN
 235                  ASM_REWRITE_TAC[DOT_LZERO] THEN
 236                  REWRITE_TAC[DOT_RMUL; GSYM REAL_MUL_ASSOC] THEN
 237                  ASM_SIMP_TAC[REAL_MUL_LINV] THEN
 238                  REAL_ARITH_TAC;
 239
 240                FIRST_X_ASSUM (MP_TAC o SPEC `(d * inv((c:real^N) dot c)) % c`) THEN
 241                  ASM_REWRITE_TAC[DOT_LZERO] THEN
 242                  ASM_SIMP_TAC[REAL_ARITH `b < &0 ==> ((&0 <= b) <=> F)`] THEN
 243                  REWRITE_TAC[DOT_RMUL; GSYM REAL_MUL_ASSOC] THEN
 244                  ASM_SIMP_TAC[REAL_MUL_LINV] THEN
 245                  REWRITE_TAC[REAL_MUL_RID; REAL_LE_REFL]
 246              ];
 247
 248            ALL_TAC
 249          ] THEN
 250
 251          DISJ1_TAC THEN
 252          SUBGOAL_TAC "A" `~((a:real^N dot a) = &0)` [ ASM_REWRITE_TAC[DOT_EQ_0] ] THEN
 253          SUBGOAL_THEN `!u. u*((a:real^N dot a)*(c dot c) - (a dot c)*(a dot c)) <= d*(a dot a) - b*(a dot c)` MP_TAC THENL
 254          [
 255            GEN_TAC THEN
 256              FIRST_X_ASSUM (MP_TAC o SPEC `((b - u * (a:real^N dot c)) * inv(a dot a)) % a + u % c`) THEN
 257              REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN
 258              REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
 259              ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_RID; REAL_ARITH `(b:real - a) + a = b`; REAL_LE_REFL] THEN
 260
 261              DISCH_TAC THEN
 262              ASSUME_TAC (ISPEC `a:real^N` DOT_POS_LE) THEN
 263
 264              MP_TAC (SPECL [`(b - u * (a:real^N dot c)) * inv(a dot a) * (c dot a) + u * (c dot c)`; `d:real`; `a:real^N dot a`] REAL_LE_RMUL) THEN
 265              ASM_REWRITE_TAC[REAL_ADD_RDISTRIB] THEN
 266              REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
 267              ASM_SIMP_TAC[REAL_FIELD `~(a:real^N dot a = &0) ==> inv(a dot a) * (c dot a) * (a dot a) = (c dot a)`] THEN
 268              REWRITE_TAC[REAL_SUB_RDISTRIB; REAL_SUB_LDISTRIB; DOT_SYM] THEN
 269              REAL_ARITH_TAC;
 270            ALL_TAC
 271          ] THEN
 272
 273          DISCH_THEN (MP_TAC o (fun th -> MATCH_MP REAL_LINE_BOUNDED th)) THEN
 274          REWRITE_TAC[GSYM REAL_POW_2; REAL_ARITH `a - b = &0 <=> b = a`] THEN
 275          DISCH_TAC THEN
 276          SUBGOAL_THEN `?t. c = t % (a:real^N)` MP_TAC THENL
 277          [
 278            MP_TAC (SPECL [`a:real^N`; `c:real^N`] DOT_CAUCHY_SCHWARZ_EQUAL) THEN
 279              ASM_REWRITE_TAC[COLLINEAR_LEMMA] THEN
 280              STRIP_TAC THENL
 281              [
 282                EXISTS_TAC `&0` THEN
 283                  ASM_REWRITE_TAC[VECTOR_MUL_LZERO];
 284                ALL_TAC
 285              ] THEN
 286              EXISTS_TAC `c':real` THEN ASM_REWRITE_TAC[];
 287
 288            ALL_TAC
 289          ] THEN
 290
 291          STRIP_TAC THEN
 292          EXISTS_TAC `t:real` THEN
 293          ASM_REWRITE_TAC[] THEN
 294          FIRST_X_ASSUM (MP_TAC o check (is_forall o concl)) THEN
 295          ASM_REWRITE_TAC[DOT_LMUL] THEN
 296          DISCH_TAC THEN
 297          FIRST_ASSUM (MP_TAC o SPEC `(b * inv(a:real^N dot a)) % a`) THEN
 298          FIRST_ASSUM (MP_TAC o SPEC `(d * inv(t) * inv(a:real^N dot a)) % a`) THEN
 299          REWRITE_TAC[DOT_RMUL; GSYM REAL_MUL_ASSOC] THEN
 300          ASM_SIMP_TAC[REAL_MUL_LINV] THEN
 301          REWRITE_TAC[REAL_MUL_RID; REAL_LE_REFL] THEN
 302          SUBGOAL_THEN `~(t = &0)` ASSUME_TAC THENL
 303          [
 304            DISJ_CASES_TAC (TAUT `~(t = &0) \/ t = &0`) THEN ASM_REWRITE_TAC[] THEN
 305              FIRST_X_ASSUM (MP_TAC o check (is_forall o concl)) THEN
 306              ASM_REWRITE_TAC[REAL_ARITH `&0 * a = &0`] THEN
 307              DISCH_TAC THEN
 308              DISJ_CASES_TAC (REAL_ARITH `&0 <= d \/ d < &0`) THENL
 309              [
 310                FIRST_X_ASSUM (MP_TAC o SPEC `((b + &1) * inv((a:real^N) dot a)) % a`) THEN
 311                  ASM_REWRITE_TAC[DOT_LZERO] THEN
 312                  REWRITE_TAC[DOT_RMUL; GSYM REAL_MUL_ASSOC] THEN
 313                  ASM_SIMP_TAC[REAL_MUL_LINV] THEN
 314                  REAL_ARITH_TAC;
 315
 316                FIRST_X_ASSUM (MP_TAC o SPEC `(b * inv((a:real^N) dot a)) % a`) THEN
 317                  ASM_REWRITE_TAC[DOT_LZERO] THEN
 318                  ASM_SIMP_TAC[REAL_ARITH `b < &0 ==> ((&0 <= b) <=> F)`] THEN
 319                  REWRITE_TAC[DOT_RMUL; GSYM REAL_MUL_ASSOC] THEN
 320                  ASM_SIMP_TAC[REAL_MUL_LINV] THEN
 321                  REWRITE_TAC[REAL_MUL_RID; REAL_LE_REFL]
 322              ];
 323
 324            ALL_TAC
 325          ] THEN
 326
 327          ASM_SIMP_TAC[REAL_FIELD `~(t = &0) ==> t * d * inv t = d`] THEN
 328          ASM_REWRITE_TAC[REAL_LE_REFL] THEN
 329
 330          SUBGOAL_THEN `&0 < t` ASSUME_TAC THENL
 331          [
 332            DISJ_CASES_TAC (REAL_ARITH `&0 < t \/ t <= &0`) THEN ASM_REWRITE_TAC[] THEN
 333              POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[REAL_LE_LT] THEN
 334              DISCH_TAC THEN
 335              DISJ_CASES_TAC (REAL_ARITH `t * b - d - &1 <= &0 \/ &0 < t * b - d - &1`) THENL
 336              [
 337                FIRST_X_ASSUM (MP_TAC o SPEC `((d + &1) * inv(t) * inv(a:real^N dot a)) % a`) THEN
 338                  REWRITE_TAC[DOT_RMUL; GSYM REAL_MUL_ASSOC] THEN
 339                  ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_RID; REAL_FIELD `~(t = &0) ==> (t * d * inv t = d)`] THEN
 340                  REWRITE_TAC[REAL_ARITH `d + &1 <= d <=> F`] THEN
 341                  SUBGOAL_THEN `(d + &1) * inv t <= b` MP_TAC THENL
 342                  [
 343                    MP_TAC (SPECL [`(d + &1) * inv t`; `b:real`; `t:real`] REAL_NEG_LE_RMUL) THEN
 344                      ASM_REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
 345                      DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
 346                      ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_RID] THEN
 347                      POP_ASSUM MP_TAC THEN
 348                      REAL_ARITH_TAC;
 349
 350                    ALL_TAC
 351                  ] THEN
 352                  MESON_TAC[];
 353
 354                ALL_TAC
 355              ] THEN
 356
 357              FIRST_X_ASSUM (MP_TAC o SPEC `(b * inv(a:real^N dot a)) % a`) THEN
 358              REWRITE_TAC[DOT_RMUL; GSYM REAL_MUL_ASSOC] THEN
 359              ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_RID; REAL_LE_REFL] THEN
 360              POP_ASSUM MP_TAC THEN
 361              REAL_ARITH_TAC;
 362
 363            ALL_TAC
 364          ] THEN
 365
 366          DISCH_TAC THEN
 367          SUBGOAL_THEN `d:real <= t * b` MP_TAC THENL
 368          [
 369            MP_TAC (SPECL [`t:real`; `(d:real) * inv t`; `b:real`] REAL_LE_LMUL) THEN
 370              ASM_SIMP_TAC[REAL_ARITH `&0 < t ==> &0 <= t`; REAL_FIELD `~(t = &0) ==> t * d * inv t = d`];
 371            ALL_TAC
 372          ] THEN
 373
 374          ASM_REWRITE_TAC[] THEN
 375          REAL_ARITH_TAC;
 376
 377        ALL_TAC
 378      ] THEN
 379
 380      STRIP_TAC THENL
 381      [
 382        GEN_TAC THEN
 383          ASM_REWRITE_TAC[DOT_LMUL] THEN
 384          ASM_SIMP_TAC[REAL_LE_LMUL_EQ];
 385
 386        GEN_TAC THEN
 387          ASM_REWRITE_TAC[DOT_LZERO];
 388
 389        GEN_TAC THEN
 390          ASM_REWRITE_TAC[DOT_LZERO] THEN
 391          POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
 392          REAL_ARITH_TAC
 393      ]);;
 394
 395
 396
 397 let HALFSPACE_EQ_BIS_LE_IMP_HYPERPLANE_EQ_BIS = prove(`!(a:real^N) b v w. ~(a = vec 0) /\ {x | a dot x <= b} = bis_le v w ==> {x | a dot x = b} = bis v w`,
 398    REPEAT GEN_TAC THEN
 399      REWRITE_TAC[BIS_LE_EQ_HALFSPACE; BIS_EQ_HYPERPLANE] THEN
 400      REWRITE_TAC[HALFSPACE_EQ] THEN
 401      REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[DOT_LZERO; EXTENSION; IN_ELIM_THM] THENL
 402      [
 403        GEN_TAC THEN
 404          REWRITE_TAC[DOT_LMUL] THEN
 405          REWRITE_TAC[REAL_EQ_MUL_LCANCEL] THEN
 406          ASM_SIMP_TAC[REAL_ARITH `&0 < t ==> ~(t = &0)`];
 407
 408        ASM_MESON_TAC[];
 409        ASM_MESON_TAC[]
 410      ]);;
 411
 412
 413
 414
 415
 416 (* A special version of the FACET_OF_POLYHEDRON_EXPLICIT theorem for bisectors *)
 417 let FACET_OF_POLYHEDRON_EXPLICIT_BIS = prove(`!(V:real^3->bool) K s u.
 418         FINITE K /\ s = affine hull s INTER INTERS K /\
 419         (!a. a IN K ==> (?v. v IN V /\ ~(v = u) /\ (a = bis_le v u \/ a = bis_le u v))) /\
 420         (!K'. K' PSUBSET K ==> s PSUBSET (affine hull s INTER INTERS K'))
 421         ==> (!c. c facet_of s <=> (?v. v IN V /\ (bis_le v u IN K \/ bis_le u v IN K) /\ c = s INTER bis u v))`,
 422   REPEAT STRIP_TAC THEN
 423     SUBGOAL_THEN `?a b. !h:real^3->bool. h IN K ==> ~(a h = vec 0) /\ h = {x | a h dot x <= b h}` MP_TAC THENL
 424         [
 425           POP_ASSUM (fun th -> ALL_TAC) THEN POP_ASSUM MP_TAC THEN
 426             REPLICATE_TAC 2 (POP_ASSUM (fun th -> ALL_TAC)) THEN
 427             DISCH_TAC THEN
 428             REWRITE_TAC[GSYM SKOLEM_THM] THEN
 429             GEN_TAC THEN
 430             REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN
 431             DISCH_TAC THEN
 432             FIRST_X_ASSUM (MP_TAC o SPEC `h:(real^3->bool)`) THEN
 433             ASM_REWRITE_TAC[BIS_LE_EQ_HALFSPACE] THEN STRIP_TAC THENL
 434             [
 435               EXISTS_TAC `&2 % (u - (v:real^3))` THEN
 436                 EXISTS_TAC `(u:real^3) dot u - (v:real^3) dot v` THEN
 437                 ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_ARITH `&2 = &0 <=> F`; VECTOR_SUB_EQ];
 438               EXISTS_TAC `&2 % ((v:real^3) - u)` THEN
 439                 EXISTS_TAC `(v:real^3) dot v - (u:real^3) dot u` THEN
 440                 ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_ARITH `&2 = &0 <=> F`; VECTOR_SUB_EQ]
 441             ];
 442
 443           ALL_TAC
 444         ] THEN
 445
 446         STRIP_TAC THEN
 447         MP_TAC (ISPECL [`s:(real^3->bool)`; `K:(real^3->bool)->bool`; `a:(real^3->bool)->real^3`; `b:(real^3->bool)->real`] FACET_OF_POLYHEDRON_EXPLICIT) THEN
 448         ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ ASM_MESON_TAC[]; ALL_TAC] THEN
 449
 450         DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
 451         EQ_TAC THENL
 452         [
 453           STRIP_TAC THEN
 454             FIRST_X_ASSUM (MP_TAC o SPEC `h:real^3->bool`) THEN
 455             FIRST_X_ASSUM ((fun th -> ALL_TAC) o check (is_forall o concl)) THEN
 456             FIRST_X_ASSUM (MP_TAC o SPEC `h:real^3->bool`) THEN
 457             ASM_REWRITE_TAC[] THEN
 458             REPEAT STRIP_TAC THENL
 459             [
 460               EXISTS_TAC `v:real^3` THEN
 461                 SUBGOAL_THEN `{x:real^3 | x | (a:(real^3->bool)->real^3) h dot x = b h} = bis u v` ASSUME_TAC THENL
 462                 [
 463                   MP_TAC (ISPECL [`(a:(real^3->bool)->real^3) h`; `(b:(real^3->bool)->real) h`; `v:real^3`; `u:real^3`] HALFSPACE_EQ_BIS_LE_IMP_HYPERPLANE_EQ_BIS) THEN
 464                     ASM_MESON_TAC[BIS_SYM];
 465                   ALL_TAC
 466                 ] THEN
 467                 ASM_MESON_TAC[];
 468
 469               EXISTS_TAC `v:real^3` THEN
 470                 SUBGOAL_THEN `{x:real^3 | x | (a:(real^3->bool)->real^3) h dot x = b h} = bis u v` ASSUME_TAC THENL
 471                 [
 472                   MP_TAC (ISPECL [`(a:(real^3->bool)->real^3) h`; `(b:(real^3->bool)->real) h`; `u:real^3`; `v:real^3`] HALFSPACE_EQ_BIS_LE_IMP_HYPERPLANE_EQ_BIS) THEN
 473                     ASM_MESON_TAC[];
 474                   ALL_TAC
 475                 ] THEN
 476                 ASM_MESON_TAC[]
 477             ];
 478
 479           ALL_TAC
 480         ] THEN
 481
 482         STRIP_TAC THENL
 483         [
 484           ABBREV_TAC `h = bis_le (v:real^3) u` THEN
 485             FIRST_X_ASSUM (MP_TAC o SPEC `h:real^3->bool`) THEN
 486             FIRST_X_ASSUM ((fun th -> ALL_TAC) o check (is_forall o concl)) THEN
 487             FIRST_X_ASSUM ((fun th -> ALL_TAC) o SPEC `h:real^3->bool`) THEN
 488             ASM_REWRITE_TAC[] THEN
 489             STRIP_TAC THEN
 490             EXISTS_TAC `h:real^3->bool` THEN
 491             SUBGOAL_THEN `{x:real^3 | x | (a:(real^3->bool)->real^3) h dot x = b h} = bis u v` ASSUME_TAC THENL
 492             [
 493               MP_TAC (ISPECL [`(a:(real^3->bool)->real^3) h`; `(b:(real^3->bool)->real) h`; `v:real^3`; `u:real^3`] HALFSPACE_EQ_BIS_LE_IMP_HYPERPLANE_EQ_BIS) THEN
 494                 ASM_MESON_TAC[BIS_SYM];
 495                 ALL_TAC
 496             ] THEN
 497             ASM_MESON_TAC[];
 498
 499           ABBREV_TAC `h = bis_le (u:real^3) v` THEN
 500             FIRST_X_ASSUM (MP_TAC o SPEC `h:real^3->bool`) THEN
 501             FIRST_X_ASSUM ((fun th -> ALL_TAC) o check (is_forall o concl)) THEN
 502             FIRST_X_ASSUM ((fun th -> ALL_TAC) o SPEC `h:real^3->bool`) THEN
 503             ASM_REWRITE_TAC[] THEN
 504             STRIP_TAC THEN
 505             EXISTS_TAC `h:real^3->bool` THEN
 506             SUBGOAL_THEN `{x:real^3 | x | (a:(real^3->bool)->real^3) h dot x = b h} = bis u v` ASSUME_TAC THENL
 507             [
 508               MP_TAC (ISPECL [`(a:(real^3->bool)->real^3) h`; `(b:(real^3->bool)->real) h`; `u:real^3`; `v:real^3`] HALFSPACE_EQ_BIS_LE_IMP_HYPERPLANE_EQ_BIS) THEN
 509                 ASM_MESON_TAC[BIS_SYM];
 510                 ALL_TAC
 511             ] THEN
 512             ASM_MESON_TAC[]
 513         ]);;
 514
 515
 516
 517
 518 (************************************************************)
 519 (* IDBEZAL: characterization of facets of Omega(V, ul)      *)
 520 (************************************************************)
 521
 522 (* vor_list -> barV *)
 523 let IDBEZAL = prove(`!V ul k F.  saturated V /\ packing V /\ barV V k ul /\ (k < 3) ==>
 524    (F facet_of voronoi_list V ul <=>
 525         (?vl. (F = voronoi_list V vl) /\ barV V (k+1) vl /\ (truncate_simplex k vl = ul)))`,
 526   REPEAT STRIP_TAC THEN
 527     EQ_TAC THENL
 528     [
 529       MP_TAC (SPECL [`V:real^3->bool`; `k:num`; `ul:(real^3)list`] VORONOI_BARV_CANONICAL) THEN
 530         ASM_REWRITE_TAC[] THEN
 531         STRIP_TAC THEN
 532         ABBREV_TAC `s = voronoi_list (V:real^3->bool) ul` THEN
 533
 534         MP_TAC (SPECL [`V:real^3->bool`; `K:(real^3->bool)->bool`; `s:real^3->bool`; `(HD ul):real^3`] FACET_OF_POLYHEDRON_EXPLICIT_BIS) THEN
 535
 536         ASM_REWRITE_TAC[] THEN
 537         ANTS_TAC THENL [ ASM_MESON_TAC[]; ALL_TAC ] THEN
 538         DISCH_TAC THEN DISCH_TAC THEN
 539         SUBGOAL_THEN `aff_dim (F':real^3->bool) = aff_dim (s:real^3->bool) - &1` ASSUME_TAC THENL
 540         [
 541           POP_ASSUM MP_TAC THEN
 542             REWRITE_TAC[facet_of] THEN
 543             SIMP_TAC[];
 544           ALL_TAC
 545         ] THEN
 546
 547         POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
 548         POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN
 549         DISCH_THEN (CHOOSE_THEN MP_TAC) THEN
 550         DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
 551         DISCH_THEN (ASSUME_TAC o CONJUNCT2) THEN
 552         DISCH_TAC THEN
 553         EXISTS_TAC `APPEND ul [v:real^3]` THEN
 554         SUBGOAL_THEN `truncate_simplex k (APPEND ul [v:real^3]) = ul` (fun th -> REWRITE_TAC[th]) THENL
 555         [
 556           REWRITE_TAC[TRUNCATE_SIMPLEX] THEN
 557             MATCH_MP_TAC CHOICE_LEMMA THEN
 558             CONJ_TAC THENL
 559             [
 560               EXISTS_TAC `ul:(real^3)list` THEN
 561                 CONJ_TAC THENL [ ASM_MESON_TAC[BARV]; ALL_TAC] THEN
 562                 REWRITE_TAC[INITIAL_SUBLIST_APPEND];
 563               ALL_TAC
 564             ] THEN
 565
 566             REPLICATE_TAC 9 (POP_ASSUM (fun th -> ALL_TAC)) THEN
 567             POP_ASSUM MP_TAC THEN REWRITE_TAC[BARV] THEN
 568             REPEAT STRIP_TAC THEN
 569             ASSUME_TAC (ISPECL [`ul:(real^3)list`; `[v:real^3]`] INITIAL_SUBLIST_APPEND) THEN
 570             ASM_MESON_TAC[INITIAL_SUBLIST_UNIQUE];
 571
 572           ALL_TAC
 573         ] THEN
 574
 575         SUBGOAL_THEN `F' = voronoi_list V (APPEND ul [v:real^3])` ASSUME_TAC THENL
 576         [
 577           POP_ASSUM (fun th -> ALL_TAC) THEN
 578             REPLICATE_TAC 3 (POP_ASSUM MP_TAC) THEN
 579             REPLICATE_TAC 5 (POP_ASSUM (fun th -> ALL_TAC)) THEN
 580             FIRST_ASSUM (MP_TAC o (fun th -> MATCH_MP BARV_SUBSET th)) THEN
 581             FIRST_ASSUM (MP_TAC o (fun th -> MATCH_MP BARV_CONS th)) THEN
 582             STRIP_TAC THEN
 583             FIRST_X_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
 584             DISCH_TAC THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
 585             DISCH_TAC THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
 586             MATCH_MP_TAC VORONOI_LIST_INTER_BIS THEN
 587             ASM_MESON_TAC[];
 588           ALL_TAC
 589         ] THEN
 590
 591         SUBGOAL_THEN `barV (V:real^3->bool) (k + 1) (APPEND ul [v])` (fun th -> REWRITE_TAC[th]) THENL
 592         [
 593           REWRITE_TAC[BARV] THEN CONJ_TAC THENL
 594             [
 595               REPLICATE_TAC 10 (POP_ASSUM (fun th -> ALL_TAC)) THEN
 596                 POP_ASSUM MP_TAC THEN
 597                 REWRITE_TAC[BARV; LENGTH_APPEND] THEN
 598                 REWRITE_TAC[LENGTH; SYM ONE] THEN
 599                 SIMP_TAC[];
 600               ALL_TAC
 601             ] THEN
 602
 603             REWRITE_TAC[VORONOI_NONDG; INITIAL_SUBLIST_APPEND_SING] THEN
 604             POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
 605             EXPAND_TAC "s" THEN
 606             POP_ASSUM (fun th -> ALL_TAC) THEN
 607             POP_ASSUM MP_TAC THEN
 608             REPLICATE_TAC 5 (POP_ASSUM (fun th -> ALL_TAC)) THEN
 609             POP_ASSUM MP_TAC THEN
 610             FIRST_ASSUM (MP_TAC o (fun th -> MATCH_MP BARV_SUBSET th)) THEN
 611             POP_ASSUM MP_TAC THEN
 612             REPLICATE_TAC 2 (POP_ASSUM (fun th -> ALL_TAC)) THEN
 613             REWRITE_TAC[BARV; VORONOI_NONDG] THEN
 614
 615             REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THENL
 616             [
 617               ASM_REWRITE_TAC[LENGTH_APPEND; LENGTH] THEN
 618                 ASM_SIMP_TAC [ARITH_RULE `k < 3 ==> (k + 1) + SUC 0 < 5`];
 619               REWRITE_TAC[SUBSET; IN_SET_OF_LIST; MEM_APPEND; MEM] THEN
 620                 ASM_MESON_TAC[SUBSET; IN_SET_OF_LIST];
 621
 622               POP_ASSUM (fun th -> ALL_TAC) THEN POP_ASSUM (fun th -> ALL_TAC) THEN
 623                 POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
 624                 POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN
 625                 REWRITE_TAC[LENGTH_APPEND; LENGTH] THEN
 626                 POP_ASSUM (fun th -> ALL_TAC) THEN POP_ASSUM MP_TAC THEN
 627                 POP_ASSUM MP_TAC THEN
 628                 POP_ASSUM (MP_TAC o SPEC `ul:(real^3)list`) THEN
 629                 ASM_REWRITE_TAC[INITIAL_SUBLIST_REFL; ARITH_RULE `0 < k + 1`] THEN
 630                 ARITH_TAC
 631             ];
 632           ALL_TAC
 633         ] THEN
 634         POP_ASSUM ACCEPT_TAC;
 635
 636       ALL_TAC
 637     ] THEN
 638
 639     REWRITE_TAC[facet_of] THEN
 640     REPEAT STRIP_TAC THENL
 641     [
 642       SUBGOAL_THEN `initial_sublist ul (vl:(real^3)list)` ASSUME_TAC THENL
 643         [
 644           SUBGOAL_TAC "A" `k + 1 <= LENGTH (vl:(real^3)list)` [ ASM_MESON_TAC[BARV; ARITH_RULE `k + 1 <= (k + 1) + 1`] ] THEN
 645             ASM_MESON_TAC[TRUNCATE_SIMPLEX_INITIAL_SUBLIST];
 646           ALL_TAC
 647         ] THEN
 648         ASM_REWRITE_TAC[] THEN
 649         MATCH_MP_TAC KHEJKCI_GEN THEN
 650         ASM_MESON_TAC[];
 651
 652       POP_ASSUM MP_TAC THEN POP_ASSUM (fun th -> ALL_TAC) THEN POP_ASSUM MP_TAC THEN
 653         POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN
 654         REWRITE_TAC[BARV; VORONOI_NONDG] THEN
 655         STRIP_TAC THEN
 656         POP_ASSUM (MP_TAC o SPEC `vl:(real^3)list`) THEN
 657         ASM_SIMP_TAC[INITIAL_SUBLIST_REFL; ARITH_RULE `k < 3 ==> (k + 1) + 1 < 5`; ARITH_RULE `0 < a + 1`] THEN
 658         DISCH_THEN ((LABEL_TAC "A") o CONJUNCT2) THEN
 659         DISCH_TAC THEN REMOVE_THEN "A" MP_TAC THEN
 660         POP_ASSUM (fun th -> REWRITE_TAC[th; AFF_DIM_EMPTY]) THEN
 661         POP_ASSUM (fun th -> ALL_TAC) THEN POP_ASSUM MP_TAC THEN
 662         REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN
 663         REWRITE_TAC[INT_ARITH `-- &1 + (((&k):int) + &1) + &1 = &4 <=> (&k):int = &3`] THEN
 664         ONCE_REWRITE_TAC[INT_OF_NUM_EQ] THEN
 665         ACCEPT_TAC (ARITH_RULE `k < 3 ==> ~(k = 3)`);
 666
 667       POP_ASSUM (fun th -> ALL_TAC) THEN
 668         POP_ASSUM MP_TAC THEN
 669         POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN
 670         POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
 671         REWRITE_TAC[BARV; VORONOI_NONDG] THEN
 672         REPEAT STRIP_TAC THEN
 673         FIRST_X_ASSUM (MP_TAC o SPEC `vl:(real^3)list`) THEN
 674         ASM_SIMP_TAC[INITIAL_SUBLIST_REFL; ARITH_RULE `0 < a + 1`] THEN
 675         DISCH_THEN (CONJUNCTS_THEN2 (fun th -> ALL_TAC) (ASSUME_TAC o CONJUNCT2)) THEN
 676         FIRST_X_ASSUM (MP_TAC o SPEC `ul:(real^3)list`) THEN
 677         ASM_SIMP_TAC[INITIAL_SUBLIST_REFL; ARITH_RULE `0 < a + 1`] THEN
 678         DISCH_THEN (CONJUNCTS_THEN2 (fun th -> ALL_TAC) (ASSUME_TAC o CONJUNCT2)) THEN
 679         POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
 680         REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN
 681         INT_ARITH_TAC
 682     ]);;
 683
 684
 685
 686 (**************************************)
 687
 688 (************************)
 689 (* Partitionining space *)
 690 (************************)
 691
 692 (* GLTVHUM *)
 693
 694 let VORONOI_LIST_EQ_UNION_CONVEX_HULL_FACETS = prove(`!V ul k p. packing V /\ saturated V /\ barV V k ul /\ k < 3 /\ p IN voronoi_list V ul
 695                                                        ==> voronoi_list V ul = UNIONS {convex hull (p INSERT voronoi_list V vl) | vl |
 696                                                                                            barV V (k + 1) vl /\ truncate_simplex k vl = ul}`,
 697    REPEAT STRIP_TAC THEN
 698      MP_TAC (ISPECL [`{p:real^3}`; `voronoi_list V ul`] POLYTOPE_UNION_CONVEX_HULL_FACETS) THEN
 699      ANTS_TAC THENL
 700      [
 701        ASM_SIMP_TAC[SUBSET; IN_SING] THEN
 702          REPEAT CONJ_TAC THENL
 703          [
 704            MATCH_MP_TAC POLYTOPE_VORONOI_LIST THEN
 705              ASM_REWRITE_TAC[] THEN
 706              CONJ_TAC THENL
 707              [
 708                MATCH_MP_TAC BARV_SUBSET THEN
 709                  EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[];
 710                ALL_TAC
 711              ] THEN
 712
 713              REWRITE_TAC[GSYM LENGTH_EQ_NIL] THEN
 714              UNDISCH_TAC `barV V k ul` THEN SIMP_TAC[BARV] THEN
 715              ARITH_TAC;
 716
 717            UNDISCH_TAC `barV V k ul` THEN
 718              REWRITE_TAC[BARV; VORONOI_NONDG] THEN
 719              STRIP_TAC THEN
 720              FIRST_X_ASSUM (MP_TAC o SPEC `ul:(real^3)list`) THEN
 721              ASM_REWRITE_TAC[INITIAL_SUBLIST_REFL; ARITH_RULE `0 < k + 1`] THEN
 722              REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN
 723              UNDISCH_TAC `k < 3` THEN
 724              REWRITE_TAC[GSYM INT_OF_NUM_LT] THEN
 725              INT_ARITH_TAC;
 726
 727            REWRITE_TAC[EXTENSION; IN_SING; NOT_IN_EMPTY; NOT_FORALL_THM] THEN
 728              EXISTS_TAC `p:real^3` THEN REWRITE_TAC[]
 729          ];
 730        ALL_TAC
 731      ] THEN
 732
 733      DISCH_THEN (fun th -> ONCE_REWRITE_TAC[th]) THEN
 734      AP_TERM_TAC THEN
 735
 736      MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `k:num`] IDBEZAL) THEN
 737      ASM_REWRITE_TAC[] THEN
 738      DISCH_THEN (fun th -> ONCE_REWRITE_TAC[th]) THEN
 739
 740      REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN
 741      REWRITE_TAC[GSYM EXTENSION; SET_RULE `!f:real^3->bool. {p} UNION f = p INSERT f`] THEN
 742      EQ_TAC THEN STRIP_TAC THENL
 743      [
 744        EXISTS_TAC `vl:(real^3)list` THEN
 745          ASM_REWRITE_TAC[];
 746        EXISTS_TAC `voronoi_list V vl` THEN
 747          ASM_REWRITE_TAC[] THEN
 748          EXISTS_TAC `vl:(real^3)list` THEN
 749          ASM_REWRITE_TAC[]
 750      ]);;
 751
 752
 753
 754 let NUMSEG_SUBSET_INDUCT = prove(`!s a b. (a IN s) /\ (!k. a <= k /\ SUC k <= b /\ k IN s ==> SUC k IN s) ==> a..b SUBSET s`,
 755    REPEAT STRIP_TAC THEN
 756      REWRITE_TAC[SUBSET; IN_NUMSEG] THEN
 757      INDUCT_TAC THENL
 758      [
 759        REWRITE_TAC[ARITH_RULE `a <= 0 <=> a = 0`] THEN DISCH_TAC THEN
 760          UNDISCH_TAC `a:num IN s` THEN ASM_REWRITE_TAC[];
 761        ALL_TAC
 762      ] THEN
 763
 764      DISCH_TAC THEN
 765      ASM_CASES_TAC `SUC x = a:num` THENL
 766      [
 767        ASM_REWRITE_TAC[];
 768        ALL_TAC
 769      ] THEN
 770
 771      FIRST_X_ASSUM MATCH_MP_TAC THEN
 772      ASM_REWRITE_TAC[] THEN
 773      MP_TAC (ARITH_RULE `a <= SUC x /\ ~(SUC x = a) /\ SUC x <= b ==> a <= x /\ x <= b`) THEN
 774      ASM_SIMP_TAC[]);;
 775
 776
 777
 778 let BARV_EXISTS = prove(`!V wl k. packing V /\ saturated V /\ k < 3 /\ barV V k wl ==> ?vl. barV V (SUC k) vl /\ truncate_simplex k vl = wl`,
 779    REPEAT STRIP_TAC THEN
 780      MP_TAC (ISPECL [`voronoi_list V wl`] POLYTOPE_FACET_EXISTS) THEN
 781      ANTS_TAC THENL
 782      [
 783        CONJ_TAC THENL
 784          [
 785            MATCH_MP_TAC POLYTOPE_VORONOI_LIST_BARV THEN
 786              EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[];
 787            ALL_TAC
 788          ] THEN
 789          ASM_SIMP_TAC[AFF_DIM_VORONOI_LIST] THEN
 790          UNDISCH_TAC `k < 3` THEN REWRITE_TAC[GSYM INT_OF_NUM_LT] THEN
 791          INT_ARITH_TAC;
 792        ALL_TAC
 793      ] THEN
 794
 795      STRIP_TAC THEN
 796      MP_TAC (SPECL [`V:real^3->bool`; `wl:(real^3)list`; `k:num`; `f:real^3->bool`] IDBEZAL) THEN
 797      ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
 798      EXISTS_TAC `vl:(real^3)list` THEN
 799      ASM_REWRITE_TAC[ADD1]);;
 800
 801
 802
 803 let BARV_EXISTS_ALT = prove(`!V k. packing V /\ saturated V /\ k <= 3 ==> ?ul. barV V k ul`,
 804    GEN_TAC THEN INDUCT_TAC THENL
 805      [
 806        STRIP_TAC THEN
 807          MP_TAC (SPEC_ALL TIWWFYQ) THEN
 808          ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
 809          EXISTS_TAC `[v:real^3]` THEN
 810          ASM_SIMP_TAC[BARV_0];
 811        ALL_TAC
 812      ] THEN
 813
 814      STRIP_TAC THEN
 815      FIRST_X_ASSUM (MP_TAC o check (is_imp o concl)) THEN
 816      ASM_SIMP_TAC[ARITH_RULE `SUC k <= 3 ==> k <= 3`] THEN
 817      STRIP_TAC THEN
 818      MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `k:num`] BARV_EXISTS) THEN
 819      ASM_SIMP_TAC[ARITH_RULE `SUC k <= 3 ==> k < 3`] THEN
 820      STRIP_TAC THEN
 821      EXISTS_TAC `vl:(real^3)list` THEN
 822      ASM_REWRITE_TAC[]);;
 823
 824
 825
 826 let GLTVHUM_lemma1 = prove(`!V ul j. packing V /\ saturated V /\ j < 3 /\ barV V j ul
 827                              ==> {k | k IN j..3 /\
 828                                       voronoi_list V ul = UNIONS {convex hull ({omega_list_n V vl i | i IN j..k-1} UNION voronoi_list V vl) | vl |
 829                                                                       barV V k vl /\ truncate_simplex j vl = ul}} = j..3`,
 830    REPEAT STRIP_TAC THEN
 831      MATCH_MP_TAC SUBSET_ANTISYM THEN
 832      CONJ_TAC THENL
 833      [
 834        SIMP_TAC[SUBSET; IN_ELIM_THM];
 835        ALL_TAC
 836      ] THEN
 837
 838      MATCH_MP_TAC NUMSEG_SUBSET_INDUCT THEN
 839      REWRITE_TAC[SUBSET; IN_NUMSEG; IN_ELIM_THM; LE_REFL] THEN
 840      SUBGOAL_THEN `LENGTH (ul:(real^3)list) = j + 1` ASSUME_TAC THENL
 841      [
 842        UNDISCH_TAC `barV V j ul` THEN SIMP_TAC[BARV];
 843        ALL_TAC
 844      ] THEN
 845
 846      SUBGOAL_THEN `!vl. barV V j vl /\ truncate_simplex j vl = ul <=> vl = ul` (LABEL_TAC "j") THENL
 847      [
 848        GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
 849          [
 850            UNDISCH_TAC `barV V j vl` THEN UNDISCH_TAC `barV V j ul` THEN
 851              REWRITE_TAC[BARV] THEN REPEAT STRIP_TAC THEN
 852              MP_TAC (ISPECL [`j:num`; `vl:(real^3)list`; `vl:(real^3)list`] TRUNCATE_SIMPLEX_INITIAL_SUBLIST) THEN
 853              ASM_REWRITE_TAC[LE_REFL; INITIAL_SUBLIST_REFL; EQ_SYM_EQ];
 854            ALL_TAC
 855          ] THEN
 856          ASM_SIMP_TAC[TRUNCATE_SIMPLEX_REFL];
 857        ALL_TAC
 858      ] THEN
 859
 860
 861      CONJ_TAC THENL
 862      [
 863        ASM_REWRITE_TAC[SING_GSPEC_APP; UNIONS_1] THEN
 864          ASM_SIMP_TAC[LT_IMP_LE] THEN
 865          ASM_CASES_TAC `j = 0` THENL
 866          [
 867            SUBGOAL_THEN `?x. ul = [x:real^3]` CHOOSE_TAC THENL
 868              [
 869                EXISTS_TAC `HD ul:real^3` THEN
 870                  MATCH_MP_TAC LENGTH_1_LEMMA THEN
 871                  UNDISCH_TAC `LENGTH (ul:(real^3)list) = j + 1` THEN ASM_REWRITE_TAC[ARITH];
 872                ALL_TAC
 873              ] THEN
 874              ASM_REWRITE_TAC[ARITH_RULE `0 - 1 = 0`; ARITH_RULE `j <= 0 <=> j = 0`; ARITH_RULE `0 <= i /\ i = 0 <=> i = 0`] THEN
 875              REWRITE_TAC[SING_GSPEC_APP; VORONOI_LIST; set_of_list; VORONOI_SET; INTERS_1; IN_SING; OMEGA_LIST_N; HD; SING_UNION_EQ_INSERT] THEN
 876              SUBGOAL_THEN `x:real^3 INSERT voronoi_closed V x = voronoi_closed V x` (fun th -> REWRITE_TAC[th]) THENL
 877              [
 878                REWRITE_TAC[GSYM ABSORPTION; CENTER_IN_VORONOI_CELL];
 879                ALL_TAC
 880              ] THEN
 881
 882              REWRITE_TAC[EQ_SYM_EQ; CONVEX_HULL_EQ; CONVEX_VORONOI_CLOSED];
 883            ALL_TAC
 884          ] THEN
 885
 886          ASM_SIMP_TAC[ARITH_RULE `~(j = 0) ==> (j <= i /\ i <= j - 1 <=> F)`] THEN
 887          SUBGOAL_THEN `{omega_list_n V ul i | i | F} = {}` (fun th -> REWRITE_TAC[th]) THENL
 888          [
 889            REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY];
 890            ALL_TAC
 891          ] THEN
 892
 893          REWRITE_TAC[UNION_EMPTY; EQ_SYM_EQ; CONVEX_HULL_EQ; CONVEX_VORONOI_LIST];
 894        ALL_TAC
 895      ] THEN
 896
 897      REPEAT STRIP_TAC THENL
 898      [
 899        ASM_SIMP_TAC[ARITH_RULE `j <= k ==> j <= SUC k`];
 900        ASM_REWRITE_TAC[];
 901        ALL_TAC
 902      ] THEN
 903
 904      REWRITE_TAC[ARITH_RULE `SUC k - 1 = k`] THEN
 905      ABBREV_TAC `f = \vl:(real^3)list. {omega_list_n V vl i | j <= i /\ i <= k} UNION voronoi_list V vl` THEN
 906      SUBGOAL_THEN `!vl:(real^3)list. {omega_list_n V vl i | j <= i /\ i <= k} UNION voronoi_list V vl = f vl` (fun th -> REWRITE_TAC[th]) THENL
 907      [
 908        EXPAND_TAC "f" THEN REWRITE_TAC[];
 909        ALL_TAC
 910      ] THEN
 911
 912      SUBGOAL_THEN `!P:(real^3)list->(real^3->bool). UNIONS {P vl | barV V (SUC k) vl /\ truncate_simplex j vl = ul} = UNIONS {UNIONS {P vl | vl | barV V (SUC k) vl /\ truncate_simplex k vl = wl} | wl | barV V k wl /\ truncate_simplex j wl = ul}` (fun th -> REWRITE_TAC[th]) THENL
 913      [
 914        GEN_TAC THEN
 915          REWRITE_TAC[EXTENSION; IN_UNIONS] THEN GEN_TAC THEN
 916          REWRITE_TAC[GSYM EXTENSION; IN_ELIM_THM; IN_UNIONS] THEN
 917          EQ_TAC THEN STRIP_TAC THENL
 918          [
 919            POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
 920              EXISTS_TAC `UNIONS {(P vl'):(real^3->bool) | vl' | barV V (SUC k) vl' /\ truncate_simplex k vl' = truncate_simplex k vl}` THEN
 921              CONJ_TAC THENL
 922              [
 923                EXISTS_TAC `truncate_simplex k vl:(real^3)list` THEN
 924                  REWRITE_TAC[] THEN
 925                  CONJ_TAC THENL
 926                  [
 927                    MATCH_MP_TAC TRUNCATE_SIMPLEX_BARV THEN
 928                      EXISTS_TAC `SUC k` THEN ASM_REWRITE_TAC[ARITH_RULE `k <= SUC k`];
 929                    ALL_TAC
 930                  ] THEN
 931
 932                  MP_TAC (ISPECL [`vl:(real^3)list`; `j:num`; `k:num`] TRUNCATE_TRUNCATE_SIMPLEX) THEN
 933                  UNDISCH_TAC `barV V (SUC k) vl` THEN SIMP_TAC[BARV] THEN DISCH_TAC THEN
 934                  ASM_SIMP_TAC[ARITH_RULE `k + 1 <= SUC k + 1`];
 935                ALL_TAC
 936              ] THEN
 937
 938              REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN
 939              EXISTS_TAC `(P (vl:(real^3)list)):real^3->bool` THEN
 940              ASM_REWRITE_TAC[] THEN
 941              EXISTS_TAC `vl:(real^3)list` THEN
 942              ASM_REWRITE_TAC[];
 943            ALL_TAC
 944          ] THEN
 945
 946          POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN
 947          REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN
 948          STRIP_TAC THEN
 949          POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
 950          EXISTS_TAC `(P (vl:(real^3)list)):real^3->bool` THEN
 951          ASM_REWRITE_TAC[] THEN
 952          EXISTS_TAC `vl:(real^3)list` THEN
 953          ASM_REWRITE_TAC[] THEN
 954          UNDISCH_TAC `truncate_simplex j wl = ul:(real^3)list` THEN
 955          MP_TAC (ISPECL [`vl:(real^3)list`; `j:num`; `k:num`] TRUNCATE_TRUNCATE_SIMPLEX) THEN
 956          UNDISCH_TAC `barV V (SUC k) vl` THEN SIMP_TAC[BARV] THEN DISCH_TAC THEN
 957          ASM_SIMP_TAC[ARITH_RULE `k + 1 <= SUC k + 1`];
 958        ALL_TAC
 959      ] THEN
 960
 961      ABBREV_TAC `g = \vl:(real^3)list. convex hull (omega_list_n V vl k INSERT voronoi_list V vl)` THEN
 962
 963      SUBGOAL_THEN `!vl:(real^3)list. convex hull (f vl):real^3->bool = convex hull ({omega_list_n V vl i | j <= i /\ i <= k - 1} UNION g vl)` (fun th -> REWRITE_TAC[th]) THENL
 964      [
 965        GEN_TAC THEN
 966          EXPAND_TAC "g" THEN
 967          ONCE_REWRITE_TAC[GSYM CONV_UNION_lemma] THEN
 968          ONCE_REWRITE_TAC[GSYM SING_UNION_EQ_INSERT] THEN
 969          REWRITE_TAC[GSYM UNION_ASSOC] THEN
 970          SUBGOAL_THEN `{omega_list_n V vl i | j <= i /\ i <= k - 1} UNION {omega_list_n V vl k} = {omega_list_n V vl i | j <= i /\ i <= k}` (fun th -> REWRITE_TAC[th]) THENL
 971          [
 972            REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM; IN_SING] THEN
 973              GEN_TAC THEN EQ_TAC THENL
 974              [
 975                STRIP_TAC THENL
 976                  [
 977                    EXISTS_TAC `i:num` THEN
 978                      ASM_SIMP_TAC[ARITH_RULE `i <= k - 1 ==> i <= k`];
 979                    ALL_TAC
 980                  ] THEN
 981                  EXISTS_TAC `k:num` THEN
 982                  ASM_REWRITE_TAC[LE_REFL];
 983                ALL_TAC
 984              ] THEN
 985              STRIP_TAC THEN
 986              ASM_CASES_TAC `i = k:num` THENL
 987              [
 988                ASM_REWRITE_TAC[];
 989                ALL_TAC
 990              ] THEN
 991
 992              DISJ1_TAC THEN
 993              EXISTS_TAC `i:num` THEN
 994              ASM_SIMP_TAC[ARITH_RULE `i <= k /\ ~(i = k) ==> i <= k - 1`];
 995            ALL_TAC
 996          ] THEN
 997
 998          EXPAND_TAC "f" THEN REWRITE_TAC[];
 999        ALL_TAC
1000      ] THEN
1001
1002      SUBGOAL_THEN `!wl. barV V k wl ==> UNIONS {g vl | vl | barV V (SUC k) vl /\ truncate_simplex k vl = wl} = voronoi_list V wl` (LABEL_TAC "wl") THENL
1003      [
1004        REPEAT STRIP_TAC THEN
1005          ABBREV_TAC `p = omega_list_n V wl k` THEN
1006          SUBGOAL_THEN `UNIONS {g vl | barV V (SUC k) vl /\ truncate_simplex k vl = wl} = UNIONS {convex hull ((p:real^3) INSERT voronoi_list V vl) | vl | barV V (SUC k) vl /\ truncate_simplex k vl = wl}` (fun th -> REWRITE_TAC[th]) THENL
1007          [
1008            AP_TERM_TAC THEN
1009              EXPAND_TAC "g" THEN
1010              REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN
1011              REWRITE_TAC[GSYM EXTENSION] THEN
1012              SUBGOAL_THEN `!vl. barV V (SUC k) vl /\ truncate_simplex k vl = wl ==> omega_list_n V vl k = p` ASSUME_TAC THENL
1013              [
1014                REPEAT STRIP_TAC THEN
1015                  MP_TAC (SPECL [`V:real^3->bool`; `vl:(real^3)list`; `k:num`; `0:num`] OMEGA_LIST_N_LEMMA) THEN
1016                  SUBGOAL_THEN `LENGTH (vl:(real^3)list) = k + 2 /\ LENGTH (wl:(real^3)list) = k + 1` ASSUME_TAC THENL
1017                  [
1018                    UNDISCH_TAC `barV V k wl` THEN UNDISCH_TAC `barV V (SUC k) vl` THEN
1019                      SIMP_TAC[BARV; ARITH_RULE `k + 2 = SUC k + 1`];
1020                    ALL_TAC
1021                  ] THEN
1022
1023                  ASM_REWRITE_TAC[ARITH_RULE `k + 0 + 1 <= k + 2`] THEN
1024                  DISCH_THEN (fun th -> ASM_REWRITE_TAC[th; ADD_0]);
1025                ALL_TAC
1026              ] THEN
1027
1028              EQ_TAC THENL
1029              [
1030                STRIP_TAC THEN
1031                  EXISTS_TAC `vl:(real^3)list` THEN
1032                  ASM_SIMP_TAC[];
1033                ALL_TAC
1034              ] THEN
1035              STRIP_TAC THEN
1036              EXISTS_TAC `vl:(real^3)list` THEN
1037              ASM_SIMP_TAC[];
1038            ALL_TAC
1039          ] THEN
1040
1041          REWRITE_TAC[ADD1] THEN
1042          MATCH_MP_TAC (GSYM VORONOI_LIST_EQ_UNION_CONVEX_HULL_FACETS) THEN
1043          ASM_SIMP_TAC[ARITH_RULE `SUC k <= 3 ==> k < 3`] THEN
1044          EXPAND_TAC "p" THEN
1045          SUBGOAL_THEN `voronoi_list V wl = voronoi_list V (truncate_simplex k wl):real^3->bool` (fun th -> ONCE_REWRITE_TAC[th]) THENL
1046          [
1047            SUBGOAL_THEN `truncate_simplex k wl = wl:(real^3)list` (fun th -> REWRITE_TAC[th]) THEN
1048              MATCH_MP_TAC TRUNCATE_SIMPLEX_REFL THEN
1049              UNDISCH_TAC `barV V k wl` THEN SIMP_TAC[BARV];
1050            ALL_TAC
1051          ] THEN
1052
1053          MATCH_MP_TAC OMEGA_LIST_N_IN_VORONOI_LIST THEN
1054          EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[LE_REFL];
1055        ALL_TAC
1056      ] THEN
1057
1058
1059      ASM_REWRITE_TAC[] THEN
1060      AP_TERM_TAC THEN
1061
1062
1063      SUBGOAL_THEN `!wl. barV V k wl ==> UNIONS {convex hull ({omega_list_n V vl i | j <= i /\ i <= k - 1} UNION g vl) | vl | barV V (SUC k) vl /\ truncate_simplex k vl = wl} = convex hull ({omega_list_n V wl i | j <= i /\ i <= k - 1} UNION voronoi_list V wl)` (LABEL_TAC "wl2") THENL
1064      [
1065        REPEAT STRIP_TAC THEN
1066          SUBGOAL_THEN `LENGTH (wl:(real^3)list) = k + 1` ASSUME_TAC THENL
1067          [
1068            UNDISCH_TAC `barV V k wl` THEN SIMP_TAC[BARV];
1069            ALL_TAC
1070          ] THEN
1071
1072          ABBREV_TAC `S = {omega_list_n V wl i | j <= i /\ i <= k - 1}` THEN
1073          SUBGOAL_THEN `!vl. barV V (SUC k) vl /\ truncate_simplex k vl = wl ==> {omega_list_n V vl i | j <= i /\ i <= k - 1} = S` (LABEL_TAC "vl") THENL
1074          [
1075            REPEAT STRIP_TAC THEN
1076              SUBGOAL_THEN `!i. j <= i /\ i <= k - 1 ==> omega_list_n V wl i = omega_list_n V vl i` ASSUME_TAC THENL
1077              [
1078                REPEAT STRIP_TAC THEN
1079                  SUBGOAL_THEN `LENGTH (vl:(real^3)list) = k + 2` ASSUME_TAC THENL
1080                  [
1081                    UNDISCH_TAC `barV V (SUC k) vl` THEN SIMP_TAC[BARV; ARITH_RULE `k + 2 = SUC k + 1`];
1082                    ALL_TAC
1083                  ] THEN
1084
1085                  MP_TAC (SPECL [`V:real^3->bool`; `vl:(real^3)list`; `i:num`; `k - i:num`] OMEGA_LIST_N_LEMMA) THEN
1086                  ASM_SIMP_TAC[ARITH_RULE `i <= k - 1 ==> i + k - i + 1 = k + 1 /\ i + k - i = k`; ARITH_RULE `k + 1 <= k + 2`];
1087                ALL_TAC
1088              ] THEN
1089
1090              EXPAND_TAC "S" THEN
1091              REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
1092              GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
1093              [
1094                EXISTS_TAC `i:num` THEN ASM_SIMP_TAC[];
1095                EXISTS_TAC `i:num` THEN ASM_SIMP_TAC[]
1096              ];
1097            ALL_TAC
1098          ] THEN
1099
1100          MP_TAC (ISPECL [`{(g vl):real^3->bool | vl | barV V (SUC k) vl /\ truncate_simplex k vl = wl}`; `S:real^3->bool`] CONVEX_HULL_UNION_UNIONS) THEN
1101          ANTS_TAC THENL
1102          [
1103            ASM_SIMP_TAC[CONVEX_VORONOI_LIST] THEN
1104              REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
1105              MP_TAC (SPEC_ALL BARV_EXISTS) THEN
1106              ASM_SIMP_TAC[ARITH_RULE `SUC k <= 3 ==> k < 3`] THEN
1107              STRIP_TAC THEN
1108              EXISTS_TAC `(g (vl:(real^3)list)):real^3->bool` THEN
1109              REWRITE_TAC[IN_ELIM_THM] THEN
1110              EXISTS_TAC `vl:(real^3)list` THEN
1111              ASM_REWRITE_TAC[];
1112            ALL_TAC
1113          ] THEN
1114
1115          ASM_SIMP_TAC[] THEN
1116          DISCH_THEN (fun th -> ALL_TAC) THEN
1117          AP_TERM_TAC THEN
1118
1119          REWRITE_TAC[EXTENSION] THEN GEN_TAC THEN
1120          REWRITE_TAC[IN_ELIM_THM] THEN
1121          EQ_TAC THENL
1122          [
1123            STRIP_TAC THEN
1124              EXISTS_TAC `(g (vl:(real^3)list)):real^3->bool` THEN
1125              ASM_SIMP_TAC[] THEN
1126              EXISTS_TAC `vl:(real^3)list` THEN
1127              ASM_REWRITE_TAC[];
1128            ALL_TAC
1129          ] THEN
1130
1131          STRIP_TAC THEN
1132          EXISTS_TAC `vl:(real^3)list` THEN
1133          ASM_SIMP_TAC[];
1134        ALL_TAC
1135      ] THEN
1136
1137      REWRITE_TAC[EXTENSION] THEN GEN_TAC THEN
1138      REWRITE_TAC[IN_ELIM_THM] THEN
1139      EQ_TAC THENL
1140      [
1141        STRIP_TAC THEN
1142          EXISTS_TAC `vl:(real^3)list` THEN
1143          ASM_SIMP_TAC[];
1144        STRIP_TAC THEN
1145          EXISTS_TAC `wl:(real^3)list` THEN
1146          ASM_SIMP_TAC[]
1147      ]);;
1148
1149
1150 (* GLTVHUM *)
1151
1152 let GLTVHUM = prove(`!V (u0:real^3) p. packing V /\ saturated V /\ (u0 IN V) ==>
1153                         (p IN voronoi_closed V u0 <=>
1154                           (?vl. vl IN barV V 3 /\ p IN rogers V vl /\ (truncate_simplex 0 vl = [u0])))`,
1155    REPEAT STRIP_TAC THEN
1156      MP_TAC (SPECL [`V:real^3->bool`; `[u0:real^3]`; `0`] GLTVHUM_lemma1) THEN
1157      ANTS_TAC THENL
1158      [
1159        ASM_REWRITE_TAC[ARITH_RULE `0 < 3`] THEN
1160          ASM_SIMP_TAC[BARV_0];
1161        ALL_TAC
1162      ] THEN
1163
1164      REWRITE_TAC[EXTENSION] THEN
1165      DISCH_THEN (MP_TAC o SPEC `3`) THEN
1166      REWRITE_TAC[IN_NUMSEG; LE_REFL; LE_0; IN_ELIM_THM] THEN
1167      SUBGOAL_THEN `voronoi_list V [u0:real^3] = voronoi_closed V u0` (fun th -> REWRITE_TAC[th]) THENL
1168      [
1169        REWRITE_TAC[VORONOI_LIST; set_of_list; VORONOI_SET; IN_SING; SING_GSPEC_APP; INTERS_1];
1170        ALL_TAC
1171      ] THEN
1172
1173      DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
1174      REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN
1175
1176      SUBGOAL_THEN `!vl. barV V 3 vl ==> convex hull ({omega_list_n V vl i | i <= 2} UNION voronoi_list V vl) = rogers V vl` ASSUME_TAC THENL
1177      [
1178        REPEAT STRIP_TAC THEN
1179          REWRITE_TAC[ROGERS; IMAGE_LEMMA] THEN
1180          AP_TERM_TAC THEN
1181          SUBGOAL_THEN `LENGTH (vl:(real^3)list) = 4` ASSUME_TAC THENL
1182          [
1183            POP_ASSUM MP_TAC THEN SIMP_TAC[BARV; ARITH_RULE `3 + 1 = 4`];
1184            ALL_TAC
1185          ] THEN
1186
1187          SUBGOAL_THEN `voronoi_list V vl = {omega_list_n V vl 3}` (fun th -> REWRITE_TAC[th]) THENL
1188          [
1189            SUBGOAL_THEN `aff_dim (voronoi_list V vl:real^3->bool) = &0` MP_TAC THENL
1190              [
1191                ONCE_REWRITE_TAC[INT_ARITH `&0 = int_of_num 3 - &3`] THEN
1192                  MATCH_MP_TAC AFF_DIM_VORONOI_LIST THEN
1193                  ASM_REWRITE_TAC[];
1194                ALL_TAC
1195              ] THEN
1196              REWRITE_TAC[AFF_DIM_EQ_0] THEN
1197              STRIP_TAC THEN
1198              MP_TAC (SPECL [`V:real^3->bool`; `vl:(real^3)list`; `3`; `3`] OMEGA_LIST_N_IN_VORONOI_LIST) THEN
1199              ASM_REWRITE_TAC[LE_REFL] THEN
1200              SUBGOAL_THEN `truncate_simplex 3 vl = vl:(real^3)list` (fun th -> REWRITE_TAC[th]) THENL
1201              [
1202                MATCH_MP_TAC TRUNCATE_SIMPLEX_REFL THEN
1203                  ASM_REWRITE_TAC[] THEN ARITH_TAC;
1204                ALL_TAC
1205              ] THEN
1206              ASM_SIMP_TAC[IN_SING];
1207            ALL_TAC
1208          ] THEN
1209
1210          ASM_REWRITE_TAC[EXTENSION; IN_UNION] THEN GEN_TAC THEN
1211          REWRITE_TAC[IN_SING; IN_ELIM_THM] THEN
1212          EQ_TAC THENL
1213          [
1214            STRIP_TAC THENL
1215              [
1216                EXISTS_TAC `i:num` THEN
1217                  ASM_SIMP_TAC[ARITH_RULE `i <= 2 ==> i < 4`];
1218                ALL_TAC
1219              ] THEN
1220              EXISTS_TAC `3` THEN
1221              ASM_REWRITE_TAC[ARITH_RULE `3 < 4`];
1222            ALL_TAC
1223          ] THEN
1224          STRIP_TAC THEN
1225          ASM_CASES_TAC `x' = 3` THENL
1226          [
1227            UNDISCH_TAC `x = omega_list_n V vl x'` THEN ASM_SIMP_TAC[];
1228            ALL_TAC
1229          ] THEN
1230          DISJ1_TAC THEN
1231          EXISTS_TAC `x':num` THEN
1232          ASM_SIMP_TAC[ARITH_RULE `x' < 4 /\ ~(x' = 3) ==> x' <= 2`];
1233        ALL_TAC
1234      ] THEN
1235
1236      REWRITE_TAC[ARITH_RULE `3 - 1 = 2`] THEN
1237      EQ_TAC THEN STRIP_TAC THENL
1238      [
1239        POP_ASSUM MP_TAC THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN
1240          EXISTS_TAC `vl:(real^3)list` THEN
1241          ASM_REWRITE_TAC[IN];
1242        ALL_TAC
1243      ] THEN
1244
1245      UNDISCH_TAC `vl IN barV V 3` THEN DISCH_THEN (ASSUME_TAC o REWRITE_RULE[IN]) THEN
1246      EXISTS_TAC `rogers V vl` THEN
1247      ASM_REWRITE_TAC[] THEN
1248      EXISTS_TAC `vl:(real^3)list` THEN
1249      ASM_SIMP_TAC[]);;
1250
1251 (***************************************************)
1252
1253 (* DUUNHOR *)
1254 (*************************)
1255
1256 let VORONOI_CLOSED_EQ_LEMMA = prove(`!V u v. packing V /\ u IN V /\ v IN V /\
1257                                       voronoi_closed V u = voronoi_closed V v
1258     ==> u = v`,
1259   REWRITE_TAC[voronoi_closed; EXTENSION] THEN REPEAT STRIP_TAC THEN
1260     FIRST_ASSUM (MP_TAC o SPEC `v : real^3`) THEN REWRITE_TAC[IN_ELIM_THM] THEN
1261     REWRITE_TAC[DIST_REFL; DIST_POS_LE] THEN
1262     DISCH_THEN (MP_TAC o SPEC `v : real^3`) THEN
1263     UNDISCH_TAC `v : real^3 IN V` THEN REWRITE_TAC[IN] THEN DISCH_TAC THEN
1264     ANTS_TAC THEN ASM_REWRITE_TAC[DIST_REFL; DIST_LE_0; EQ_SYM_EQ]);;
1265
1266
1267 let ODIGPXU_lemma = prove(`!P f f' p0 p (q : real^N) t s.
1268                       polyhedron P /\ p0 IN P /\ ~(p0 IN f UNION f') /\
1269                       f facet_of P /\ f' facet_of P /\
1270                       p IN f /\ q IN f' /\
1271                       &0 < t /\ &0 < s /\
1272                       (&1 - t) % p0 + t % p = (&1 - s) % p0 + s % q ==> s <= t`,
1273   REPEAT STRIP_TAC THEN
1274     POP_ASSUM MP_TAC THEN
1275     REWRITE_TAC[VECTOR_SUB_RDISTRIB] THEN
1276     REWRITE_TAC[VECTOR_ARITH `a - t % (p0 : real^N) + t % p = a - s % p0 + s % q <=> t % (p - p0) = s % (q - p0)`] THEN
1277     MP_TAC (REAL_ARITH `s <= t \/ t < s`) THEN
1278     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
1279     DISCH_THEN (MP_TAC o AP_TERM `\x : real^N. inv t % x`) THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
1280     ASM_SIMP_TAC[REAL_ARITH `&0 < t ==> ~(t = &0)`; REAL_MUL_LINV; VECTOR_MUL_LID] THEN
1281     ABBREV_TAC `r = inv t * s` THEN
1282     SUBGOAL_THEN `&1 < r` ASSUME_TAC THENL
1283     [
1284       MP_TAC (SPECL [`&1`; `r : real`; `t : real`] REAL_LT_LMUL_EQ) THEN
1285         ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[GSYM th]) THEN
1286         POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
1287         REWRITE_TAC[REAL_MUL_ASSOC] THEN
1288         ASM_SIMP_TAC[REAL_MUL_RID; REAL_ARITH `&0 < t ==> ~(t = &0)`; REAL_MUL_RINV; REAL_MUL_LID];
1289       ALL_TAC
1290     ] THEN
1291
1292     MP_TAC (SPECL[`P : real^N -> bool`; `f' : real^N -> bool`] FACET_OF_POLYHEDRON) THEN
1293     ASM_REWRITE_TAC[] THEN
1294     REPEAT (DISCH_THEN (CHOOSE_THEN MP_TAC)) THEN REWRITE_TAC[SUBSET] THEN
1295     STRIP_TAC THEN
1296     SUBGOAL_THEN `(a : real^N) dot p0 < b` ASSUME_TAC THENL
1297     [
1298       REWRITE_TAC[REAL_ARITH `x < y <=> x <= y /\ ~(x = y)`] THEN
1299         FIRST_X_ASSUM (MP_TAC o SPEC `p0 : real^N`) THEN
1300         ASM_REWRITE_TAC[IN_ELIM_THM] THEN SIMP_TAC[] THEN DISCH_THEN (fun th -> ALL_TAC) THEN
1301         UNDISCH_TAC `~(p0 : real^N IN f UNION f')` THEN
1302         ASM_REWRITE_TAC[CONTRAPOS_THM; IN_UNION] THEN DISCH_TAC THEN
1303         DISJ2_TAC THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM];
1304       ALL_TAC
1305     ] THEN
1306     REWRITE_TAC[VECTOR_ARITH `p - p0 = x <=> p = p0 + x : real^N`] THEN DISCH_TAC THEN
1307     MP_TAC (ISPECL[`f : real^N -> bool`; `P : real^N -> bool`] FACET_OF_IMP_SUBSET) THEN
1308     ASM_REWRITE_TAC[SUBSET] THEN DISCH_THEN (MP_TAC o SPEC `p : real^N`) THEN
1309     ASM_REWRITE_TAC[] THEN
1310     DISCH_THEN (fun th -> FIRST_X_ASSUM (MP_TAC o (fun th2 -> MATCH_MP th2 th))) THEN
1311     REWRITE_TAC[IN_ELIM_THM; DOT_RADD; DOT_RMUL; DOT_RSUB] THEN
1312     REPLICATE_TAC 3 (POP_ASSUM MP_TAC) THEN REWRITE_TAC[EXTENSION] THEN
1313     DISCH_THEN (MP_TAC o SPEC `q : real^N`) THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
1314     DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN DISCH_TAC THEN DISCH_THEN (fun th -> ALL_TAC) THEN
1315     REWRITE_TAC[REAL_ARITH `x + r * (b - x) <= b <=> (r - &1) * b <= (r - &1) * x`] THEN
1316     ASM_SIMP_TAC[REAL_ARITH `&1 < r ==> &0 < r - &1`; REAL_LE_LMUL_EQ] THEN
1317     POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);;
1318
1319
1320 (* ODIGPXU *)
1321 let ODIGPXU = prove(`!P f f' p0 p (q : real^N) t s.
1322                       polyhedron P /\ p0 IN P /\ ~(p0 IN f UNION f') /\
1323                       f facet_of P /\ f' facet_of P /\
1324                       p IN f /\ q IN f' /\
1325                       &0 < t /\ &0 < s /\
1326                       (&1 - t) % p0 + t % p = (&1 - s) % p0 + s % q
1327     ==> s = t`,
1328   REPEAT STRIP_TAC THEN
1329     REWRITE_TAC[REAL_ARITH `s = t <=> s <= t /\ t <= s`] THEN
1330     STRIP_TAC THEN MATCH_MP_TAC ODIGPXU_lemma THENL
1331     [
1332       MAP_EVERY EXISTS_TAC [`P : real^N -> bool`; `f : real^N -> bool`; `f' : real^N -> bool`] THEN
1333         MAP_EVERY EXISTS_TAC [`p0 : real^N`; `p : real^N`; `q : real^N`] THEN
1334         ASM_REWRITE_TAC[];
1335       MAP_EVERY EXISTS_TAC [`P : real^N -> bool`; `f' : real^N -> bool`; `f : real^N -> bool`] THEN
1336         MAP_EVERY EXISTS_TAC [`p0 : real^N`; `q : real^N`; `p : real^N`] THEN
1337         ASM_REWRITE_TAC[UNION_COMM]
1338     ]);;
1339
1340
1341
1342 let OMEGA_LIST_N_EQ = prove(`!V ul i j. omega_list_n V ul i IN voronoi_list V (truncate_simplex (SUC i) ul)
1343                               ==> omega_list_n V ul (SUC i) = omega_list_n V ul i`,
1344   REPEAT GEN_TAC THEN ABBREV_TAC `X = voronoi_list V (truncate_simplex (SUC i) ul)` THEN
1345     ASM_REWRITE_TAC[OMEGA_LIST_N] THEN DISCH_TAC THEN
1346     MP_TAC (ISPECL[`X:real^3 -> bool`; `omega_list_n V ul i`] CLOSEST_POINT_EXISTS) THEN
1347     ANTS_TAC THENL
1348     [
1349       REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
1350         EXPAND_TAC "X" THEN REWRITE_TAC[CLOSED_VORONOI_LIST] THEN
1351         EXISTS_TAC `omega_list_n V ul i` THEN ASM_REWRITE_TAC[];
1352       ALL_TAC
1353     ] THEN
1354     STRIP_TAC THEN
1355     POP_ASSUM (MP_TAC o SPEC `omega_list_n V ul i`) THEN
1356     ASM_REWRITE_TAC[DIST_REFL; DIST_LE_0] THEN
1357     DISCH_THEN (fun th -> REWRITE_TAC[SYM th]));;
1358
1359
1360 let OMEGA_LIST_N_IN_FACET = prove(`!V ul k i. packing V /\ saturated V /\ barV V k ul /\ i < k
1361                                   ==> ?F. F facet_of voronoi_list V (truncate_simplex i ul) /\
1362                                      voronoi_list V (truncate_simplex (i + 1) ul) = F /\
1363                                      (!j. i < j /\ j <= k ==> omega_list_n V ul j IN F)`,
1364   REPEAT STRIP_TAC THEN
1365     ABBREV_TAC `FF = voronoi_list V (truncate_simplex (i + 1) ul)` THEN
1366     EXISTS_TAC `FF : real^3 -> bool` THEN REWRITE_TAC[] THEN
1367     CONJ_TAC THENL
1368     [
1369       MP_TAC (SPECL[`V:real^3->bool`; `truncate_simplex i ul : (real^3)list`; `i:num`; `FF:real^3->bool`] IDBEZAL) THEN
1370         ANTS_TAC THENL
1371         [
1372           ASM_REWRITE_TAC[] THEN
1373             MP_TAC (SPEC_ALL BARV_IMP_K_LE_3) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
1374             MP_TAC (ARITH_RULE `i < k /\ k <= 3 ==> i < 3`) THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN
1375             MATCH_MP_TAC TRUNCATE_SIMPLEX_BARV THEN
1376             EXISTS_TAC `k:num` THEN ASM_SIMP_TAC[LT_IMP_LE];
1377           ALL_TAC
1378         ] THEN
1379
1380         DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
1381         EXISTS_TAC `truncate_simplex (i + 1) ul : (real^3)list` THEN
1382         ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
1383         [
1384           MATCH_MP_TAC TRUNCATE_SIMPLEX_BARV THEN
1385             EXISTS_TAC `k:num` THEN ASM_SIMP_TAC[ARITH_RULE `i < k ==> i + 1 <= k`];
1386           MP_TAC (ISPECL[`ul:(real^3)list`; `i:num`; `i + 1`] TRUNCATE_TRUNCATE_SIMPLEX) THEN
1387             DISCH_THEN MATCH_MP_TAC THEN
1388             REWRITE_TAC[ARITH_RULE `i <= i + 1`] THEN
1389             UNDISCH_TAC `barV V k ul` THEN REWRITE_TAC[BARV] THEN DISCH_TAC THEN
1390             ASM_SIMP_TAC[ARITH_RULE `i < k ==> (i + 1) + 1 <= k + 1`]
1391         ];
1392       ALL_TAC
1393     ] THEN
1394     REPEAT STRIP_TAC THEN
1395     MP_TAC (SPECL[`V:real^3->bool`; `ul:(real^3)list`; `k:num`; `j:num`] OMEGA_LIST_N_IN_VORONOI_LIST) THEN
1396     ASM_REWRITE_TAC[] THEN
1397     SUBGOAL_THEN `voronoi_list V (truncate_simplex j ul) SUBSET FF` ASSUME_TAC THENL
1398     [
1399       EXPAND_TAC "FF" THEN REWRITE_TAC[VORONOI_LIST; VORONOI_SET] THEN
1400         REWRITE_TAC[SUBSET; IN_INTERS; IN_ELIM_THM] THEN
1401         REPEAT STRIP_TAC THEN
1402         FIRST_X_ASSUM MATCH_MP_TAC THEN
1403         EXISTS_TAC `v:real^3` THEN ASM_REWRITE_TAC[] THEN
1404         POP_ASSUM (fun th -> ALL_TAC) THEN POP_ASSUM MP_TAC THEN
1405         REWRITE_TAC[IN_SET_OF_LIST; MEM_EXISTS_EL] THEN
1406
1407         UNDISCH_TAC `barV V k ul` THEN REWRITE_TAC[BARV] THEN DISCH_TAC THEN
1408         MP_TAC (ISPECL[`i + 1`; `ul:(real^3)list`] LENGTH_TRUNCATE_SIMPLEX) THEN
1409         MP_TAC (ISPECL[`j:num`; `ul:(real^3)list`] LENGTH_TRUNCATE_SIMPLEX) THEN
1410         ASM_REWRITE_TAC[ARITH_RULE `j + 1 <= k + 1 <=> j <= k`] THEN
1411         ASM_SIMP_TAC[ARITH_RULE `i < k ==> i + 1 <= k`] THEN
1412         REPLICATE_TAC 2 (DISCH_THEN (fun th -> REWRITE_TAC[th])) THEN
1413         DISCH_THEN (X_CHOOSE_THEN `r:num` MP_TAC) THEN STRIP_TAC THEN POP_ASSUM MP_TAC THEN
1414
1415         MP_TAC (ISPECL[`ul:(real^3)list`; `i + 1`; `r:num`] EL_TRUNCATE_SIMPLEX) THEN
1416         ASM_SIMP_TAC[ARITH_RULE `i < k ==> (i + 1) + 1 <= k + 1`] THEN
1417         ASM_SIMP_TAC[ARITH_RULE `r < (i + 1) + 1 ==> r <= i + 1`] THEN
1418         REPEAT DISCH_TAC THEN
1419         EXISTS_TAC `r:num` THEN
1420         MP_TAC (ARITH_RULE `j <= k /\ i < j /\ r < (i + 1) + 1 ==> r < j + 1`) THEN
1421         ASM_SIMP_TAC[] THEN DISCH_TAC THEN
1422         MP_TAC (ISPECL[`ul:(real^3)list`; `j:num`; `r:num`] EL_TRUNCATE_SIMPLEX) THEN
1423         ASM_REWRITE_TAC[ARITH_RULE `j + 1 <= k + 1 <=> j <= k`] THEN
1424         ASM_SIMP_TAC[ARITH_RULE `r < j + 1 ==> r <= j`];
1425       ALL_TAC
1426     ] THEN
1427     DISCH_TAC THEN
1428     MATCH_MP_TAC IN_TRANS THEN
1429     EXISTS_TAC `voronoi_list V (truncate_simplex j ul)` THEN
1430     ASM_REWRITE_TAC[]);;
1431
1432
1433 let OMEGA_LIST_N_IN_VORONOI_LIST_GEN = prove(`!V ul k i j. packing V /\ saturated V /\ barV V k ul /\
1434                                                i <= j /\ j <= k ==>
1435                                        omega_list_n V ul j IN voronoi_list V (truncate_simplex i ul)`,
1436   REPEAT STRIP_TAC THEN
1437     UNDISCH_TAC `i <= j:num` THEN REWRITE_TAC[LE_LT] THEN STRIP_TAC THENL
1438     [
1439       MP_TAC (SPEC_ALL OMEGA_LIST_N_IN_FACET) THEN
1440         ASM_REWRITE_TAC[] THEN
1441         ANTS_TAC THENL
1442         [
1443           MATCH_MP_TAC (ARITH_RULE `i < j /\ j <= k ==> i < k : num`) THEN ASM_REWRITE_TAC[];
1444           ALL_TAC
1445         ] THEN
1446         STRIP_TAC THEN
1447         MATCH_MP_TAC IN_TRANS THEN
1448         EXISTS_TAC `F':real^3->bool` THEN
1449         CONJ_TAC THENL
1450         [
1451           FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[];
1452           ALL_TAC
1453         ] THEN
1454         MATCH_MP_TAC FACET_OF_IMP_SUBSET THEN ASM_REWRITE_TAC[];
1455       ALL_TAC
1456     ] THEN
1457     ASM_REWRITE_TAC[] THEN
1458     MATCH_MP_TAC OMEGA_LIST_N_IN_VORONOI_LIST THEN
1459     EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[]);;
1460
1461
1462 let VORONOI_SET_SUBSET = prove(`!V s t. s SUBSET t ==> voronoi_set V t SUBSET voronoi_set V s`,
1463   REWRITE_TAC[VORONOI_SET] THEN SET_TAC[]);;
1464
1465
1466
1467
1468 let TRUNCATE_SIMPLEX_SUBSET = prove(`!(ul:(A)list) i j. j <= i /\ i + 1 <= LENGTH ul ==>
1469                       set_of_list (truncate_simplex j ul) SUBSET set_of_list (truncate_simplex i ul)`,
1470   REWRITE_TAC[SUBSET; IN_SET_OF_LIST; MEM_EXISTS_EL] THEN REPEAT STRIP_TAC THEN
1471     EXISTS_TAC `i':num` THEN ASM_REWRITE_TAC[] THEN
1472     POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
1473     MP_TAC (SPECL[`i:num`; `ul:(A)list`] LENGTH_TRUNCATE_SIMPLEX) THEN
1474     MP_TAC (SPECL[`j:num`; `ul:(A)list`] LENGTH_TRUNCATE_SIMPLEX) THEN
1475     MP_TAC (ARITH_RULE `!x. j <= i /\ i + 1 <= x ==> j + 1 <= x`) THEN
1476     MP_TAC (ARITH_RULE `i' < j + 1 /\ j <= i ==> i' < i + 1`) THEN
1477     ASM_SIMP_TAC[] THEN REPEAT DISCH_TAC THEN
1478     MP_TAC (SPECL[`ul:(A)list`; `i:num`; `i':num`] EL_TRUNCATE_SIMPLEX) THEN
1479     ASM_SIMP_TAC[ARITH_RULE `i' < i + 1 ==> i' <= i`] THEN DISCH_TAC THEN
1480     MP_TAC (SPECL[`ul:(A)list`; `j:num`; `i':num`] EL_TRUNCATE_SIMPLEX) THEN
1481     ASM_SIMP_TAC[ARITH_RULE `i' < j + 1 ==> i' <= j`]);;
1482
1483
1484 let OMEGA_LIST_N_EQ_GEN = prove(`!V ul k i j. packing V /\ saturated V /\ barV V k ul /\
1485                   i < j /\ j <= k /\ omega_list_n V ul i IN voronoi_list V (truncate_simplex j ul)
1486                   ==> omega_list_n V ul (SUC i) = omega_list_n V ul i`,
1487   REPEAT STRIP_TAC THEN
1488     MATCH_MP_TAC OMEGA_LIST_N_EQ THEN
1489     MATCH_MP_TAC IN_TRANS THEN EXISTS_TAC `voronoi_list V (truncate_simplex j ul)` THEN
1490     ASM_REWRITE_TAC[VORONOI_LIST] THEN
1491     MATCH_MP_TAC VORONOI_SET_SUBSET THEN
1492     MATCH_MP_TAC TRUNCATE_SIMPLEX_SUBSET THEN
1493     ASM_SIMP_TAC[ARITH_RULE `i < j ==> SUC i <= j`] THEN
1494     UNDISCH_TAC `barV V k ul` THEN REWRITE_TAC[BARV] THEN
1495     ASM_SIMP_TAC[ARITH_RULE `j <= k ==> j + 1 <= k + 1`]);;
1496
1497
1498
1499 let CARD_LE_3 = prove(`!s. ~(s = {}) /\ FINITE s /\ CARD s <= 3 ==> ?x y z : A. s = {x, y, z}`,
1500   REPEAT STRIP_TAC THEN
1501     MP_TAC (ARITH_RULE `!n. n <= 3 ==> n = 0 \/ n = 1 \/ n = 2 \/ n = 3`) THEN
1502     DISCH_THEN (MP_TAC o SPEC `CARD (s:A->bool)`) THEN ASM_REWRITE_TAC[] THEN
1503     STRIP_TAC THEN POP_ASSUM MP_TAC THEN UNDISCH_TAC `FINITE (s:A->bool)` THEN REWRITE_TAC[IMP_IMP; GSYM HAS_SIZE; num_CONV `3`; num_CONV `2`; num_CONV `1`; HAS_SIZE_CLAUSES] THENL
1504     [
1505       DISCH_TAC THEN UNDISCH_TAC `~((s:A->bool) = {})` THEN ASM_REWRITE_TAC[];
1506       STRIP_TAC THEN POP_ASSUM MP_TAC THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN
1507         REPLICATE_TAC 3 (EXISTS_TAC `a:A`) THEN SET_TAC[];
1508       REPEAT (DISCH_THEN (CHOOSE_THEN MP_TAC)) THEN
1509         DISCH_THEN (CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "A")) THEN
1510         STRIP_TAC THEN REMOVE_THEN "A" MP_TAC THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN
1511         EXISTS_TAC `a:A` THEN EXISTS_TAC `a':A` THEN EXISTS_TAC `a':A` THEN SET_TAC[];
1512       REPEAT (DISCH_THEN (CHOOSE_THEN MP_TAC)) THEN
1513         DISCH_THEN (CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "A")) THEN
1514         REPEAT (DISCH_THEN (CHOOSE_THEN MP_TAC)) THEN
1515         DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
1516         STRIP_TAC THEN REMOVE_THEN "A" MP_TAC THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN
1517         EXISTS_TAC `a:A` THEN EXISTS_TAC `a':A` THEN EXISTS_TAC `a'':A` THEN REWRITE_TAC[]
1518     ]);;
1519
1520
1521 let AFF_DIM_LE_2_IMP_COPLANAR = prove(`!s : real^N -> bool. aff_dim s <= &2 ==> coplanar s`,
1522   REPEAT STRIP_TAC THEN REWRITE_TAC[coplanar] THEN
1523     MP_TAC (ISPEC `s:real^N->bool` AFF_DIM) THEN
1524     STRIP_TAC THEN
1525     SUBGOAL_THEN `CARD (b:real^N -> bool) <= 3` ASSUME_TAC THENL
1526     [
1527       REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN
1528         REWRITE_TAC[INT_ARITH `a <= int_of_num 3 <=> a - &1 <= &2`] THEN
1529         POP_ASSUM (fun th -> ASM_REWRITE_TAC[SYM th]);
1530       ALL_TAC
1531     ] THEN
1532     ASM_CASES_TAC `(b:real^N -> bool) = {}` THENL
1533     [
1534       REPLICATE_TAC 3 (EXISTS_TAC `vec 0 : real^N`) THEN
1535         MATCH_MP_TAC SUBSET_TRANS THEN
1536         EXISTS_TAC `affine hull b : real^N -> bool` THEN
1537         CONJ_TAC THENL [ ASM_REWRITE_TAC[HULL_SUBSET]; ALL_TAC ] THEN
1538         POP_ASSUM (fun th -> REWRITE_TAC[th; AFFINE_HULL_EMPTY; EMPTY_SUBSET]);
1539       ALL_TAC
1540     ] THEN
1541     MP_TAC (ISPEC `b:real^N->bool` CARD_LE_3) THEN
1542     ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE] THEN
1543     STRIP_TAC THEN
1544     MAP_EVERY EXISTS_TAC [`x:real^N`; `y:real^N`; `z:real^N`] THEN
1545     MATCH_MP_TAC SUBSET_TRANS THEN
1546     EXISTS_TAC `affine hull b : real^N -> bool` THEN
1547     CONJ_TAC THENL [ ASM_REWRITE_TAC[HULL_SUBSET]; ALL_TAC ] THEN
1548     POP_ASSUM (fun th -> REWRITE_TAC[th; SUBSET_REFL]));;
1549
1550
1551 let SET_OF_LIST_TRUNCATE_SIMPLEX_SUBSET = prove(`!(ul:(A)list) k. k + 1 <= LENGTH ul ==> set_of_list (truncate_simplex k ul) SUBSET set_of_list ul`,
1552    REPEAT STRIP_TAC THEN
1553      MATCH_MP_TAC SET_OF_LIST_INITIAL_SUBLIST_SUBSET THEN
1554      MP_TAC (SPECL [`k:num`; `truncate_simplex k (ul:(A)list)`; `ul:(A)list`] TRUNCATE_SIMPLEX_INITIAL_SUBLIST) THEN
1555      ASM_REWRITE_TAC[] THEN SIMP_TAC[]);;
1556
1557
1558
1559 let ROGERS_AFF_DIM_FULL = prove(`!V ul. barV V 3 ul /\ aff_dim (rogers V ul) = &3
1560     ==> !i j. i < 4 /\ j < 4 /\ ~(i = j) ==> ~(omega_list_n V ul i = omega_list_n V ul j)`,
1561   REWRITE_TAC[ROGERS; AFF_DIM_CONVEX_HULL; BARV; ARITH] THEN REPEAT GEN_TAC THEN
1562     REWRITE_TAC[GSYM IMP_IMP] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
1563     DISCH_THEN (fun th -> ALL_TAC) THEN REPEAT STRIP_TAC THEN
1564     ABBREV_TAC `S = IMAGE (omega_list_n V ul) {j | j < 4}` THEN
1565     ABBREV_TAC `a = omega_list_n V ul i` THEN
1566     ABBREV_TAC `b = omega_list_n V ul j` THEN
1567     SUBGOAL_THEN `S DELETE a DELETE b SUBSET IMAGE (omega_list_n V ul) {k | k < 4 /\ ~(k = i) /\ ~(k = j)}` MP_TAC THENL
1568     [
1569       REPLICATE_TAC 3 (POP_ASSUM (fun th -> REWRITE_TAC[SYM th])) THEN
1570         REWRITE_TAC[SUBSET; IN_DELETE; IN_IMAGE; IN_ELIM_THM] THEN
1571         REPEAT STRIP_TAC THEN
1572         EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[] THEN
1573         CONJ_TAC THENL
1574         [
1575           POP_ASSUM (fun th -> ALL_TAC) THEN POP_ASSUM MP_TAC THEN ASM_SIMP_TAC[CONTRAPOS_THM];
1576           POP_ASSUM MP_TAC THEN ASM_SIMP_TAC[CONTRAPOS_THM]
1577         ];
1578       ALL_TAC
1579     ] THEN
1580
1581     SUBGOAL_THEN `FINITE (S:real^3->bool)` ASSUME_TAC THENL
1582     [
1583       EXPAND_TAC "S" THEN
1584         MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[FINITE_NUMSEG_LT];
1585       ALL_TAC
1586     ] THEN
1587
1588     DISCH_TAC THEN
1589     SUBGOAL_THEN `CARD (S DELETE a DELETE (b:real^3)) <= 2` MP_TAC THENL
1590     [
1591       MATCH_MP_TAC LE_TRANS THEN
1592         EXISTS_TAC `CARD (IMAGE (omega_list_n V ul) {k | k < 4 /\ ~(k = i) /\ ~(k = j)})` THEN
1593         SUBGOAL_THEN `{k | k < 4 /\ ~(k = i) /\ ~(k = j)} HAS_SIZE 2` MP_TAC THENL
1594         [
1595           SUBGOAL_THEN `{k | k < 4 /\ ~(k = i) /\ ~(k = j)} = {k | k < 4} DELETE i DELETE j` ASSUME_TAC THENL
1596             [
1597               REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_DELETE; CONJ_ACI];
1598               ALL_TAC
1599             ] THEN
1600             ASM_REWRITE_TAC[HAS_SIZE; FINITE_DELETE; FINITE_NUMSEG_LT] THEN
1601             MP_TAC (ISPECL[`j:num`; `{k | k < 4} DELETE i`] CARD_DELETE) THEN
1602             ASM_REWRITE_TAC[FINITE_DELETE; FINITE_NUMSEG_LT; IN_DELETE; IN_ELIM_THM] THEN
1603             DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
1604             MP_TAC (ISPECL[`i:num`; `{k | k < 4}`] CARD_DELETE) THEN
1605             ASM_REWRITE_TAC[FINITE_NUMSEG_LT; IN_ELIM_THM] THEN
1606             DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
1607             REWRITE_TAC[CARD_NUMSEG_LT] THEN ARITH_TAC;
1608           ALL_TAC
1609         ] THEN
1610
1611         REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN
1612
1613         CONJ_TAC THENL
1614         [
1615           MATCH_MP_TAC CARD_SUBSET THEN ASM_REWRITE_TAC[] THEN
1616             MATCH_MP_TAC FINITE_IMAGE THEN ASM_REWRITE_TAC[];
1617           ALL_TAC
1618         ] THEN
1619
1620         POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
1621         MATCH_MP_TAC CARD_IMAGE_LE THEN ASM_REWRITE_TAC[];
1622       ALL_TAC
1623     ] THEN
1624
1625     MP_TAC (ISPECL[`S:real^3->bool`; `a:real^3`] FINITE_DELETE) THEN ASM_REWRITE_TAC[] THEN
1626     DISCH_TAC THEN ASM_SIMP_TAC[CARD_DELETE; IN_DELETE] THEN
1627     SUBGOAL_THEN `b:real^3 IN S` ASSUME_TAC THENL
1628     [
1629       EXPAND_TAC "S" THEN EXPAND_TAC "b" THEN
1630         REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `j:num` THEN ASM_REWRITE_TAC[];
1631       ALL_TAC
1632     ] THEN
1633
1634     MP_TAC (ISPECL[`S:real^3->bool`; `b:real^3`] Hypermap.CARD_ATLEAST_1) THEN
1635     ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
1636     ASM_SIMP_TAC[GSYM INT_OF_NUM_LE; GSYM INT_OF_NUM_SUB] THEN
1637     MP_TAC (ISPEC `S:real^3->bool` AFF_DIM_LE_CARD) THEN ASM_REWRITE_TAC[] THEN
1638     INT_ARITH_TAC);;
1639
1640
1641 let VORONOI_LIST_AFF_DIM = prove(`!V ul k i. barV V k ul /\ i <= k
1642                                    ==> aff_dim (voronoi_list V (truncate_simplex i ul)) = &3 - &i`,
1643   REPEAT STRIP_TAC THEN
1644     SUBGOAL_THEN `barV V i (truncate_simplex i ul)` MP_TAC THENL
1645     [
1646       MATCH_MP_TAC TRUNCATE_SIMPLEX_BARV THEN
1647         EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[];
1648       ALL_TAC
1649     ] THEN
1650     REWRITE_TAC[BARV; VORONOI_NONDG] THEN STRIP_TAC THEN
1651     FIRST_X_ASSUM (MP_TAC o SPEC `truncate_simplex i ul : (real^3)list`) THEN
1652     ASM_REWRITE_TAC[INITIAL_SUBLIST_REFL; ARITH_RULE `0 < i + 1`] THEN
1653     REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN
1654     INT_ARITH_TAC);;
1655
1656
1657 let AFF_DIM_FINITE_UNION_LE = prove(`!s (t:real^N->bool). FINITE s ==>
1658                                       aff_dim (s UNION t) <= &(CARD s) + aff_dim t`,
1659   REPEAT STRIP_TAC THEN
1660     ABBREV_TAC `n = CARD (s:real^N->bool)` THEN
1661     POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
1662     SPEC_TAC (`s:real^N->bool`, `s:real^N->bool`) THEN
1663     SPEC_TAC (`n:num`, `n:num`) THEN
1664     INDUCT_TAC THEN REPEAT STRIP_TAC THENL
1665     [
1666       MP_TAC (ISPEC `s:real^N->bool` CARD_EQ_0) THEN
1667         ASM_SIMP_TAC[UNION_EMPTY; INT_ADD_LID; INT_LE_REFL];
1668       ALL_TAC
1669     ] THEN
1670     SUBGOAL_THEN `s:real^N->bool HAS_SIZE (SUC n)` MP_TAC THENL
1671     [
1672       ASM_REWRITE_TAC[HAS_SIZE];
1673       ALL_TAC
1674     ] THEN
1675     REWRITE_TAC[HAS_SIZE_CLAUSES; HAS_SIZE] THEN
1676     STRIP_TAC THEN ASM_REWRITE_TAC[INSERT_UNION_EQ; AFF_DIM_INSERT] THEN
1677     FIRST_X_ASSUM (MP_TAC o SPEC `t':real^N->bool`) THEN
1678     ASM_REWRITE_TAC[ARITH_RULE `SUC n = n + 1`; GSYM INT_OF_NUM_ADD] THEN
1679     INT_ARITH_TAC);;
1680
1681 (* DUUNHOR *)
1682 let DUUNHOR = prove(`!V ul vl. packing V /\ saturated V /\
1683                       ul IN barV V 3 /\ vl IN barV V 3 /\
1684                       ~(rogers V ul = rogers V vl) ==>
1685                       coplanar (rogers V ul INTER rogers V vl)`,
1686   REWRITE_TAC[IN] THEN REPEAT STRIP_TAC THEN
1687     SUBGOAL_THEN `LENGTH (ul : (real^3)list) = 4 /\ LENGTH (vl : (real^3)list) = 4` ASSUME_TAC THENL
1688     [
1689       REPLICATE_TAC 3 (POP_ASSUM MP_TAC) THEN SIMP_TAC[BARV; ARITH];
1690       ALL_TAC
1691     ] THEN
1692
1693     ASM_CASES_TAC `~(aff_dim (rogers V ul) = &3)` THENL
1694     [
1695       MATCH_MP_TAC COPLANAR_SUBSET THEN
1696         EXISTS_TAC `rogers V ul` THEN REWRITE_TAC[INTER_SUBSET] THEN
1697         MATCH_MP_TAC AFF_DIM_LE_2_IMP_COPLANAR THEN
1698         MP_TAC (ISPEC `rogers V ul` AFF_DIM_LE_UNIV) THEN REWRITE_TAC[DIMINDEX_3] THEN
1699         POP_ASSUM MP_TAC THEN INT_ARITH_TAC;
1700       ALL_TAC
1701     ] THEN
1702     POP_ASSUM MP_TAC THEN REWRITE_TAC[NOT_CLAUSES] THEN
1703
1704     ASM_CASES_TAC `~(aff_dim (rogers V vl) = &3)` THENL
1705     [
1706       DISCH_THEN (fun th -> ALL_TAC) THEN MATCH_MP_TAC COPLANAR_SUBSET THEN
1707         EXISTS_TAC `rogers V vl` THEN REWRITE_TAC[INTER_SUBSET] THEN
1708         MATCH_MP_TAC AFF_DIM_LE_2_IMP_COPLANAR THEN
1709         MP_TAC (ISPEC `rogers V vl` AFF_DIM_LE_UNIV) THEN REWRITE_TAC[DIMINDEX_3] THEN
1710         POP_ASSUM MP_TAC THEN INT_ARITH_TAC;
1711       ALL_TAC
1712     ] THEN
1713     POP_ASSUM MP_TAC THEN REWRITE_TAC[NOT_CLAUSES] THEN
1714
1715     SUBGOAL_THEN `?k. k <= 3 /\ (!i. i < k ==> omega_list_n V ul i = omega_list_n V vl i /\
1716                      voronoi_list V (truncate_simplex i ul) = voronoi_list V (truncate_simplex i vl)) /\
1717                      ~(voronoi_list V (truncate_simplex k ul) = voronoi_list V (truncate_simplex k vl))` MP_TAC THENL
1718     [
1719       ONCE_REWRITE_TAC[GSYM NOT_CLAUSES] THEN UNDISCH_TAC `~(rogers V ul = rogers V vl)` THEN
1720         REWRITE_TAC[CONTRAPOS_THM; NOT_EXISTS_THM; DE_MORGAN_THM; NOT_FORALL_THM; NOT_IMP] THEN
1721         REWRITE_TAC[ROGERS] THEN DISCH_TAC THEN
1722         AP_TERM_TAC THEN
1723         SUBGOAL_THEN `!i. i < 4 ==> omega_list_n V ul i = omega_list_n V vl i /\ voronoi_list V (truncate_simplex i ul) = voronoi_list V (truncate_simplex i vl)` ASSUME_TAC THENL
1724         [
1725           MATCH_MP_TAC num_WF THEN INDUCT_TAC THEN ASM_REWRITE_TAC[OMEGA_LIST_N] THENL
1726             [
1727               REPLICATE_TAC 2 (DISCH_THEN (fun th -> ALL_TAC)) THEN
1728                 POP_ASSUM (MP_TAC o SPEC `0`) THEN
1729                 REWRITE_TAC[ARITH_RULE `~(0 <= 3) <=> F`; ARITH_RULE `i < 0 <=> F`; ARITH_RULE `0 < 4`] THEN
1730                 REPLICATE_TAC 3 (POP_ASSUM MP_TAC) THEN
1731                 DISCH_THEN (LABEL_TAC "A") THEN DISCH_THEN (LABEL_TAC "B") THEN DISCH_TAC THEN
1732                 USE_THEN "A" (MP_TAC o MATCH_MP BARV_SUBSET) THEN
1733                 USE_THEN "B" (MP_TAC o MATCH_MP BARV_SUBSET) THEN
1734                 REWRITE_TAC[SUBSET] THEN
1735                 USE_THEN "A" (MP_TAC o MATCH_MP BARV_IMP_HD_IN_SET_OF_LIST) THEN DISCH_TAC THEN
1736                 USE_THEN "B" (MP_TAC o MATCH_MP BARV_IMP_HD_IN_SET_OF_LIST) THEN DISCH_TAC THEN
1737                 DISCH_THEN (MP_TAC o SPEC `HD vl : real^3`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
1738                 DISCH_THEN (MP_TAC o SPEC `HD ul : real^3`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
1739                 MP_TAC (ISPEC `ul:(real^3)list` TRUNCATE_0_EQ_HEAD) THEN
1740                 MP_TAC (ISPEC `vl:(real^3)list` TRUNCATE_0_EQ_HEAD) THEN
1741                 ASM_REWRITE_TAC[ARITH] THEN
1742                 REPLICATE_TAC 2 (DISCH_THEN (fun th -> REWRITE_TAC[th])) THEN
1743                 REWRITE_TAC[VORONOI_LIST_SING] THEN DISCH_TAC THEN
1744                 ASM_REWRITE_TAC[] THEN
1745                 MATCH_MP_TAC VORONOI_CLOSED_EQ_LEMMA THEN
1746                 EXISTS_TAC `V : real^3 -> bool` THEN
1747                 ASM_REWRITE_TAC[];
1748               ALL_TAC
1749             ] THEN
1750
1751             POP_ASSUM (fun th -> ALL_TAC) THEN
1752             DISCH_THEN (LABEL_TAC "A") THEN DISCH_TAC THEN
1753             REMOVE_THEN "A" MP_TAC THEN
1754             FIRST_X_ASSUM (MP_TAC o SPEC `SUC i`) THEN
1755             ASM_SIMP_TAC[ARITH_RULE `SUC i < 4 ==> SUC i <= 3`] THEN
1756             STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
1757             [
1758               DISCH_THEN (MP_TAC o SPEC `i':num`) THEN
1759                 MP_TAC (ARITH_RULE `SUC i < 4 /\ i' < SUC i ==> i' < 4`) THEN
1760                 ASM_SIMP_TAC[];
1761               DISCH_THEN (MP_TAC o SPEC `i':num`) THEN
1762                 MP_TAC (ARITH_RULE `SUC i < 4 /\ i' < SUC i ==> i' < 4`) THEN
1763                 ASM_SIMP_TAC[];
1764               ALL_TAC
1765             ] THEN
1766             DISCH_THEN (MP_TAC o SPEC `i:num`) THEN
1767             ASM_SIMP_TAC[ARITH_RULE `i < SUC i`; ARITH_RULE `SUC i < 4 ==> i < 4`];
1768           ALL_TAC
1769         ] THEN
1770
1771         ASM_REWRITE_TAC[EXTENSION] THEN GEN_TAC THEN
1772         REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN EQ_TAC THENL
1773         [
1774           DISCH_THEN (CHOOSE_THEN ASSUME_TAC) THEN
1775             EXISTS_TAC `x' : num` THEN ASM_REWRITE_TAC[] THEN
1776             FIRST_X_ASSUM (MP_TAC o SPEC `x':num`) THEN ASM_SIMP_TAC[];
1777           DISCH_THEN (CHOOSE_THEN ASSUME_TAC) THEN
1778             EXISTS_TAC `x' : num` THEN ASM_REWRITE_TAC[] THEN
1779             FIRST_X_ASSUM (MP_TAC o SPEC `x':num`) THEN ASM_SIMP_TAC[];
1780         ];
1781       ALL_TAC
1782     ] THEN
1783
1784     DISCH_THEN (CHOOSE_THEN STRIP_ASSUME_TAC) THEN
1785     DISCH_TAC THEN DISCH_TAC THEN
1786     ABBREV_TAC `X = voronoi_list V (truncate_simplex k ul) INTER voronoi_list V (truncate_simplex k vl)` THEN
1787     ABBREV_TAC `Y = IMAGE (omega_list_n V ul) {j | j < k}` THEN
1788     SUBGOAL_THEN `rogers V ul INTER rogers V vl SUBSET convex hull (Y UNION X)` MP_TAC THENL
1789     [
1790       REWRITE_TAC[SUBSET; IN_INTER] THEN X_GEN_TAC `w:real^3` THEN
1791         ABBREV_TAC `YX = convex hull (Y UNION X) : real^3->bool` THEN
1792         ASM_REWRITE_TAC[ROGERS; CONVEX_HULL_FINITE] THEN
1793         ABBREV_TAC `L1 = IMAGE (omega_list_n V ul) {j | j < 4}` THEN
1794         ABBREV_TAC `L2 = IMAGE (omega_list_n V vl) {j | j < 4}` THEN
1795         REWRITE_TAC[GSYM IMP_IMP; IN_ELIM_THM] THEN
1796         DISCH_THEN (X_CHOOSE_THEN `ss : real^3 -> real` STRIP_ASSUME_TAC) THEN
1797         DISCH_THEN (X_CHOOSE_THEN `tt : real^3 -> real` STRIP_ASSUME_TAC) THEN
1798
1799         SUBGOAL_THEN `FINITE (L1:real^3->bool) /\ FINITE (L2:real^3->bool)` ASSUME_TAC THENL
1800         [
1801           CONJ_TAC THEN EXPAND_TAC "L1" THEN EXPAND_TAC "L2" THEN MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[FINITE_NUMSEG_LT];
1802           ALL_TAC
1803         ] THEN
1804
1805         SUBGOAL_THEN `Y SUBSET (L1 : real^3->bool) /\ Y SUBSET (L2 : real^3->bool)` ASSUME_TAC THENL
1806         [
1807           MAP_EVERY EXPAND_TAC ["L1"; "Y"; "L2"] THEN REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN
1808             REPEAT STRIP_TAC THEN EXISTS_TAC `x':num` THEN MP_TAC (ARITH_RULE `x' < k /\ k <= 3 ==> x' < 4`) THEN ASM_SIMP_TAC[];
1809           ALL_TAC
1810         ] THEN
1811
1812         ASM_CASES_TAC `?i. i < k /\ (sum (IMAGE (omega_list_n V ul) {j | j <= i}) ss = &1 \/ sum (IMAGE (omega_list_n V vl) {j | j <= i}) tt = &1)` THENL
1813         [
1814           EXPAND_TAC "YX" THEN
1815             MATCH_MP_TAC IN_TRANS THEN EXISTS_TAC `convex hull Y UNION convex hull X : real^3->bool` THEN
1816             REWRITE_TAC[HULL_UNION_SUBSET; IN_UNION] THEN DISJ1_TAC THEN
1817             REWRITE_TAC[CONVEX_HULL_FINITE; IN_ELIM_THM] THEN
1818             POP_ASSUM MP_TAC THEN STRIP_TAC THENL
1819             [
1820               ABBREV_TAC `Li = IMAGE (omega_list_n V ul) {j | j <= i}` THEN
1821                 EXISTS_TAC `ss : real^3->real` THEN
1822                 MP_TAC (ISPECL[`ss:real^3->real`; `Li:real^3->bool`; `L1 DIFF Li:real^3->bool`; `L1:real^3->bool`] (GEN_ALL SUM_UNION_EQ)) THEN
1823                 ANTS_TAC THENL
1824                 [
1825                   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
1826                     [
1827                       REWRITE_TAC[EXTENSION; IN_INTER; IN_DIFF] THEN REPEAT STRIP_TAC THEN SET_TAC[];
1828                       EXPAND_TAC "L1" THEN EXPAND_TAC "Li" THEN
1829                         REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNION; IN_IMAGE; IN_ELIM_THM] THEN GEN_TAC THEN
1830                         EQ_TAC THEN REPEAT STRIP_TAC THENL
1831                         [
1832                           EXISTS_TAC `x':num` THEN
1833                             MP_TAC (ARITH_RULE `x' <= i /\ i < k /\ k <= 3 ==> x' < 4`) THEN
1834                             ASM_SIMP_TAC[];
1835                           EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[];
1836                           REWRITE_TAC[TAUT `A \/ B /\ ~A <=> A \/ B`] THEN DISJ2_TAC THEN
1837                             EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[]
1838                         ];
1839                     ];
1840                   ALL_TAC
1841                 ] THEN
1842
1843                 ASM_REWRITE_TAC[REAL_ARITH `&1 + a = &1 <=> a = &0`] THEN
1844                 DISCH_TAC THEN
1845                 MP_TAC (ISPECL[`ss:real^3->real`; `L1 DIFF Li:real^3->bool`] SUM_POS_EQ_0) THEN
1846                 ANTS_TAC THENL
1847                 [
1848                   REPEAT CONJ_TAC THENL
1849                     [
1850                       MATCH_MP_TAC FINITE_DIFF THEN ASM_REWRITE_TAC[];
1851                       REWRITE_TAC[IN_DIFF] THEN
1852                         REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[];
1853                       ALL_TAC
1854                     ] THEN
1855                     ASM_REWRITE_TAC[];
1856                   ALL_TAC
1857                 ] THEN
1858
1859                 DISCH_TAC THEN
1860                 REPEAT CONJ_TAC THENL
1861                 [
1862                   EXPAND_TAC "Y" THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN
1863                     REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
1864                     EXPAND_TAC "L1" THEN ASM_REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN
1865                     EXISTS_TAC `x':num` THEN MP_TAC (ARITH_RULE `x' < k /\ k <= 3 ==> x' < 4`) THEN
1866                     ASM_SIMP_TAC[];
1867                   UNDISCH_TAC `sum Li (ss:real^3->real) = &1` THEN
1868                     DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
1869                     MATCH_MP_TAC SUM_SUPERSET THEN
1870                     CONJ_TAC THENL
1871                     [
1872                       EXPAND_TAC "Li" THEN EXPAND_TAC "Y" THEN
1873                         REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
1874                         EXISTS_TAC `x':num` THEN MP_TAC (ARITH_RULE `x' <= i /\ i < k ==> x' < k:num`) THEN
1875                         ASM_SIMP_TAC[];
1876                       ALL_TAC
1877                     ] THEN
1878                     EXPAND_TAC "Y" THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
1879                     FIRST_X_ASSUM MATCH_MP_TAC THEN
1880                     ASM_REWRITE_TAC[IN_DIFF] THEN EXPAND_TAC "L1" THEN
1881                     REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN
1882                     EXISTS_TAC `x':num` THEN MP_TAC (ARITH_RULE `x' < k /\ k <= 3 ==> x' < 4`) THEN
1883                     ASM_SIMP_TAC[];
1884                   ALL_TAC
1885                 ] THEN
1886
1887                 UNDISCH_TAC `vsum L1 (\x:real^3. ss x % x) = w` THEN
1888                 DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
1889                 MATCH_MP_TAC EQ_SYM THEN
1890                 MATCH_MP_TAC VSUM_SUPERSET THEN
1891                 ASM_REWRITE_TAC[] THEN
1892                 EXPAND_TAC "Y" THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
1893                 REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN
1894                 FIRST_X_ASSUM MATCH_MP_TAC THEN
1895                 POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF; CONTRAPOS_THM] THEN
1896                 EXPAND_TAC "Li" THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN
1897                 REPEAT STRIP_TAC THEN
1898                 EXISTS_TAC `x':num` THEN MP_TAC (ARITH_RULE `x' <= i /\ i < k ==> x' < k : num`) THEN
1899                 ASM_SIMP_TAC[];
1900               ALL_TAC
1901             ] THEN
1902
1903             (* The second case *)
1904             ABBREV_TAC `Li = IMAGE (omega_list_n V vl) {j | j <= i}` THEN
1905             EXISTS_TAC `tt : real^3->real` THEN
1906             MP_TAC (ISPECL[`tt:real^3->real`; `Li:real^3->bool`; `L2 DIFF Li:real^3->bool`; `L2:real^3->bool`] (GEN_ALL SUM_UNION_EQ)) THEN
1907             ANTS_TAC THENL
1908             [
1909               ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
1910                 [
1911                   REWRITE_TAC[EXTENSION; IN_INTER; IN_DIFF] THEN REPEAT STRIP_TAC THEN SET_TAC[];
1912                   EXPAND_TAC "L2" THEN EXPAND_TAC "Li" THEN
1913                     REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNION; IN_IMAGE; IN_ELIM_THM] THEN GEN_TAC THEN
1914                     EQ_TAC THEN REPEAT STRIP_TAC THENL
1915                     [
1916                       EXISTS_TAC `x':num` THEN
1917                         MP_TAC (ARITH_RULE `x' <= i /\ i < k /\ k <= 3 ==> x' < 4`) THEN
1918                         ASM_SIMP_TAC[];
1919                       EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[];
1920                       REWRITE_TAC[TAUT `A \/ B /\ ~A <=> A \/ B`] THEN DISJ2_TAC THEN
1921                         EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[]
1922                     ];
1923                 ];
1924               ALL_TAC
1925             ] THEN
1926
1927             ASM_REWRITE_TAC[REAL_ARITH `&1 + a = &1 <=> a = &0`] THEN
1928             DISCH_TAC THEN
1929             MP_TAC (ISPECL[`tt:real^3->real`; `L2 DIFF Li:real^3->bool`] SUM_POS_EQ_0) THEN
1930             ANTS_TAC THENL
1931             [
1932               REPEAT CONJ_TAC THENL
1933                 [
1934                   MATCH_MP_TAC FINITE_DIFF THEN ASM_REWRITE_TAC[];
1935                   REWRITE_TAC[IN_DIFF] THEN
1936                     REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[];
1937                   ALL_TAC
1938                 ] THEN
1939                 ASM_REWRITE_TAC[];
1940               ALL_TAC
1941             ] THEN
1942
1943             DISCH_TAC THEN
1944             SUBGOAL_THEN `Li SUBSET (Y : real^3->bool)` ASSUME_TAC THENL
1945             [
1946               EXPAND_TAC "Li" THEN EXPAND_TAC "Y" THEN
1947                 REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
1948                 EXISTS_TAC `x':num` THEN MP_TAC (ARITH_RULE `x' <= i /\ i < k ==> x' < k:num`) THEN
1949                 ASM_SIMP_TAC[];
1950               ALL_TAC
1951             ] THEN
1952
1953             REPEAT CONJ_TAC THENL
1954             [
1955               REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
1956                 MATCH_MP_TAC IN_TRANS THEN EXISTS_TAC `Y:real^3->bool` THEN ASM_REWRITE_TAC[];
1957               UNDISCH_TAC `sum Li (tt:real^3->real) = &1` THEN
1958                 DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
1959                 MATCH_MP_TAC SUM_SUPERSET THEN ASM_REWRITE_TAC[] THEN
1960                 REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
1961                 ASM_REWRITE_TAC[IN_DIFF] THEN
1962                 MATCH_MP_TAC IN_TRANS THEN EXISTS_TAC `Y:real^3->bool` THEN ASM_REWRITE_TAC[];
1963               ALL_TAC
1964             ] THEN
1965
1966             UNDISCH_TAC `vsum L2(\x:real^3. tt x % x) = w` THEN
1967             DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
1968             MATCH_MP_TAC EQ_SYM THEN
1969             MATCH_MP_TAC VSUM_SUPERSET THEN
1970
1971             ASM_REWRITE_TAC[] THEN
1972             REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
1973             REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN
1974             FIRST_X_ASSUM MATCH_MP_TAC THEN
1975             POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF; CONTRAPOS_THM] THEN
1976             POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN SIMP_TAC[SUBSET];
1977           ALL_TAC
1978         ] THEN
1979
1980         POP_ASSUM MP_TAC THEN REWRITE_TAC[NOT_EXISTS_THM; DE_MORGAN_THM] THEN
1981         DISCH_THEN (LABEL_TAC "not1") THEN
1982
1983         (* ss i = tt i for i < k *)
1984         SUBGOAL_THEN `!i. i < k ==> ss (omega_list_n V ul i) : real = tt (omega_list_n V vl i : real^3)` MP_TAC THENL
1985         [
1986           MATCH_MP_TAC num_WF THEN REPEAT STRIP_TAC THEN
1987             ASM_SIMP_TAC[] THEN
1988             REMOVE_THEN "not1" (MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
1989             ABBREV_TAC `a = sum (IMAGE (omega_list_n V ul) {j | j <= i}) ss` THEN
1990             ABBREV_TAC `b = sum (IMAGE (omega_list_n V vl) {j | j <= i}) tt` THEN
1991             ABBREV_TAC `Lu = IMAGE (omega_list_n V ul) {j | i < j /\ j < 4}` THEN
1992             ABBREV_TAC `Lv = IMAGE (omega_list_n V vl) {j | i < j /\ j < 4}` THEN
1993
1994             (* sum Lu ss = 1 - a *)
1995             SUBGOAL_THEN `sum Lu (ss:real^3->real) = &1 - a` ASSUME_TAC THENL
1996             [
1997               UNDISCH_TAC `sum (L1:real^3->bool) ss = &1` THEN
1998                 DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
1999                 REWRITE_TAC[REAL_ARITH `a = b - c <=> a + c = b : real`] THEN
2000                 EXPAND_TAC "a" THEN
2001                 MATCH_MP_TAC SUM_UNION_EQ THEN ASM_REWRITE_TAC[] THEN
2002                 EXPAND_TAC "Lu" THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_UNION; IN_IMAGE; IN_ELIM_THM] THEN
2003                 REPEAT STRIP_TAC THENL
2004                 [
2005                   REWRITE_TAC[NOT_IN_EMPTY] THEN STRIP_TAC THEN
2006                     MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`] ROGERS_AFF_DIM_FULL) THEN
2007                     ASM_REWRITE_TAC[] THEN
2008                     DISCH_THEN (MP_TAC o SPECL [`x':num`; `x'':num`]) THEN
2009                     ANTS_TAC THENL
2010                     [
2011                       MP_TAC (ARITH_RULE `x'' <= i /\ i < k /\ k <= 3 ==> x'' < 4`) THEN
2012                         MP_TAC (ARITH_RULE `x'' <= i /\ i < x' ==> ~(x' = x'':num)`) THEN
2013                         ASM_SIMP_TAC[];
2014                       ALL_TAC
2015                     ] THEN
2016                     POP_ASSUM MP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
2017                     ASM_REWRITE_TAC[];
2018                   ALL_TAC
2019                 ] THEN
2020                 EXPAND_TAC "L1" THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN EQ_TAC THEN STRIP_TAC THENL
2021                 [
2022                   EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[];
2023                   EXISTS_TAC `x':num` THEN MP_TAC (ARITH_RULE `x' <= i /\ i < k /\ k <= 3 ==> x' < 4`) THEN
2024                     ASM_SIMP_TAC[];
2025                   ALL_TAC
2026                 ] THEN
2027                 ASM_CASES_TAC `x' <= i : num` THENL
2028                 [
2029                   DISJ2_TAC THEN EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[];
2030                   ALL_TAC
2031                 ] THEN
2032                 DISJ1_TAC THEN
2033                 EXISTS_TAC `x':num` THEN POP_ASSUM MP_TAC THEN ASM_SIMP_TAC[NOT_LE];
2034               ALL_TAC
2035             ] THEN
2036
2037             (* sum Lv tt = 1 - b *)
2038             SUBGOAL_THEN `sum Lv (tt:real^3->real) = &1 - b` ASSUME_TAC THENL
2039             [
2040               UNDISCH_TAC `sum (L2:real^3->bool) tt = &1` THEN
2041                 DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
2042                 REWRITE_TAC[REAL_ARITH `a = b - c <=> a + c = b : real`] THEN
2043                 EXPAND_TAC "b" THEN
2044                 MATCH_MP_TAC SUM_UNION_EQ THEN ASM_REWRITE_TAC[] THEN
2045                 EXPAND_TAC "Lv" THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_UNION; IN_IMAGE; IN_ELIM_THM] THEN
2046                 REPEAT STRIP_TAC THENL
2047                 [
2048                   REWRITE_TAC[NOT_IN_EMPTY] THEN STRIP_TAC THEN
2049                     MP_TAC (SPECL [`V:real^3->bool`; `vl:(real^3)list`] ROGERS_AFF_DIM_FULL) THEN
2050                     ASM_REWRITE_TAC[] THEN
2051                     DISCH_THEN (MP_TAC o SPECL [`x':num`; `x'':num`]) THEN
2052                     ANTS_TAC THENL
2053                     [
2054                       MP_TAC (ARITH_RULE `x'' <= i /\ i < k /\ k <= 3 ==> x'' < 4`) THEN
2055                         MP_TAC (ARITH_RULE `x'' <= i /\ i < x' ==> ~(x' = x'':num)`) THEN
2056                         ASM_SIMP_TAC[];
2057                       ALL_TAC
2058                     ] THEN
2059                     POP_ASSUM MP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
2060                     ASM_REWRITE_TAC[];
2061                   ALL_TAC
2062                 ] THEN
2063                 EXPAND_TAC "L2" THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN EQ_TAC THEN STRIP_TAC THENL
2064                 [
2065                   EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[];
2066                   EXISTS_TAC `x':num` THEN MP_TAC (ARITH_RULE `x' <= i /\ i < k /\ k <= 3 ==> x' < 4`) THEN
2067                     ASM_SIMP_TAC[];
2068                   ALL_TAC
2069                 ] THEN
2070                 ASM_CASES_TAC `x' <= i : num` THENL
2071                 [
2072                   DISJ2_TAC THEN EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[];
2073                   ALL_TAC
2074                 ] THEN
2075                 DISJ1_TAC THEN
2076                 EXISTS_TAC `x':num` THEN POP_ASSUM MP_TAC THEN ASM_SIMP_TAC[NOT_LE];
2077               ALL_TAC
2078             ] THEN
2079
2080             (* a < 1 /\ b < 1 *)
2081             SUBGOAL_THEN `&0 < &1 - a /\ &0 < &1 - b` ASSUME_TAC THENL
2082             [
2083               ASM_REWRITE_TAC[REAL_ARITH `&0 < &1 - a <=> a <= &1 /\ ~(a = &1)`] THEN
2084                 REPLICATE_TAC 6 (POP_ASSUM (fun th -> REWRITE_TAC[SYM th])) THEN
2085                 CONJ_TAC THENL
2086                 [
2087                   UNDISCH_TAC `sum (L1:real^3->bool) ss = &1` THEN
2088                     DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
2089                     MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_REWRITE_TAC[] THEN
2090                     CONJ_TAC THENL
2091                     [
2092                       EXPAND_TAC "L1" THEN REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN
2093                         REPEAT STRIP_TAC THEN
2094                         EXISTS_TAC `x':num` THEN MP_TAC (ARITH_RULE `x' <= i /\ i < k /\ k <= 3 ==> x' < 4`) THEN
2095                         ASM_SIMP_TAC[];
2096                       ALL_TAC
2097                     ] THEN
2098
2099                     REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN
2100                     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[];
2101                   ALL_TAC
2102                 ] THEN
2103                 UNDISCH_TAC `sum (L2:real^3->bool) tt = &1` THEN
2104                 DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
2105                 MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_REWRITE_TAC[] THEN
2106                 CONJ_TAC THENL
2107                 [
2108                   EXPAND_TAC "L2" THEN REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN
2109                     REPEAT STRIP_TAC THEN
2110                     EXISTS_TAC `x':num` THEN MP_TAC (ARITH_RULE `x' <= i /\ i < k /\ k <= 3 ==> x' < 4`) THEN
2111                     ASM_SIMP_TAC[];
2112                   ALL_TAC
2113                 ] THEN
2114
2115                 REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN
2116                 FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[];
2117               ALL_TAC
2118             ] THEN
2119
2120             (* Abbreviations *)
2121             ABBREV_TAC `p0 = omega_list_n V vl i` THEN
2122             ABBREV_TAC `p = inv (&1 - a) % vsum Lu (\x : real^3. ss x % x)` THEN
2123             ABBREV_TAC `p' = inv (&1 - b) % vsum Lv (\x : real^3. tt x % x)` THEN
2124
2125             ABBREV_TAC `Lu_le = IMAGE (omega_list_n V ul) {j | j <= i}` THEN
2126             ABBREV_TAC `Lv_le = IMAGE (omega_list_n V vl) {j | j <= i}` THEN
2127
2128             (* a = sum {j < i} ss + ss p0 *)
2129             SUBGOAL_THEN `a = sum (Lu_le DELETE p0 : real^3) ss + ss p0` ASSUME_TAC THENL
2130             [
2131               MP_TAC (ISPECL[`ss:real^3->real`; `Lu_le:real^3->bool`; `p0:real^3`] SUM_DELETE) THEN
2132                 ANTS_TAC THEN EXPAND_TAC "Lu_le" THENL
2133                 [
2134                   CONJ_TAC THENL
2135                     [
2136                       MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[FINITE_NUMSEG_LE];
2137                       ALL_TAC
2138                     ] THEN
2139                     EXPAND_TAC "p0" THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN
2140                     EXISTS_TAC `i:num` THEN ASM_SIMP_TAC[LE_REFL];
2141                   ALL_TAC
2142                 ] THEN
2143                 ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
2144               ALL_TAC
2145             ] THEN
2146
2147             (* b = sum {j < i} tt + tt p0 *)
2148             SUBGOAL_THEN `b = sum (Lv_le DELETE p0 : real^3) tt + tt p0` ASSUME_TAC THENL
2149             [
2150               MP_TAC (ISPECL[`tt:real^3->real`; `Lv_le:real^3->bool`; `p0:real^3`] SUM_DELETE) THEN
2151                 ANTS_TAC THEN EXPAND_TAC "Lv_le" THENL
2152                 [
2153                   CONJ_TAC THENL
2154                     [
2155                       MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[FINITE_NUMSEG_LE];
2156                       ALL_TAC
2157                     ] THEN
2158                     EXPAND_TAC "p0" THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN
2159                     EXISTS_TAC `i:num` THEN ASM_SIMP_TAC[LE_REFL];
2160                   ALL_TAC
2161                 ] THEN
2162                 ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
2163               ALL_TAC
2164             ] THEN
2165
2166             (* Lu_le = Lv_le *)
2167             SUBGOAL_THEN `Lu_le = Lv_le : real^3->bool` (LABEL_TAC "L_eq") THENL
2168             [
2169               EXPAND_TAC "Lu_le" THEN EXPAND_TAC "Lv_le" THEN
2170                 REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN GEN_TAC THEN
2171                 EQ_TAC THEN STRIP_TAC THEN EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[] THENL
2172                 [
2173                   MP_TAC (ARITH_RULE `x' <= i /\ i < k ==> x' < k : num`) THEN ASM_REWRITE_TAC[] THEN
2174                     DISCH_TAC THEN ASM_SIMP_TAC[];
2175                   ALL_TAC
2176                 ] THEN
2177                 MP_TAC (ARITH_RULE `x' <= i /\ i < k ==> x' < k : num`) THEN ASM_REWRITE_TAC[] THEN
2178                 DISCH_TAC THEN ASM_SIMP_TAC[];
2179               ALL_TAC
2180             ] THEN
2181
2182             (* sum {j < i} ss = sum {j < i} tt *)
2183             SUBGOAL_THEN `sum (Lv_le DELETE p0 : real^3) ss = sum (Lv_le DELETE p0) tt` ASSUME_TAC THENL
2184             [
2185               MATCH_MP_TAC SUM_EQ THEN POP_ASSUM (fun th -> ALL_TAC) THEN EXPAND_TAC "Lv_le" THEN
2186                 REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; IN_DELETE] THEN REPEAT STRIP_TAC THEN
2187                 ASM_REWRITE_TAC[] THEN
2188                 FIRST_X_ASSUM (MP_TAC o SPEC `x':num`) THEN
2189                 SUBGOAL_THEN `~(x' = i:num)` ASSUME_TAC THENL
2190                 [
2191                   POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN
2192                     EXPAND_TAC "p0" THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
2193                     ASM_REWRITE_TAC[];
2194                   ALL_TAC
2195                 ] THEN
2196
2197                 ASM_REWRITE_TAC[LT_LE] THEN REWRITE_TAC[GSYM LT_LE] THEN
2198                 ANTS_TAC THENL
2199                 [
2200                   MATCH_MP_TAC (ARITH_RULE `x' <= i /\ i < k ==> x' < k : num`) THEN
2201                     ASM_REWRITE_TAC[];
2202                   ALL_TAC
2203                 ] THEN
2204
2205                 MP_TAC (ARITH_RULE `x' <= i /\ i < k ==> x' < k : num`) THEN
2206                 ASM_SIMP_TAC[];
2207               ALL_TAC
2208             ] THEN
2209
2210             SUBGOAL_THEN `&1 - a = &1 - b ==> (ss:real^3->real) p0 = tt p0` MATCH_MP_TAC THENL
2211             [
2212               ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
2213               ALL_TAC
2214             ] THEN
2215
2216             MATCH_MP_TAC (ISPEC `voronoi_list V (truncate_simplex i ul)` ODIGPXU) THEN
2217             EXISTS_TAC `voronoi_list V (truncate_simplex (i + 1) vl)` THEN
2218             EXISTS_TAC `voronoi_list V (truncate_simplex (i + 1) ul)` THEN
2219             MAP_EVERY EXISTS_TAC [`p0:real^3`; `p':real^3`; `p:real^3`] THEN
2220             REPEAT STRIP_TAC THENL
2221             [
2222               (* polyhedron *)
2223               MATCH_MP_TAC POLYHEDRON_VORONOI_LIST THEN ASM_REWRITE_TAC[] THEN
2224                 MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `set_of_list ul : real^3->bool` THEN
2225                 CONJ_TAC THENL
2226                 [
2227                   MATCH_MP_TAC SET_OF_LIST_TRUNCATE_SIMPLEX_SUBSET THEN
2228                     ASM_REWRITE_TAC[] THEN MP_TAC (ARITH_RULE `i < k /\ k <= 3 ==> i + 1 <= 4`) THEN
2229                     ASM_SIMP_TAC[];
2230                   ALL_TAC
2231                 ] THEN
2232                 MATCH_MP_TAC BARV_SUBSET THEN EXISTS_TAC `3` THEN ASM_REWRITE_TAC[];
2233
2234               (* p0 IN polyhedron *)
2235               ASM_SIMP_TAC[] THEN EXPAND_TAC "p0" THEN
2236                 MATCH_MP_TAC OMEGA_LIST_N_IN_VORONOI_LIST THEN
2237                 EXISTS_TAC `3` THEN MP_TAC (ARITH_RULE `i < k /\ k <= 3 ==> i <= 3`) THEN
2238                 ASM_SIMP_TAC[];
2239
2240               (* ~(p0 IN F UNION F') *)
2241               POP_ASSUM MP_TAC THEN REWRITE_TAC[IN_UNION] THEN STRIP_TAC THENL
2242                 [
2243                   POP_ASSUM MP_TAC THEN EXPAND_TAC "p0" THEN
2244                     REWRITE_TAC[ARITH_RULE `i + 1 = SUC i`] THEN
2245                     DISCH_THEN (MP_TAC o MATCH_MP OMEGA_LIST_N_EQ) THEN
2246                     REWRITE_TAC[] THEN
2247                     MP_TAC (SPECL [`V:real^3->bool`; `vl:(real^3)list`] ROGERS_AFF_DIM_FULL) THEN
2248                     ASM_REWRITE_TAC[] THEN EXPAND_TAC "p0" THEN DISCH_THEN MATCH_MP_TAC THEN
2249                     ASM_REWRITE_TAC[ARITH_RULE `~(SUC i = i)`] THEN
2250                     MATCH_MP_TAC (ARITH_RULE `i < k /\ k <= 3 ==> SUC i < 4 /\ i < 4`) THEN
2251                     ASM_REWRITE_TAC[];
2252                   ALL_TAC
2253                 ] THEN
2254                 POP_ASSUM MP_TAC THEN
2255                 REPLICATE_TAC 2 (FIRST_X_ASSUM (MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN
2256                 DISCH_THEN (fun th -> REWRITE_TAC[GSYM th]) THEN DISCH_TAC THEN
2257                 REWRITE_TAC[ARITH_RULE `i + 1 = SUC i`] THEN
2258                 DISCH_THEN (MP_TAC o MATCH_MP OMEGA_LIST_N_EQ) THEN
2259                 REWRITE_TAC[] THEN
2260                 MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`] ROGERS_AFF_DIM_FULL) THEN
2261                 ASM_REWRITE_TAC[] THEN EXPAND_TAC "p0" THEN DISCH_THEN MATCH_MP_TAC THEN
2262                 ASM_REWRITE_TAC[ARITH_RULE `~(SUC i = i)`] THEN
2263                 MATCH_MP_TAC (ARITH_RULE `i < k /\ k <= 3 ==> SUC i < 4 /\ i < 4`) THEN
2264                 ASM_REWRITE_TAC[];
2265
2266               (* F facet_of polyhedron *)
2267               MP_TAC (SPECL[`V:real^3->bool`; `vl:(real^3)list`; `3`; `i:num`] OMEGA_LIST_N_IN_FACET) THEN
2268                 ASM_SIMP_TAC[] THEN MP_TAC (ARITH_RULE `i < k /\ k <= 3 ==> i < 3`) THEN
2269                 ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
2270                 STRIP_TAC THEN ASM_REWRITE_TAC[];
2271
2272               (* F' facet_of polyhedron *)
2273               MP_TAC (SPECL[`V:real^3->bool`; `ul:(real^3)list`; `3`; `i:num`] OMEGA_LIST_N_IN_FACET) THEN
2274                 ASM_REWRITE_TAC[] THEN MP_TAC (ARITH_RULE `i < k /\ k <= 3 ==> i < 3`) THEN
2275                 ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
2276                 STRIP_TAC THEN ASM_REWRITE_TAC[];
2277
2278               (* p' IN F *)
2279               MP_TAC (ISPEC `voronoi_list V (truncate_simplex (i + 1) vl)` CONVEX_HULL_EQ) THEN
2280                 REWRITE_TAC[CONVEX_VORONOI_LIST] THEN
2281                 DISCH_THEN (fun th -> ONCE_REWRITE_TAC[SYM th]) THEN
2282                 REWRITE_TAC[CONVEX_HULL_EXPLICIT; IN_ELIM_THM] THEN
2283                 EXISTS_TAC `Lv : real^3->bool` THEN
2284                 EXISTS_TAC `\x:real^3. inv (&1 - b) * tt x` THEN
2285                 REPEAT STRIP_TAC THENL
2286                 [
2287                   EXPAND_TAC "Lv" THEN MATCH_MP_TAC FINITE_IMAGE THEN
2288                     MATCH_MP_TAC FINITE_SUBSET THEN
2289                     EXISTS_TAC `{j | j < 4}` THEN REWRITE_TAC[FINITE_NUMSEG_LT] THEN
2290                     SIMP_TAC[SUBSET; IN_ELIM_THM];
2291                   EXPAND_TAC "Lv" THEN REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN
2292                     REPEAT STRIP_TAC THEN
2293                     MP_TAC (SPECL[`V:real^3->bool`; `vl:(real^3)list`; `3`; `i:num`] OMEGA_LIST_N_IN_FACET) THEN
2294                     ANTS_TAC THEN ASM_REWRITE_TAC[] THENL
2295                     [
2296                       MP_TAC (ARITH_RULE `i < k /\ k <= 3 ==> i < 3`) THEN ASM_SIMP_TAC[];
2297                       ALL_TAC
2298                     ] THEN
2299                     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2300                     FIRST_X_ASSUM MATCH_MP_TAC THEN
2301                     ASM_REWRITE_TAC[ARITH_RULE `x' <= 3 <=> x' < 4`];
2302                   REWRITE_TAC[] THEN
2303                     MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ; REAL_LE_LT] THEN
2304                     REWRITE_TAC[GSYM REAL_LE_LT] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
2305                     POP_ASSUM MP_TAC THEN EXPAND_TAC "Lv" THEN EXPAND_TAC "L2" THEN
2306                     REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
2307                     EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[];
2308                   ASM_REWRITE_TAC[SUM_LMUL] THEN
2309                     MP_TAC (REAL_ARITH `~(b = &1) ==> ~(&1 - b = &0)`) THEN
2310                     ASM_SIMP_TAC[REAL_MUL_LINV];
2311                   ALL_TAC
2312                 ] THEN
2313                 REPLICATE_TAC 4 (POP_ASSUM (fun th -> ALL_TAC)) THEN
2314                 ASM_REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; VSUM_LMUL];
2315
2316               (* p IN F' *)
2317               REPLICATE_TAC 4 (POP_ASSUM (fun th -> ALL_TAC)) THEN
2318                 MP_TAC (ISPEC `voronoi_list V (truncate_simplex (i + 1) ul)` CONVEX_HULL_EQ) THEN
2319                 REWRITE_TAC[CONVEX_VORONOI_LIST] THEN
2320                 DISCH_THEN (fun th -> ONCE_REWRITE_TAC[SYM th]) THEN
2321                 REWRITE_TAC[CONVEX_HULL_EXPLICIT; IN_ELIM_THM] THEN
2322                 EXISTS_TAC `Lu : real^3->bool` THEN
2323                 EXISTS_TAC `\x:real^3. inv (&1 - a) * ss x` THEN
2324                 REPEAT STRIP_TAC THENL
2325                 [
2326                   EXPAND_TAC "Lu" THEN MATCH_MP_TAC FINITE_IMAGE THEN
2327                     MATCH_MP_TAC FINITE_SUBSET THEN
2328                     EXISTS_TAC `{j | j < 4}` THEN REWRITE_TAC[FINITE_NUMSEG_LT] THEN
2329                     SIMP_TAC[SUBSET; IN_ELIM_THM];
2330                   EXPAND_TAC "Lu" THEN REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN
2331                     REPEAT STRIP_TAC THEN
2332                     MP_TAC (SPECL[`V:real^3->bool`; `ul:(real^3)list`; `3`; `i:num`] OMEGA_LIST_N_IN_FACET) THEN
2333                     ANTS_TAC THEN ASM_REWRITE_TAC[] THENL
2334                     [
2335                       MP_TAC (ARITH_RULE `i < k /\ k <= 3 ==> i < 3`) THEN ASM_SIMP_TAC[];
2336                       ALL_TAC
2337                     ] THEN
2338                     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2339                     FIRST_X_ASSUM MATCH_MP_TAC THEN
2340                     ASM_REWRITE_TAC[ARITH_RULE `x' <= 3 <=> x' < 4`];
2341                   REWRITE_TAC[] THEN
2342                     MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ; REAL_LE_LT] THEN
2343                     REWRITE_TAC[GSYM REAL_LE_LT] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
2344                     POP_ASSUM MP_TAC THEN EXPAND_TAC "Lu" THEN EXPAND_TAC "L1" THEN
2345                     REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
2346                     EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[];
2347                   ASM_REWRITE_TAC[SUM_LMUL] THEN
2348                     ASM_SIMP_TAC[REAL_ARITH `~(a = &1) ==> ~(&1 - a = &0)`; REAL_MUL_LINV];
2349                   ALL_TAC
2350                 ] THEN
2351                 ASM_REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; VSUM_LMUL];
2352
2353               (* &0 < &1 - b *)
2354               ASM_REWRITE_TAC[];
2355
2356               (* &0 < &1 - a *)
2357               ASM_REWRITE_TAC[];
2358
2359               ALL_TAC
2360             ] THEN
2361             (* b * p0 + (1 - b) * p' = a * p0 + (1 - a) * p *)
2362             REWRITE_TAC[REAL_ARITH `&1 - (&1 - b) = b`] THEN
2363             EXPAND_TAC "p" THEN EXPAND_TAC "p'" THEN
2364             REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
2365             SUBGOAL_THEN `(&1 - b) * inv (&1 - b) = &1 /\ (&1 - a) * inv (&1 - a) = &1` (fun th -> REWRITE_TAC[th]) THENL
2366             [
2367               CONJ_TAC THEN MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[REAL_ARITH `~(&1 - b = &0) <=> ~(b = &1)`];
2368               ALL_TAC
2369             ] THEN
2370             ASM_REWRITE_TAC[VECTOR_MUL_LID; VECTOR_ADD_RDISTRIB] THEN
2371             REWRITE_TAC[VECTOR_ARITH `(a + b) + c = (a + d) + e <=> b + c = d + e : real^3`] THEN
2372
2373             (* vsum (Lv_le DELETE p0) ss = vsum (Lv_le DELETE p0) tt *)
2374             SUBGOAL_THEN `vsum (Lv_le DELETE p0) (\x:real^3. tt x % x) = vsum (Lv_le DELETE p0) (\x. ss x % x)` ASSUME_TAC THENL
2375             [
2376               MATCH_MP_TAC VSUM_EQ THEN UNDISCH_TAC `Lu_le = Lv_le : real^3->bool` THEN
2377                 DISCH_THEN (fun th -> ALL_TAC) THEN EXPAND_TAC "Lv_le" THEN
2378                 REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; IN_DELETE] THEN REPEAT STRIP_TAC THEN
2379                 ASM_REWRITE_TAC[VECTOR_MUL_RCANCEL] THEN DISJ1_TAC THEN
2380                 FIRST_X_ASSUM (MP_TAC o SPEC `x':num`) THEN
2381                 SUBGOAL_THEN `~(x' = i:num)` ASSUME_TAC THENL
2382                 [
2383                   POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN
2384                     EXPAND_TAC "p0" THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
2385                     ASM_REWRITE_TAC[];
2386                   ALL_TAC
2387                 ] THEN
2388
2389                 ASM_REWRITE_TAC[LT_LE] THEN REWRITE_TAC[GSYM LT_LE] THEN
2390                 ANTS_TAC THENL
2391                 [
2392                   MATCH_MP_TAC (ARITH_RULE `x' <= i /\ i < k ==> x' < k : num`) THEN
2393                     ASM_REWRITE_TAC[];
2394                   ALL_TAC
2395                 ] THEN
2396
2397                 MP_TAC (ARITH_RULE `x' <= i /\ i < k ==> x' < k : num`) THEN
2398                 ASM_SIMP_TAC[];
2399               ALL_TAC
2400             ] THEN
2401
2402             ONCE_REWRITE_TAC[SPEC `vsum (Lv_le DELETE p0:real^3) (\x. tt x % x)` (VECTOR_ARITH `!x y z:real^3. y = z <=> x + y = x + z`)] THEN
2403             ONCE_REWRITE_TAC[VECTOR_ADD_ASSOC] THEN
2404
2405             (* vsum {j < i} + vsum i = vsum {j <= i} *)
2406             SUBGOAL_THEN `vsum (Lv_le DELETE p0) (\x:real^3. tt x % x) + tt p0 % p0 = vsum Lv_le (\x. tt x % x)` (fun th -> REWRITE_TAC[th]) THENL
2407             [
2408               MP_TAC (ISPECL[`\x:real^3. tt x % x`; `Lv_le:real^3->bool`; `p0:real^3`] VSUM_DELETE) THEN
2409                 ANTS_TAC THEN EXPAND_TAC "Lv_le" THEN EXPAND_TAC "Lu_le" THENL
2410                 [
2411                   CONJ_TAC THENL
2412                     [
2413                       MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[FINITE_NUMSEG_LE];
2414                       ALL_TAC
2415                     ] THEN
2416                     EXPAND_TAC "p0" THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN
2417                     EXISTS_TAC `i:num` THEN ASM_SIMP_TAC[LE_REFL];
2418                   ALL_TAC
2419                 ] THEN
2420                 ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC;
2421               ALL_TAC
2422             ] THEN
2423
2424             (* vsum {j < i} + vsum i = vsum {j <= i} *)
2425             SUBGOAL_THEN `vsum (Lv_le DELETE p0) (\x:real^3. tt x % x) + ss p0 % p0 = vsum Lv_le (\x. ss x % x)` (fun th -> REWRITE_TAC[th]) THENL
2426             [
2427               MP_TAC (ISPECL[`\x:real^3. ss x % x`; `Lv_le:real^3->bool`; `p0:real^3`] VSUM_DELETE) THEN
2428                 ANTS_TAC THEN EXPAND_TAC "Lv_le" THEN EXPAND_TAC "Lu_le" THENL
2429                 [
2430                   CONJ_TAC THENL
2431                     [
2432                       MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[FINITE_NUMSEG_LE];
2433                       ALL_TAC
2434                     ] THEN
2435                     EXPAND_TAC "p0" THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN
2436                     EXISTS_TAC `i:num` THEN ASM_SIMP_TAC[LE_REFL];
2437                   ALL_TAC
2438                 ] THEN
2439                 ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC;
2440               ALL_TAC
2441             ] THEN
2442
2443             SUBGOAL_THEN `FINITE (Lv_le:real^3->bool) /\ FINITE (Lv:real^3->bool) /\ FINITE (Lu:real^3->bool)` ASSUME_TAC THENL
2444             [
2445               MAP_EVERY EXPAND_TAC ["Lv_le"; "Lu_le"; "Lv"; "Lu"] THEN
2446                 REPEAT CONJ_TAC THEN MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[FINITE_NUMSEG_LE] THENL
2447                 [
2448                   MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{j | j < 4}` THEN
2449                     SIMP_TAC[FINITE_NUMSEG_LT; SUBSET; IN_ELIM_THM];
2450                   MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{j | j < 4}` THEN
2451                     SIMP_TAC[FINITE_NUMSEG_LT; SUBSET; IN_ELIM_THM];
2452                 ];
2453               ALL_TAC
2454             ] THEN
2455
2456             SUBGOAL_THEN `DISJOINT (Lv_le:real^3->bool) Lv /\ DISJOINT (Lu_le:real^3->bool) Lu` ASSUME_TAC THENL
2457             [
2458               MAP_EVERY EXPAND_TAC ["Lv_le"; "Lu_le"; "Lv"; "Lu"] THEN
2459                 REWRITE_TAC[DISJOINT; EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_IMAGE; IN_ELIM_THM] THEN
2460                 REPEAT STRIP_TAC THENL
2461                 [
2462                   MP_TAC (SPECL [`V:real^3->bool`; `vl:(real^3)list`] ROGERS_AFF_DIM_FULL) THEN
2463                     ASM_REWRITE_TAC[] THEN
2464                     DISCH_THEN (MP_TAC o SPECL [`x':num`; `x'':num`]) THEN
2465                     ANTS_TAC THENL
2466                     [
2467                       MP_TAC (ARITH_RULE `x' <= i /\ i < k /\ k <= 3 ==> x' < 4`) THEN
2468                         MP_TAC (ARITH_RULE `x' <= i /\ i < x'' ==> ~(x' = x'':num)`) THEN
2469                         ASM_SIMP_TAC[];
2470                       ALL_TAC
2471                     ] THEN
2472                     POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
2473                     MP_TAC (ARITH_RULE `x' <= i /\ i < k ==> x' < k:num`) THEN
2474                     ASM_SIMP_TAC[];
2475                   ALL_TAC
2476                 ] THEN
2477
2478                 MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`] ROGERS_AFF_DIM_FULL) THEN
2479                 ASM_REWRITE_TAC[] THEN
2480                 DISCH_THEN (MP_TAC o SPECL [`x':num`; `x'':num`]) THEN
2481                 ANTS_TAC THENL
2482                 [
2483                   MP_TAC (ARITH_RULE `x' <= i /\ i < k /\ k <= 3 ==> x' < 4`) THEN
2484                     MP_TAC (ARITH_RULE `x' <= i /\ i < x'' ==> ~(x' = x'':num)`) THEN
2485                     ASM_SIMP_TAC[];
2486                   ALL_TAC
2487                 ] THEN
2488                 POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
2489                 ASM_REWRITE_TAC[];
2490               ALL_TAC
2491             ] THEN
2492
2493             MP_TAC (ISPECL[`\x:real^3. tt x % x`; `Lv_le:real^3->bool`; `Lv:real^3->bool`] VSUM_UNION) THEN
2494             ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
2495
2496             POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
2497             MP_TAC (ISPECL[`\x:real^3. ss x % x`; `Lv_le:real^3->bool`; `Lu:real^3->bool`] VSUM_UNION) THEN
2498             ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
2499
2500             (* Lv_le UNION Lv = L2 *)
2501             SUBGOAL_THEN `Lv_le UNION Lv = L2 /\ Lv_le UNION Lu = L1 : real^3->bool` (fun th -> REWRITE_TAC[th]) THENL
2502             [
2503               CONJ_TAC THENL
2504                 [
2505                   REMOVE_THEN "L_eq" (fun th -> ALL_TAC) THEN
2506                     EXPAND_TAC "Lv_le" THEN EXPAND_TAC "L2" THEN EXPAND_TAC "Lv" THEN
2507                     REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNION; IN_ELIM_THM] THEN GEN_TAC THEN
2508                     EQ_TAC THEN REPEAT STRIP_TAC THENL
2509                     [
2510                       EXISTS_TAC `x':num` THEN MP_TAC (ARITH_RULE `x' <= i /\ i < k /\ k <= 3 ==> x' < 4`) THEN
2511                         ASM_SIMP_TAC[];
2512                       EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[];
2513                       ALL_TAC
2514                     ] THEN
2515                     ASM_CASES_TAC `x' <= i : num` THENL
2516                     [
2517                       DISJ1_TAC THEN EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[];
2518                       ALL_TAC
2519                     ] THEN
2520                     DISJ2_TAC THEN EXISTS_TAC `x':num` THEN
2521                     POP_ASSUM MP_TAC THEN ASM_SIMP_TAC[NOT_LE];
2522                   ALL_TAC
2523                 ] THEN
2524                 EXPAND_TAC "Lv_le" THEN EXPAND_TAC "L1" THEN EXPAND_TAC "Lu" THEN EXPAND_TAC "Lu_le" THEN
2525                 REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNION; IN_ELIM_THM] THEN GEN_TAC THEN
2526                 EQ_TAC THEN REPEAT STRIP_TAC THENL
2527                 [
2528                   EXISTS_TAC `x':num` THEN MP_TAC (ARITH_RULE `x' <= i /\ i < k /\ k <= 3 ==> x' < 4`) THEN
2529                     ASM_SIMP_TAC[];
2530                   EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[];
2531                   ALL_TAC
2532                 ] THEN
2533                 ASM_CASES_TAC `x' <= i : num` THENL
2534                 [
2535                   DISJ1_TAC THEN EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[];
2536                   ALL_TAC
2537                 ] THEN
2538                 DISJ2_TAC THEN EXISTS_TAC `x':num` THEN
2539                 POP_ASSUM MP_TAC THEN ASM_SIMP_TAC[NOT_LE];
2540               ALL_TAC
2541             ] THEN
2542
2543             ASM_REWRITE_TAC[];
2544           ALL_TAC
2545         ] THEN
2546
2547         DISCH_THEN (LABEL_TAC "ss_tt") THEN
2548         (* Continue the second step *)
2549
2550         ABBREV_TAC `Lu_lt = IMAGE (omega_list_n V ul) {j | j < k}` THEN
2551         ABBREV_TAC `Lv_lt = IMAGE (omega_list_n V vl) {j | j < k}` THEN
2552         ABBREV_TAC `Lu_ge = IMAGE (omega_list_n V ul) {j | k <= j /\ j < 4}` THEN
2553         ABBREV_TAC `Lv_ge = IMAGE (omega_list_n V vl) {j | k <= j /\ j < 4}` THEN
2554         ABBREV_TAC `a = sum Lv_lt (ss:real^3->real)` THEN
2555
2556         (* Lu_lt = Lv_lt *)
2557         SUBGOAL_THEN `Lu_lt = Lv_lt : real^3->bool` (LABEL_TAC "l_eq") THENL
2558         [
2559           EXPAND_TAC "Lu_lt" THEN EXPAND_TAC "Lv_lt" THEN
2560             REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN GEN_TAC THEN
2561             EQ_TAC THEN STRIP_TAC THEN EXISTS_TAC `x':num` THEN ASM_SIMP_TAC[];
2562           ALL_TAC
2563         ] THEN
2564
2565         (* Unions *)
2566         SUBGOAL_THEN `Lv_lt UNION Lv_ge = L2 : real^3->bool /\ Lv_lt UNION Lu_ge = L1` ASSUME_TAC THENL
2567         [
2568           CONJ_TAC THENL
2569             [
2570               REMOVE_THEN "l_eq" (fun th -> ALL_TAC) THEN
2571                 EXPAND_TAC "Lv_lt" THEN EXPAND_TAC "L2" THEN EXPAND_TAC "Lv_ge" THEN
2572                 REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNION; IN_ELIM_THM] THEN GEN_TAC THEN
2573                 EQ_TAC THEN REPEAT STRIP_TAC THENL
2574                 [
2575                   EXISTS_TAC `x':num` THEN MP_TAC (ARITH_RULE `x' < k /\ k <= 3 ==> x' < 4`) THEN
2576                     ASM_SIMP_TAC[];
2577                   EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[];
2578                   ALL_TAC
2579                 ] THEN
2580                 ASM_CASES_TAC `x' < k : num` THENL
2581                 [
2582                   DISJ1_TAC THEN EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[];
2583                   ALL_TAC
2584                 ] THEN
2585                 DISJ2_TAC THEN EXISTS_TAC `x':num` THEN
2586                 POP_ASSUM MP_TAC THEN ASM_SIMP_TAC[NOT_LT];
2587               ALL_TAC
2588             ] THEN
2589
2590             EXPAND_TAC "Lv_lt" THEN EXPAND_TAC "L1" THEN EXPAND_TAC "Lu_ge" THEN EXPAND_TAC "Lu_lt" THEN
2591             REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNION; IN_ELIM_THM] THEN GEN_TAC THEN
2592             EQ_TAC THEN REPEAT STRIP_TAC THENL
2593             [
2594               EXISTS_TAC `x':num` THEN MP_TAC (ARITH_RULE `x' < k /\ k <= 3 ==> x' < 4`) THEN
2595                 ASM_SIMP_TAC[];
2596               EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[];
2597               ALL_TAC
2598             ] THEN
2599             ASM_CASES_TAC `x' < k : num` THENL
2600             [
2601               DISJ1_TAC THEN EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[];
2602               ALL_TAC
2603             ] THEN
2604             DISJ2_TAC THEN EXISTS_TAC `x':num` THEN
2605             POP_ASSUM MP_TAC THEN ASM_SIMP_TAC[NOT_LT];
2606           ALL_TAC
2607         ] THEN
2608
2609         (* Disjoint sets *)
2610         SUBGOAL_THEN `DISJOINT (Lv_lt:real^3->bool) Lv_ge /\ DISJOINT (Lv_lt:real^3->bool) Lu_ge` ASSUME_TAC THENL
2611         [
2612           MAP_EVERY EXPAND_TAC ["Lv_lt"; "Lu_lt"; "Lv_ge"; "Lu_ge"] THEN
2613             REWRITE_TAC[DISJOINT; EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_IMAGE; IN_ELIM_THM] THEN
2614             REPEAT STRIP_TAC THENL
2615             [
2616               MP_TAC (SPECL [`V:real^3->bool`; `vl:(real^3)list`] ROGERS_AFF_DIM_FULL) THEN
2617                 ASM_REWRITE_TAC[] THEN
2618                 DISCH_THEN (MP_TAC o SPECL [`x':num`; `x'':num`]) THEN
2619                 ANTS_TAC THENL
2620                 [
2621                   MP_TAC (ARITH_RULE `x' < k /\ k <= 3 ==> x' < 4`) THEN
2622                     MP_TAC (ARITH_RULE `x' < k /\ k <= x'' ==> ~(x' = x'':num)`) THEN
2623                     ASM_SIMP_TAC[];
2624                   ALL_TAC
2625                 ] THEN
2626                 POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
2627                 ASM_SIMP_TAC[];
2628               ALL_TAC
2629             ] THEN
2630
2631             MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`] ROGERS_AFF_DIM_FULL) THEN
2632             ASM_REWRITE_TAC[] THEN
2633             DISCH_THEN (MP_TAC o SPECL [`x':num`; `x'':num`]) THEN
2634             ANTS_TAC THENL
2635             [
2636               MP_TAC (ARITH_RULE `x' < k /\ k <= 3 ==> x' < 4`) THEN
2637                 MP_TAC (ARITH_RULE `x' < k /\ k <= x'' ==> ~(x' = x'':num)`) THEN
2638                 ASM_SIMP_TAC[];
2639               ALL_TAC
2640             ] THEN
2641             POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
2642             ASM_REWRITE_TAC[];
2643           ALL_TAC
2644         ] THEN
2645
2646         (* Finite sets *)
2647         SUBGOAL_THEN `FINITE (Lv_lt:real^3->bool) /\ FINITE (Lv_ge:real^3->bool) /\ FINITE (Lu_ge:real^3->bool)` ASSUME_TAC THENL
2648         [
2649           MAP_EVERY EXPAND_TAC ["Lv_lt"; "Lv_ge"; "Lu_ge"; "Lu_lt"] THEN
2650             REPEAT CONJ_TAC THEN MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[FINITE_NUMSEG_LT] THENL
2651             [
2652               MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{j | j < 4}` THEN
2653                 SIMP_TAC[FINITE_NUMSEG_LT; SUBSET; IN_ELIM_THM];
2654               ALL_TAC
2655             ] THEN
2656             MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{j | j < 4}` THEN
2657             SIMP_TAC[FINITE_NUMSEG_LT; SUBSET; IN_ELIM_THM];
2658           ALL_TAC
2659         ] THEN
2660
2661         (* vsum Lv_lt ss = vsum Lv_lt tt *)
2662         SUBGOAL_THEN `vsum Lv_lt (\x:real^3. ss x % x) = vsum Lv_lt (\x:real^3. tt x % x)` ASSUME_TAC THENL
2663         [
2664           MATCH_MP_TAC VSUM_EQ THEN EXPAND_TAC "Lv_lt" THEN EXPAND_TAC "Lu_lt" THEN
2665             REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
2666             REWRITE_TAC[VECTOR_MUL_RCANCEL] THEN DISJ1_TAC THEN
2667             ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM (MP_TAC o SPEC `x':num`) THEN
2668             ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
2669             ASM_SIMP_TAC[];
2670           ALL_TAC
2671         ] THEN
2672
2673         (* sum Lv_lt tt = a *)
2674         SUBGOAL_THEN `sum Lv_lt (tt:real^3->real) = a` ASSUME_TAC THENL
2675         [
2676           EXPAND_TAC "a" THEN EXPAND_TAC "Lv_lt" THEN EXPAND_TAC "Lu_lt" THEN
2677             MATCH_MP_TAC SUM_EQ THEN
2678             REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
2679             FIRST_X_ASSUM (MP_TAC o SPEC `x':num`) THEN
2680             ASM_SIMP_TAC[];
2681           ALL_TAC
2682         ] THEN
2683
2684         (* w = w_lt + w_ge *)
2685         MP_TAC (ISPECL[`\x:real^3. ss x % x`; `Lv_lt:real^3->bool`; `Lu_ge:real^3->bool`] VSUM_UNION) THEN
2686         ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "wu" o SYM) THEN
2687         MP_TAC (ISPECL[`\x:real^3. tt x % x`; `Lv_lt:real^3->bool`; `Lv_ge:real^3->bool`] VSUM_UNION) THEN
2688         ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "wv" o SYM) THEN
2689
2690         (* 1 = a + (1 - a) *)
2691         MP_TAC (ISPECL[`ss:real^3->real`; `Lv_lt:real^3->bool`; `Lu_ge:real^3->bool`] SUM_UNION) THEN
2692         MP_TAC (ISPECL[`tt:real^3->real`; `Lv_lt:real^3->bool`; `Lv_ge:real^3->bool`] SUM_UNION) THEN
2693         ASM_REWRITE_TAC[REAL_ARITH `&1 = a + x <=> x = &1 - a`] THEN
2694         DISCH_TAC THEN DISCH_TAC THEN
2695
2696         (* &1 - a != 0 *)
2697         SUBGOAL_THEN `~(&1 - a = &0)` ASSUME_TAC THENL
2698         [
2699           ASM_CASES_TAC `?p:real^3. p IN Lv_lt` THENL
2700             [
2701               POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM MP_TAC THEN
2702                 EXPAND_TAC "Lv_lt" THEN EXPAND_TAC "Lu_lt" THEN
2703                 REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN STRIP_TAC THEN
2704                 REMOVE_THEN "not1" (MP_TAC o SPEC `k - 1`) THEN
2705                 MP_TAC (ARITH_RULE `x < k ==> k - 1 < k`) THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN
2706                 ASM_SIMP_TAC[ARITH_RULE `k - 1 < k ==> (j <= k - 1 <=> j < k)`] THEN
2707                 SIMP_TAC[ARITH_RULE `~(a = &1) ==> ~(&1 - a = &0)`];
2708               ALL_TAC
2709             ] THEN
2710
2711             EXPAND_TAC "a" THEN
2712             SUBGOAL_THEN `Lv_lt = {} : real^3->bool` (fun th -> REWRITE_TAC[th]) THENL
2713             [
2714               ASM_REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; GSYM NOT_EXISTS_THM];
2715               ALL_TAC
2716             ] THEN
2717             REWRITE_TAC[SUM_CLAUSES; REAL_SUB_RZERO] THEN REAL_ARITH_TAC;
2718           ALL_TAC
2719         ] THEN
2720
2721         (* &0 < &1 - a *)
2722         SUBGOAL_THEN `&0 < &1 - a` ASSUME_TAC THENL
2723         [
2724           ASM_REWRITE_TAC[REAL_LT_LE] THEN
2725             POP_ASSUM (fun th -> ALL_TAC) THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
2726             MATCH_MP_TAC SUM_POS_LE THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
2727             FIRST_X_ASSUM MATCH_MP_TAC THEN
2728             POP_ASSUM MP_TAC THEN EXPAND_TAC "Lu_ge" THEN EXPAND_TAC "L1" THEN
2729             REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
2730             EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[];
2731           ALL_TAC
2732         ] THEN
2733
2734         ABBREV_TAC `p:real^3 = inv (&1 - a) % vsum Lv_ge (\x. tt x % x)` THEN
2735         EXPAND_TAC "YX" THEN
2736         REWRITE_TAC[CONVEX_HULL_EXPLICIT; IN_ELIM_THM] THEN
2737         EXISTS_TAC `Lv_lt UNION {p:real^3}` THEN
2738         EXISTS_TAC `\x:real^3. if x = p then (&1 - a) else tt x` THEN
2739
2740         (* p IN X *)
2741         SUBGOAL_THEN `p:real^3 IN X` ASSUME_TAC THENL
2742         [
2743           EXPAND_TAC "X" THEN REWRITE_TAC[IN_INTER] THEN
2744             MP_TAC (ISPEC `voronoi_list V (truncate_simplex k vl)` CONVEX_HULL_EQ) THEN
2745             MP_TAC (ISPEC `voronoi_list V (truncate_simplex k ul)` CONVEX_HULL_EQ) THEN
2746             REWRITE_TAC[CONVEX_VORONOI_LIST] THEN
2747             REPEAT (DISCH_THEN (fun th -> ONCE_REWRITE_TAC[SYM th])) THEN
2748             REWRITE_TAC[CONVEX_HULL_EXPLICIT; IN_ELIM_THM] THEN
2749             CONJ_TAC THENL
2750             [
2751               EXISTS_TAC `Lu_ge : real^3->bool` THEN
2752                 EXISTS_TAC `\x:real^3. inv (&1 - a) * ss x` THEN
2753                 ASM_REWRITE_TAC[] THEN
2754                 REPEAT STRIP_TAC THENL
2755                 [
2756                   EXPAND_TAC "Lu_ge" THEN REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN
2757                     REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2758                     MATCH_MP_TAC OMEGA_LIST_N_IN_VORONOI_LIST_GEN THEN
2759                     EXISTS_TAC `3` THEN ASM_REWRITE_TAC[ARITH_RULE `x' <= 3 <=> x' < 4`];
2760                   MATCH_MP_TAC REAL_LE_MUL THEN
2761                     ASM_REWRITE_TAC[REAL_LE_INV_EQ; REAL_LE_LT] THEN REWRITE_TAC[GSYM REAL_LE_LT] THEN
2762                     FIRST_X_ASSUM MATCH_MP_TAC THEN
2763                     POP_ASSUM MP_TAC THEN EXPAND_TAC "Lu_ge" THEN EXPAND_TAC "L1" THEN
2764                     REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
2765                     EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[];
2766                   ASM_SIMP_TAC[SUM_LMUL; REAL_MUL_LINV];
2767                   ALL_TAC
2768                 ] THEN
2769                 REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; VSUM_LMUL] THEN
2770                 POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
2771                 REWRITE_TAC[VECTOR_MUL_LCANCEL] THEN DISJ2_TAC THEN
2772                 REMOVE_THEN "wu" MP_TAC THEN REMOVE_THEN "wv" (fun th -> REWRITE_TAC[SYM th]) THEN
2773                 REWRITE_TAC[VECTOR_ARITH `x + a = x + b <=> a = b:real^3`];
2774               ALL_TAC
2775             ] THEN
2776             EXISTS_TAC `Lv_ge : real^3->bool` THEN
2777             EXISTS_TAC `\x:real^3. inv (&1 - a) * tt x` THEN
2778             ASM_REWRITE_TAC[] THEN
2779             REPEAT STRIP_TAC THENL
2780             [
2781               EXPAND_TAC "Lv_ge" THEN REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN
2782                 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2783                 MATCH_MP_TAC OMEGA_LIST_N_IN_VORONOI_LIST_GEN THEN
2784                 EXISTS_TAC `3` THEN ASM_REWRITE_TAC[ARITH_RULE `x' <= 3 <=> x' < 4`];
2785               MATCH_MP_TAC REAL_LE_MUL THEN
2786                 ASM_REWRITE_TAC[REAL_LE_INV_EQ; REAL_LE_LT] THEN REWRITE_TAC[GSYM REAL_LE_LT] THEN
2787                 FIRST_X_ASSUM MATCH_MP_TAC THEN
2788                 POP_ASSUM MP_TAC THEN EXPAND_TAC "Lv_ge" THEN EXPAND_TAC "L2" THEN
2789                 REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
2790                 EXISTS_TAC `x':num` THEN ASM_REWRITE_TAC[];
2791               ASM_SIMP_TAC[SUM_LMUL; REAL_MUL_LINV];
2792               ALL_TAC
2793             ] THEN
2794             ASM_REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; VSUM_LMUL];
2795           ALL_TAC
2796         ] THEN
2797
2798         (* ~(p IN Lv_lt) *)
2799         SUBGOAL_THEN `~(p:real^3 IN Lv_lt)` ASSUME_TAC THENL
2800         [
2801           EXPAND_TAC "Lv_lt" THEN EXPAND_TAC "Lu_lt" THEN
2802             REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
2803             MP_TAC (SPECL[`V:real^3->bool`; `ul:(real^3)list`] ROGERS_AFF_DIM_FULL) THEN
2804             ASM_REWRITE_TAC[] THEN
2805             DISCH_THEN (MP_TAC o SPECL[`x:num`; `SUC x`]) THEN
2806             ANTS_TAC THENL
2807             [
2808               MP_TAC (ARITH_RULE `x < k /\ k <= 3 ==> x < 4 /\ SUC x < 4`) THEN
2809                 ASM_SIMP_TAC[ARITH_RULE `~(x = SUC x)`];
2810               ALL_TAC
2811             ] THEN
2812             REWRITE_TAC[] THEN
2813             MATCH_MP_TAC EQ_SYM THEN
2814             MATCH_MP_TAC OMEGA_LIST_N_EQ_GEN THEN
2815             EXISTS_TAC `3` THEN EXISTS_TAC `k:num` THEN
2816             ASM_REWRITE_TAC[] THEN POP_ASSUM (fun th -> ALL_TAC) THEN
2817             POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
2818             POP_ASSUM MP_TAC THEN EXPAND_TAC "X" THEN
2819             SIMP_TAC[IN_INTER];
2820           ALL_TAC
2821         ] THEN
2822
2823         REPEAT CONJ_TAC THENL
2824         [
2825           (* FINITE (Lv_lt UNION {p}) *)
2826           ASM_REWRITE_TAC[FINITE_UNION; FINITE_SING];
2827
2828           (* Lv_lt UNION {p} SUBSET Y UNION X *)
2829           EXPAND_TAC "Y" THEN REMOVE_THEN "l_eq" (fun th -> REWRITE_TAC[th]) THEN
2830             REWRITE_TAC[SUBSET; IN_UNION; IN_SING] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[];
2831
2832           (* &0 <= f x *)
2833           REWRITE_TAC[IN_UNION; IN_SING] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
2834             [
2835               COND_CASES_TAC THENL
2836                 [
2837                   UNDISCH_TAC `~(p:real^3 IN Lv_lt)` THEN
2838                     POP_ASSUM (fun th -> ASM_REWRITE_TAC[SYM th]);
2839                   ALL_TAC
2840                 ] THEN
2841                 FIRST_X_ASSUM MATCH_MP_TAC THEN
2842                 POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN EXPAND_TAC "L2" THEN
2843                 REMOVE_THEN "l_eq" (fun th -> ALL_TAC) THEN EXPAND_TAC "Lv_lt" THEN
2844                 REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
2845                 EXISTS_TAC `x':num` THEN MP_TAC (ARITH_RULE `x' < k /\ k <= 3 ==> x' < 4`) THEN
2846                 ASM_SIMP_TAC[];
2847               ALL_TAC
2848             ] THEN
2849             ASM_REWRITE_TAC[REAL_LE_LT];
2850
2851           (* sum = &1 *)
2852           MP_TAC (ISPECL[`\x:real^3. if x = p then &1 - a else tt x`; `Lv_lt:real^3->bool`; `{p:real^3}`] SUM_UNION) THEN
2853             ASM_REWRITE_TAC[FINITE_SING; DISJOINT; EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_SING] THEN
2854             ANTS_TAC THENL
2855             [
2856               GEN_TAC THEN REWRITE_TAC[DE_MORGAN_THM] THEN
2857                 ASM_CASES_TAC `x = p:real^3` THEN ASM_REWRITE_TAC[];
2858               ALL_TAC
2859             ] THEN
2860             DISCH_THEN (fun th -> REWRITE_TAC[th; SUM_SING]) THEN
2861             SUBGOAL_THEN `sum Lv_lt (\x:real^3. if x = p then &1 - a else tt x) = sum Lv_lt tt` (fun th -> REWRITE_TAC[th]) THENL
2862             [
2863               MATCH_MP_TAC SUM_EQ THEN REPEAT STRIP_TAC THEN BETA_TAC THEN
2864                 COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
2865                 UNDISCH_TAC `~(p:real^3 IN Lv_lt)` THEN POP_ASSUM (fun th -> ASM_REWRITE_TAC[SYM th]);
2866               ALL_TAC
2867             ] THEN
2868             ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
2869           ALL_TAC
2870         ] THEN
2871         (* vsum = w *)
2872         REWRITE_TAC[] THEN
2873         MP_TAC (ISPECL[`\v:real^3. (if v = p then &1 - a else tt v) % v`; `Lv_lt:real^3->bool`; `{p:real^3}`] VSUM_UNION) THEN
2874         ASM_REWRITE_TAC[FINITE_SING; DISJOINT; EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_SING] THEN
2875         ANTS_TAC THENL
2876         [
2877           GEN_TAC THEN REWRITE_TAC[DE_MORGAN_THM] THEN
2878             ASM_CASES_TAC `x = p:real^3` THEN ASM_REWRITE_TAC[];
2879           ALL_TAC
2880         ] THEN
2881         DISCH_THEN (fun th -> REWRITE_TAC[th; VSUM_SING]) THEN
2882         SUBGOAL_THEN `vsum Lv_lt (\v:real^3. (if v = p then &1 - a else tt v) % v) = vsum Lv_lt (\v. tt v % v)` (fun th -> REWRITE_TAC[th]) THENL
2883         [
2884           MATCH_MP_TAC VSUM_EQ THEN REPEAT STRIP_TAC THEN BETA_TAC THEN
2885             COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
2886             UNDISCH_TAC `~(p:real^3 IN Lv_lt)` THEN POP_ASSUM (fun th -> ASM_REWRITE_TAC[SYM th]);
2887           ALL_TAC
2888         ] THEN
2889         EXPAND_TAC "p" THEN REMOVE_THEN "wv" (fun th -> REWRITE_TAC[SYM th]) THEN
2890         ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID];
2891       ALL_TAC
2892     ] THEN
2893
2894     (* The third step *)
2895     DISCH_THEN (LABEL_TAC "conv") THEN
2896     MATCH_MP_TAC AFF_DIM_LE_2_IMP_COPLANAR THEN
2897     MATCH_MP_TAC INT_LE_TRANS THEN
2898     EXISTS_TAC `aff_dim (convex hull (Y UNION X:real^3->bool))` THEN
2899     POP_ASSUM (fun th -> SIMP_TAC[MATCH_MP AFF_DIM_SUBSET th]) THEN
2900     REWRITE_TAC[AFF_DIM_CONVEX_HULL] THEN
2901     SUBGOAL_THEN `FINITE (Y:real^3->bool)` ASSUME_TAC THENL
2902     [
2903       EXPAND_TAC "Y" THEN MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[FINITE_NUMSEG_LT];
2904       ALL_TAC
2905     ] THEN
2906
2907     (* CARD Y <= k *)
2908     SUBGOAL_THEN `CARD (Y:real^3->bool) <= k` ASSUME_TAC THENL
2909     [
2910       MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD {j | j < k : num}` THEN
2911         CONJ_TAC THENL
2912         [
2913           EXPAND_TAC "Y" THEN
2914             MP_TAC (ISPECL[`omega_list_n V ul`; `{j | j < k : num}`] CARD_IMAGE_LE) THEN
2915             SIMP_TAC[FINITE_NUMSEG_LT];
2916           ALL_TAC
2917         ] THEN
2918         REWRITE_TAC[CARD_NUMSEG_LT; LE_REFL];
2919       ALL_TAC
2920     ] THEN
2921
2922     MATCH_MP_TAC INT_LE_TRANS THEN
2923     EXISTS_TAC `&(CARD (Y:real^3->bool)) + aff_dim (X:real^3->bool)` THEN
2924     CONJ_TAC THENL
2925     [
2926       MATCH_MP_TAC AFF_DIM_FINITE_UNION_LE THEN ASM_REWRITE_TAC[];
2927       ALL_TAC
2928     ] THEN
2929
2930     (* aff dim X <= 2 - k *)
2931     SUBGOAL_THEN `aff_dim (X:real^3->bool) <= &2 - &k` MP_TAC THENL
2932     [
2933       ABBREV_TAC `Fu = voronoi_list V (truncate_simplex k ul)` THEN
2934         ABBREV_TAC `Fv = voronoi_list V (truncate_simplex k vl)` THEN
2935         (* k = 0 \/ 0 < k *)
2936         DISJ_CASES_TAC (ARITH_RULE `k = 0 \/ 0 < k`) THENL
2937         [
2938           UNDISCH_TAC `~(Fu = Fv : real^3->bool)` THEN
2939             MP_TAC (ISPEC `ul:(real^3)list` TRUNCATE_0_EQ_HEAD) THEN
2940             MP_TAC (ISPEC `vl:(real^3)list` TRUNCATE_0_EQ_HEAD) THEN
2941             ASM_REWRITE_TAC[ARITH] THEN
2942             MAP_EVERY EXPAND_TAC ["X"; "Fu"; "Fv"] THEN
2943             POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN
2944             REPLICATE_TAC 2 (DISCH_THEN (fun th -> REWRITE_TAC[th])) THEN
2945             REWRITE_TAC[VORONOI_LIST_SING] THEN DISCH_TAC THEN
2946             MATCH_MP_TAC INT_LE_TRANS THEN
2947             EXISTS_TAC `aff_dim ({x : real^3 | &2 % (HD ul - HD vl) dot x = norm (HD ul) pow 2 - norm (HD vl) pow 2})` THEN
2948
2949             SUBGOAL_THEN `!l:(real^3)list. barV V 3 l ==> HD l IN V` ASSUME_TAC THENL
2950             [
2951               REPEAT STRIP_TAC THEN
2952                 MATCH_MP_TAC IN_TRANS THEN
2953                 EXISTS_TAC `set_of_list l : real^3->bool` THEN
2954                 CONJ_TAC THENL
2955                 [
2956                   MATCH_MP_TAC BARV_IMP_HD_IN_SET_OF_LIST THEN
2957                     MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `3`] THEN ASM_REWRITE_TAC[];
2958                   ALL_TAC
2959                 ] THEN
2960                 MATCH_MP_TAC BARV_SUBSET THEN
2961                 EXISTS_TAC `3` THEN ASM_REWRITE_TAC[];
2962               ALL_TAC
2963             ] THEN
2964             FIRST_ASSUM (MP_TAC o SPEC `ul:(real^3)list`) THEN
2965             FIRST_X_ASSUM (MP_TAC o SPEC `vl:(real^3)list`) THEN
2966             ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN
2967
2968             CONJ_TAC THENL
2969             [
2970               MATCH_MP_TAC AFF_DIM_SUBSET THEN
2971                 MATCH_MP_TAC Pack2.INTER_VORONOI_SUBSET_BISECTOR THEN ASM_REWRITE_TAC[];
2972               ALL_TAC
2973             ] THEN
2974
2975             SUBGOAL_THEN `int_of_num 2 - &0 = &(dimindex (:3)) - &1` (fun th -> REWRITE_TAC[th]) THENL
2976             [
2977               REWRITE_TAC[DIMINDEX_3] THEN INT_ARITH_TAC;
2978               ALL_TAC
2979             ] THEN
2980
2981             MATCH_MP_TAC (INT_ARITH `a = b ==> a <= b : int`) THEN
2982             MATCH_MP_TAC AFF_DIM_HYPERPLANE THEN
2983             REWRITE_TAC[VECTOR_MUL_EQ_0; INT_ARITH `~(&2 = &0)`; VECTOR_SUB_EQ] THEN
2984             DISCH_TAC THEN UNDISCH_TAC `~(voronoi_closed V (HD ul) = voronoi_closed V (HD vl):real^3->bool)` THEN
2985             ASM_REWRITE_TAC[];
2986           ALL_TAC
2987         ] THEN
2988
2989         (* 0 < k *)
2990         ABBREV_TAC `P = voronoi_list V (truncate_simplex (k - 1) vl) : real^3->bool` THEN
2991         (* Fu facet_of P /\ Fv facet_of P *)
2992         SUBGOAL_THEN `Fu facet_of P /\ Fv facet_of P : real^3->bool` STRIP_ASSUME_TAC THENL
2993         [
2994           CONJ_TAC THENL
2995             [
2996               MP_TAC (SPECL[`V:real^3->bool`; `truncate_simplex (k - 1) ul:(real^3)list`; `k - 1`; `Fu:real^3->bool`] IDBEZAL) THEN
2997                 ANTS_TAC THENL
2998                 [
2999                   ASM_SIMP_TAC[ARITH_RULE `k <= 3 ==> k - 1 < 3`] THEN
3000                     MATCH_MP_TAC TRUNCATE_SIMPLEX_BARV THEN
3001                     EXISTS_TAC `3` THEN ASM_SIMP_TAC[ARITH_RULE `k <= 3 ==> k - 1 <= 3`];
3002                   ALL_TAC
3003                 ] THEN
3004                 SUBGOAL_THEN `voronoi_list V (truncate_simplex (k - 1) ul) = P : real^3->bool` MP_TAC THENL
3005                 [
3006                   FIRST_X_ASSUM (MP_TAC o SPEC `k - 1`) THEN
3007                     ASM_SIMP_TAC[ARITH_RULE `0 < k ==> k - 1 < k`];
3008                   ALL_TAC
3009                 ] THEN
3010                 REPEAT (DISCH_THEN (fun th -> REWRITE_TAC[th])) THEN
3011                 EXISTS_TAC `truncate_simplex k ul:(real^3)list` THEN
3012                 ASM_REWRITE_TAC[] THEN
3013                 CONJ_TAC THENL
3014                 [
3015                   ASM_SIMP_TAC[ARITH_RULE `0 < k ==> k - 1 + 1 = k`] THEN
3016                     MATCH_MP_TAC TRUNCATE_SIMPLEX_BARV THEN
3017                     EXISTS_TAC `3` THEN ASM_REWRITE_TAC[];
3018                   ALL_TAC
3019                 ] THEN
3020                 MATCH_MP_TAC TRUNCATE_TRUNCATE_SIMPLEX THEN
3021                 ASM_SIMP_TAC[ARITH_RULE `k <= 3 ==> k + 1 <= 4`; ARITH_RULE `k - 1 <= k`];
3022               ALL_TAC
3023             ] THEN
3024             MP_TAC (SPECL[`V:real^3->bool`; `truncate_simplex (k - 1) vl:(real^3)list`; `k - 1`; `Fv:real^3->bool`] IDBEZAL) THEN
3025             ANTS_TAC THENL
3026             [
3027               ASM_SIMP_TAC[ARITH_RULE `k <= 3 ==> k - 1 < 3`] THEN
3028                 MATCH_MP_TAC TRUNCATE_SIMPLEX_BARV THEN
3029                 EXISTS_TAC `3` THEN ASM_SIMP_TAC[ARITH_RULE `k <= 3 ==> k - 1 <= 3`];
3030               ALL_TAC
3031             ] THEN
3032             ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
3033             EXISTS_TAC `truncate_simplex k vl:(real^3)list` THEN
3034             ASM_REWRITE_TAC[] THEN
3035             CONJ_TAC THENL
3036             [
3037               ASM_SIMP_TAC[ARITH_RULE `0 < k ==> k - 1 + 1 = k`] THEN
3038                 MATCH_MP_TAC TRUNCATE_SIMPLEX_BARV THEN
3039                 EXISTS_TAC `3` THEN ASM_REWRITE_TAC[];
3040               ALL_TAC
3041             ] THEN
3042             MATCH_MP_TAC TRUNCATE_TRUNCATE_SIMPLEX THEN
3043             ASM_SIMP_TAC[ARITH_RULE `k <= 3 ==> k + 1 <= 4`; ARITH_RULE `k - 1 <= k`];
3044           ALL_TAC
3045         ] THEN
3046
3047         FIRST_ASSUM (MP_TAC o MATCH_MP FACET_OF_IMP_FACE_OF) THEN POP_ASSUM MP_TAC THEN
3048         FIRST_ASSUM (MP_TAC o MATCH_MP FACET_OF_IMP_FACE_OF) THEN POP_ASSUM (LABEL_TAC "Fu_facet") THEN
3049         MAP_EVERY (fun s -> DISCH_THEN (LABEL_TAC s)) ["Fu_face"; "Fv_facet"; "Fv_face"] THEN
3050
3051         MP_TAC (ISPECL[`Fu:real^3->bool`; `P:real^3->bool`; `Fv:real^3->bool`; `P:real^3->bool`] FACE_OF_INTER_INTER) THEN
3052         ASM_REWRITE_TAC[INTER_ACI] THEN DISCH_TAC THEN
3053
3054         REMOVE_THEN "Fu_face" (MP_TAC o SPEC `X:real^3->bool` o MATCH_MP FACE_OF_FACE) THEN
3055         REMOVE_THEN "Fv_face" (MP_TAC o SPEC `X:real^3->bool` o MATCH_MP FACE_OF_FACE) THEN
3056         SUBGOAL_THEN `X SUBSET Fv /\ X SUBSET Fu:real^3->bool` (fun th -> ASM_REWRITE_TAC[th]) THENL
3057         [
3058           MAP_EVERY EXPAND_TAC ["X"; "Fv"; "Fu"] THEN
3059             REWRITE_TAC[INTER_SUBSET];
3060           ALL_TAC
3061         ] THEN
3062
3063         ASM_CASES_TAC `X = Fv : real^3->bool /\ X = Fu : real^3->bool` THENL
3064         [
3065           UNDISCH_TAC `~(Fu = Fv:real^3->bool)` THEN
3066             POP_ASSUM (fun th -> REWRITE_TAC[GSYM th]);
3067           ALL_TAC
3068         ] THEN
3069         POP_ASSUM MP_TAC THEN REWRITE_TAC[DE_MORGAN_THM] THEN REPEAT STRIP_TAC THENL
3070         [
3071           MP_TAC (ISPECL[`X:real^3->bool`; `Fv:real^3->bool`] FACE_OF_AFF_DIM_LT) THEN
3072             ANTS_TAC THENL
3073             [
3074               ASM_REWRITE_TAC[] THEN EXPAND_TAC "Fv" THEN REWRITE_TAC[CONVEX_VORONOI_LIST];
3075               ALL_TAC
3076             ] THEN
3077             MP_TAC (SPECL[`V:real^3->bool`; `vl:(real^3)list`; `3`; `k:num`] VORONOI_LIST_AFF_DIM) THEN
3078             ASM_SIMP_TAC[] THEN INT_ARITH_TAC;
3079           ALL_TAC
3080         ] THEN
3081         MP_TAC (ISPECL[`X:real^3->bool`; `Fu:real^3->bool`] FACE_OF_AFF_DIM_LT) THEN
3082         ANTS_TAC THENL
3083         [
3084           ASM_REWRITE_TAC[] THEN EXPAND_TAC "Fu" THEN REWRITE_TAC[CONVEX_VORONOI_LIST];
3085           ALL_TAC
3086         ] THEN
3087         MP_TAC (SPECL[`V:real^3->bool`; `ul:(real^3)list`; `3`; `k:num`] VORONOI_LIST_AFF_DIM) THEN
3088         ASM_SIMP_TAC[] THEN INT_ARITH_TAC;
3089       ALL_TAC
3090     ] THEN
3091
3092     POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN
3093     INT_ARITH_TAC);;
3094
3095
3096
3097 (***************************************************)
3098
3099 (****************)
3100 (* Circumcenter *)
3101 (****************)
3102
3103
3104 (* QXSKIIT *)
3105
3106 let AFFINE_INDEPENDENT_IMP_INDEPENDENT = prove(`!S:real^N->bool. ~affine_dependent S ==> (!x. x IN S ==> independent {y - x | y | y IN (S DELETE x)})`,
3107    REPEAT STRIP_TAC THEN
3108      REWRITE_TAC[independent; DEPENDENT_AFFINE_DEPENDENT_CASES; DE_MORGAN_THM] THEN
3109      CONJ_TAC THENL
3110      [
3111        MATCH_MP_TAC AFFINE_INDEPENDENT_SUBSET THEN
3112          EXISTS_TAC `IMAGE (\y:real^N. --x + y) S` THEN
3113          ASM_REWRITE_TAC[AFFINE_DEPENDENT_TRANSLATION_EQ] THEN
3114          REWRITE_TAC[IMAGE_LEMMA; VECTOR_ARITH `--x + y:real^N = y - x`] THEN
3115          REWRITE_TAC[IN_DELETE; SUBSET; IN_ELIM_THM] THEN
3116          X_GEN_TAC `u:real^N` THEN
3117          STRIP_TAC THEN
3118          EXISTS_TAC `y:real^N` THEN
3119          ASM_REWRITE_TAC[];
3120        ALL_TAC
3121      ] THEN
3122
3123      SUBGOAL_THEN `{y - x | y | y IN S DELETE x} = IMAGE (\y:real^N. --x + y) (S DELETE x)` (fun th -> REWRITE_TAC[th]) THENL
3124      [
3125        REWRITE_TAC[IMAGE_LEMMA; VECTOR_ARITH `--x + y:real^N = y - x`];
3126        ALL_TAC
3127      ] THEN
3128
3129      REWRITE_TAC[AFFINE_HULL_TRANSLATION; IN_IMAGE] THEN
3130      REWRITE_TAC[VECTOR_ARITH `vec 0 = --x + x' <=> x' = x:real^N`] THEN
3131      STRIP_TAC THEN POP_ASSUM MP_TAC THEN
3132      UNDISCH_TAC `~affine_dependent (S:real^N->bool)` THEN
3133      ASM_REWRITE_TAC[CONTRAPOS_THM; affine_dependent] THEN
3134      DISCH_TAC THEN
3135      EXISTS_TAC `x:real^N` THEN
3136      ASM_REWRITE_TAC[]);;
3137
3138
3139
3140
3141 let ORTHOGONAL_TO_SPAN_EXISTS = prove(`!(s:real^N->bool) t. s SUBSET span t /\ dim s < dim t ==>
3142                     ?v. ~(v = vec 0) /\ v IN span t /\ (!x. x IN s ==> x dot v = &0)`,
3143    REPEAT STRIP_TAC THEN
3144      SUBGOAL_THEN `span s SUBSET span (t:real^N->bool)` ASSUME_TAC THENL
3145      [
3146        GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM SPAN_SPAN] THEN
3147          MATCH_MP_TAC SPAN_MONO THEN
3148          ASM_REWRITE_TAC[];
3149        ALL_TAC
3150      ] THEN
3151
3152      SUBGOAL_THEN `?y:real^N. y IN span t /\ ~(y IN span s)` CHOOSE_TAC THENL
3153      [
3154        UNDISCH_TAC `dim (s:real^N->bool) < dim (t:real^N->bool)` THEN
3155          ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
3156          REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(A /\ ~B) <=> (A ==> B)`; GSYM SUBSET] THEN
3157          POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; SUBSET_ANTISYM_EQ] THEN
3158          DISCH_TAC THEN
3159          MATCH_MP_TAC (ARITH_RULE `a:num = b ==> ~(a < b)`) THEN
3160          MATCH_MP_TAC SPAN_EQ_DIM THEN
3161          ASM_REWRITE_TAC[];
3162        ALL_TAC
3163      ] THEN
3164
3165      MP_TAC (SPEC `span (s:real^N->bool)` ORTHOGONAL_BASIS_SUBSPACE) THEN
3166      REWRITE_TAC[SUBSPACE_SPAN; DIM_SPAN] THEN
3167      STRIP_TAC THEN
3168
3169      ABBREV_TAC `v:real^N = (y - vsum b (\v. (v dot y) / (v dot v) % v))` THEN
3170
3171      EXISTS_TAC `v:real^N` THEN
3172      REPEAT CONJ_TAC THENL
3173      [
3174        POP_ASSUM (LABEL_TAC "A") THEN
3175          DISCH_TAC THEN REMOVE_THEN "A" MP_TAC THEN
3176          ASM_REWRITE_TAC[VECTOR_SUB_EQ] THEN
3177          DISCH_TAC THEN
3178          SUBGOAL_THEN `y:real^N IN span b` MP_TAC THENL
3179          [
3180            REWRITE_TAC[SPAN_EXPLICIT; IN_ELIM_THM] THEN
3181              MAP_EVERY EXISTS_TAC [`b:real^N->bool`; `\v:real^N. (v dot y) / (v dot v)`] THEN
3182              ASM_REWRITE_TAC[EQ_SYM_EQ; SUBSET_REFL] THEN
3183              CONJ_TAC THENL
3184              [
3185                UNDISCH_TAC `b:real^N->bool HAS_SIZE dim (s:real^N->bool)` THEN
3186                SIMP_TAC[HAS_SIZE];
3187                ALL_TAC
3188              ] THEN
3189              POP_ASSUM ACCEPT_TAC;
3190            ALL_TAC
3191          ] THEN
3192          ASM_REWRITE_TAC[];
3193
3194        EXPAND_TAC "v" THEN
3195          MATCH_MP_TAC SPAN_SUB THEN
3196          ASM_REWRITE_TAC[] THEN
3197          MATCH_MP_TAC IN_TRANS THEN
3198          EXISTS_TAC `span (s:real^N->bool)` THEN
3199          ASM_REWRITE_TAC[] THEN
3200          MATCH_MP_TAC SPAN_VSUM THEN
3201          UNDISCH_TAC `b:real^N->bool HAS_SIZE dim (s:real^N->bool)` THEN
3202          SIMP_TAC[HAS_SIZE] THEN DISCH_TAC THEN
3203          REPEAT STRIP_TAC THEN
3204          MATCH_MP_TAC SPAN_MUL THEN
3205          MATCH_MP_TAC IN_TRANS THEN
3206          EXISTS_TAC `b:real^N->bool` THEN
3207          ASM_REWRITE_TAC[];
3208
3209        ALL_TAC
3210      ] THEN
3211
3212      REPEAT STRIP_TAC THEN
3213      MP_TAC (SPECL [`b:real^N->bool`; `y:real^N`; `x:real^N`] GRAM_SCHMIDT_STEP) THEN
3214      ASM_REWRITE_TAC[orthogonal] THEN
3215      ANTS_TAC THEN REWRITE_TAC[] THEN
3216      MATCH_MP_TAC IN_TRANS THEN
3217      EXISTS_TAC `s:real^N->bool` THEN
3218      ASM_REWRITE_TAC[SPAN_INC]);;
3219
3220
3221
3222
3223
3224 let INDEPENDENT_EXPLICIT_NUMSEG = prove(`!(v:num->real^N) f n. (!i j. i IN (1..n) /\ j IN (1..n) /\ v i = v j ==> i = j) /\
3225                                           independent (IMAGE v (1..n)) /\
3226                                           vsum (1..n) (\i. f i % v i) = vec 0
3227                                                 ==> (!i. i IN 1..n ==> f i = &0)`,
3228    REPEAT STRIP_TAC THEN
3229      MP_TAC (ISPECL [`v:num->real^N`; `1..n`] INJECTIVE_ON_LEFT_INVERSE) THEN
3230      ASM_REWRITE_TAC[] THEN
3231      STRIP_TAC THEN
3232
3233      SUBGOAL_THEN `vsum (1..n) (\i. f i % v i) = vsum (IMAGE v (1..n)) (\x:real^N. f (g x) % x)` MP_TAC THENL
3234      [
3235        MP_TAC (ISPECL [`\i:num. f i % v i:real^N`; `1..n`] VSUM_RESTRICT) THEN
3236          REWRITE_TAC[FINITE_NUMSEG] THEN
3237          DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
3238
3239          SUBGOAL_THEN `(\x:num. if x IN 1..n then f x % v x else vec 0) = (\i:num. if i IN 1..n then ((\x:real^N. f (g x) % x) o v) i else vec 0)` (fun th -> REWRITE_TAC[th]) THENL
3240          [
3241            REWRITE_TAC[FUN_EQ_THM; o_THM] THEN
3242              GEN_TAC THEN COND_CASES_TAC THENL
3243              [
3244                FIRST_X_ASSUM (MP_TAC o SPEC `x:num`) THEN
3245                  ASM_REWRITE_TAC[] THEN
3246                  DISCH_THEN (fun th -> REWRITE_TAC[th]);
3247                ALL_TAC
3248              ] THEN
3249              REWRITE_TAC[];
3250            ALL_TAC
3251          ] THEN
3252          MP_TAC (ISPECL [`(\x:real^N. f ((g:real^N->num) x) % x) o (v:num->real^N)`; `1..n`] VSUM_RESTRICT) THEN
3253          REWRITE_TAC[FINITE_NUMSEG] THEN
3254          DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
3255
3256          MATCH_MP_TAC (GSYM VSUM_IMAGE) THEN
3257          ASM_REWRITE_TAC[FINITE_NUMSEG] THEN
3258          REPEAT STRIP_TAC THEN
3259          FIRST_X_ASSUM MATCH_MP_TAC THEN
3260          ASM_REWRITE_TAC[];
3261        ALL_TAC
3262      ] THEN
3263
3264      DISCH_TAC THEN
3265      UNDISCH_TAC `vsum (1..n) (\i. f i % v i) = vec 0:real^N` THEN
3266      POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN
3267      MP_TAC (ISPEC `IMAGE (v:num->real^N) (1..n)` INDEPENDENT_EXPLICIT) THEN
3268      ASM_REWRITE_TAC[] THEN
3269      STRIP_TAC THEN
3270      DISCH_THEN (fun th -> (FIRST_X_ASSUM (MP_TAC o (fun th2 -> MATCH_MP th2 th)))) THEN
3271      DISCH_THEN (MP_TAC o SPEC `(v:num->real^N) i`) THEN
3272      REWRITE_TAC[IN_IMAGE] THEN
3273      ANTS_TAC THENL
3274      [
3275        EXISTS_TAC `i:num` THEN
3276          ASM_REWRITE_TAC[];
3277        ALL_TAC
3278      ] THEN
3279
3280      FIRST_X_ASSUM (MP_TAC o SPEC `i:num`) THEN
3281      ASM_REWRITE_TAC[] THEN
3282      SIMP_TAC[]);;
3283
3284
3285
3286 let ORTHOGONAL_TO_ALL_IMP_ZERO = prove(`!(v:real^N) s. v IN span s /\ (!x. x IN s ==> v dot x = &0) ==> v = vec 0`,
3287    REPEAT STRIP_TAC THEN
3288      MP_TAC (SPECL [`span (s:real^N->bool)`; `span {v:real^N}`; `v:real^N`; `vec 0:real^N`; `vec 0:real^N`; `v:real^N`] ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE) THEN
3289      ANTS_TAC THENL
3290      [
3291        REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SPAN_SPAN; SPAN_0] THENL
3292          [
3293            MP_TAC (ISPECL [`s:real^N->bool`; `b:real^N`] ORTHOGONAL_TO_SPAN) THEN
3294              ANTS_TAC THENL
3295              [
3296                REPEAT STRIP_TAC THEN
3297                  REWRITE_TAC[orthogonal] THEN
3298                  UNDISCH_TAC `b IN span {v:real^N}` THEN
3299                  REWRITE_TAC[SPAN_SING; IN_ELIM_THM] THEN
3300                  STRIP_TAC THEN
3301                  ASM_REWRITE_TAC[DOT_LMUL; REAL_ENTIRE] THEN
3302                  DISJ2_TAC THEN
3303                  FIRST_X_ASSUM MATCH_MP_TAC THEN
3304                  ASM_REWRITE_TAC[];
3305                ALL_TAC
3306              ] THEN
3307
3308              DISCH_THEN (MP_TAC o SPEC `a:real^N`) THEN
3309              ASM_SIMP_TAC[ORTHOGONAL_SYM];
3310
3311            MATCH_MP_TAC IN_TRANS THEN
3312              EXISTS_TAC `{v:real^N}` THEN
3313              REWRITE_TAC[SPAN_INC; IN_SING];
3314
3315            VECTOR_ARITH_TAC
3316          ];
3317        ALL_TAC
3318      ] THEN
3319
3320      STRIP_TAC);;
3321
3322
3323
3324
3325 let UNIQUE_SOLUTION_lemma = prove(`!(S:real^N->bool) b. independent S ==> ?!p. p IN span S /\ (!x. x IN S ==> p dot x = b x)`,
3326    REPEAT STRIP_TAC THEN
3327      ABBREV_TAC `n = dim (span (S:real^N->bool))` THEN
3328      SUBGOAL_THEN `?w:num->real^N. S = IMAGE w (1..n) /\ (!i j. i IN (1..n) /\ j IN (1..n) /\ w i = w j ==> i = j)` MP_TAC THENL
3329      [
3330        SUBGOAL_THEN `FINITE S /\ CARD (S:real^N->bool) = dim (span S)` ASSUME_TAC THENL
3331          [
3332            REWRITE_TAC[GSYM HAS_SIZE] THEN
3333              MATCH_MP_TAC BASIS_HAS_SIZE_DIM THEN
3334              ASM_REWRITE_TAC[];
3335            ALL_TAC
3336          ] THEN
3337          MP_TAC (ISPEC `S:real^N->bool` FINITE_INDEX_NUMSEG) THEN
3338          ASM_REWRITE_TAC[] THEN
3339          STRIP_TAC THEN
3340          EXISTS_TAC `f:num->real^N` THEN
3341          ASM_REWRITE_TAC[];
3342        ALL_TAC
3343      ] THEN
3344
3345      STRIP_TAC THEN
3346      ABBREV_TAC `f:real^N->real^N = (\p:real^N. (lambda i. if i <= n then p dot (w i) else &0))` THEN
3347      ABBREV_TAC `P:real^N->bool = IMAGE f (span (S:real^N->bool))` THEN
3348      ABBREV_TAC `t:real^N->bool = IMAGE basis (1..n)` THEN
3349
3350      SUBGOAL_THEN `P:real^N->bool SUBSET span t` ASSUME_TAC THENL
3351      [
3352        REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[SYM th])) THEN
3353          REWRITE_TAC[SUBSET; IN_SPAN_IMAGE_BASIS] THEN GEN_TAC THEN
3354          EXPAND_TAC "f" THEN
3355          REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN
3356          REPEAT STRIP_TAC THEN
3357          ASM_REWRITE_TAC[] THEN
3358          FIRST_X_ASSUM ((fun th -> ALL_TAC) o check (is_forall o concl)) THEN
3359          ASM_SIMP_TAC[LAMBDA_BETA] THEN
3360          POP_ASSUM MP_TAC THEN ASM_SIMP_TAC[DE_MORGAN_THM];
3361        ALL_TAC
3362      ] THEN
3363
3364      SUBGOAL_THEN `subspace (P:real^N->bool)` ASSUME_TAC THENL
3365      [
3366        REWRITE_TAC[subspace] THEN
3367          EXPAND_TAC "P" THEN REWRITE_TAC[IN_IMAGE] THEN
3368          REPEAT CONJ_TAC THENL
3369          [
3370            EXISTS_TAC `vec 0:real^N` THEN
3371              REWRITE_TAC[SPAN_0] THEN
3372              EXPAND_TAC "f" THEN
3373              REWRITE_TAC[DOT_LZERO] THEN
3374              VECTOR_ARITH_TAC;
3375
3376            REPEAT STRIP_TAC THEN
3377              EXISTS_TAC `x' + x'':real^N` THEN
3378              CONJ_TAC THENL
3379              [
3380                ASM_REWRITE_TAC[] THEN
3381                  EXPAND_TAC "f" THEN
3382                  REWRITE_TAC[DOT_LADD] THEN
3383                  SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN
3384                  ARITH_TAC;
3385                ALL_TAC
3386              ] THEN
3387              MATCH_MP_TAC SPAN_ADD THEN
3388              ASM_REWRITE_TAC[];
3389
3390            REPEAT STRIP_TAC THEN
3391              EXISTS_TAC `c % x':real^N` THEN
3392              CONJ_TAC THENL
3393              [
3394                ASM_REWRITE_TAC[] THEN EXPAND_TAC "f" THEN
3395                  SIMP_TAC[CART_EQ; VECTOR_MUL_COMPONENT; LAMBDA_BETA; DOT_LMUL] THEN
3396                  ARITH_TAC;
3397                ALL_TAC
3398              ] THEN
3399              MATCH_MP_TAC SPAN_MUL THEN
3400              ASM_REWRITE_TAC[]
3401          ];
3402        ALL_TAC
3403      ] THEN
3404
3405      SUBGOAL_THEN `P:real^N->bool = span t` ASSUME_TAC THENL
3406      [
3407        ASM_CASES_TAC `P:real^N->bool = span t` THEN ASM_REWRITE_TAC[] THEN
3408          MP_TAC (SPECL [`P:real^N->bool`; `t:real^N->bool`] ORTHOGONAL_TO_SPAN_EXISTS) THEN
3409          ANTS_TAC THENL
3410          [
3411            ASM_REWRITE_TAC[] THEN
3412              MATCH_MP_TAC DIM_PSUBSET THEN
3413              REWRITE_TAC[PSUBSET] THEN
3414              SUBGOAL_THEN `span P = P:real^N->bool` (fun th -> REWRITE_TAC[th]) THENL
3415              [
3416                ASM_REWRITE_TAC[SPAN_EQ_SELF];
3417                ALL_TAC
3418              ] THEN
3419              ASM_REWRITE_TAC[];
3420            ALL_TAC
3421          ] THEN
3422          STRIP_TAC THEN
3423
3424          ABBREV_TAC `p:real^N = vsum (1..n) (\i. (v:real^N)$i % w i)` THEN
3425          POP_ASSUM (LABEL_TAC "p") THEN
3426
3427          SUBGOAL_THEN `(f:real^N->real^N) p IN P` ASSUME_TAC THENL
3428          [
3429            EXPAND_TAC "P" THEN
3430              REWRITE_TAC[IN_IMAGE] THEN
3431              EXISTS_TAC `p:real^N` THEN ASM_REWRITE_TAC[] THEN
3432              EXPAND_TAC "p" THEN
3433              MATCH_MP_TAC SPAN_VSUM THEN
3434              REWRITE_TAC[FINITE_NUMSEG] THEN
3435              REPEAT STRIP_TAC THEN
3436              MATCH_MP_TAC SPAN_MUL THEN
3437              MATCH_MP_TAC IN_TRANS THEN
3438              EXISTS_TAC `IMAGE (w:num->real^N) (1..n)` THEN
3439              REWRITE_TAC[SPAN_INC; IN_IMAGE] THEN
3440              EXISTS_TAC `x:num` THEN ASM_REWRITE_TAC[];
3441            ALL_TAC
3442          ] THEN
3443
3444          SUBGOAL_THEN `p:real^N dot p = &0` MP_TAC THENL
3445          [
3446            REMOVE_THEN "p" (fun th -> GEN_REWRITE_TAC (PAT_CONV `\p:real^N. a dot p = &0`) [SYM th]) THEN
3447              SIMP_TAC[FINITE_NUMSEG; DOT_RSUM] THEN
3448              REWRITE_TAC[DOT_RMUL] THEN
3449              SUBGOAL_THEN `sum (1..n) (\y. v$y * (p dot w y)) = (v:real^N) dot ((f:real^N->real^N) p)` (fun th -> REWRITE_TAC[th]) THENL
3450              [
3451                GEN_REWRITE_TAC RAND_CONV[dot] THEN
3452                  MATCH_MP_TAC EQ_TRANS THEN
3453                  EXISTS_TAC `sum (1..dimindex (:N)) (\i. (v:real^N)$i * (p:real^N dot w i))` THEN
3454                  CONJ_TAC THENL
3455                  [
3456                    SUBGOAL_THEN `1..dimindex (:N) = (1..n) UNION (n + 1..dimindex (:N))` (fun th -> REWRITE_TAC[th]) THENL
3457                      [
3458                        MATCH_MP_TAC (GSYM NUMSEG_COMBINE_R) THEN
3459                          EXPAND_TAC "n" THEN
3460                          REWRITE_TAC[DIM_SUBSET_UNIV; ARITH_RULE `1 <= a + 1`];
3461                        ALL_TAC
3462                      ] THEN
3463
3464                      MATCH_MP_TAC (GSYM SUM_UNION_RZERO) THEN
3465                      REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
3466                      GEN_TAC THEN STRIP_TAC THEN
3467                      MATCH_MP_TAC EQ_SYM THEN
3468                      REWRITE_TAC[REAL_ENTIRE] THEN
3469                      DISJ1_TAC THEN
3470                      UNDISCH_TAC `v:real^N IN span t` THEN
3471                      EXPAND_TAC "t" THEN
3472                      REWRITE_TAC[IN_SPAN_IMAGE_BASIS] THEN
3473                      DISCH_THEN MATCH_MP_TAC THEN
3474                      ASM_REWRITE_TAC[IN_NUMSEG] THEN
3475                      MATCH_MP_TAC (ARITH_RULE `n + 1 <= x ==> 1 <= x`) THEN
3476                      ASM_REWRITE_TAC[];
3477                    ALL_TAC
3478                  ] THEN
3479
3480                  MATCH_MP_TAC SUM_EQ THEN
3481                  REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN
3482                  REPEAT (FIRST_X_ASSUM ((fun th -> ALL_TAC) o check (is_forall o concl))) THEN
3483                  EXPAND_TAC "f" THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN
3484                  COND_CASES_TAC THEN REWRITE_TAC[] THEN
3485                  REWRITE_TAC[REAL_MUL_RZERO; REAL_ENTIRE] THEN
3486                  DISJ1_TAC THEN
3487                  UNDISCH_TAC `v:real^N IN span t` THEN
3488                  EXPAND_TAC "t" THEN
3489                  REWRITE_TAC[IN_SPAN_IMAGE_BASIS] THEN
3490                  DISCH_THEN MATCH_MP_TAC THEN
3491                  ASM_REWRITE_TAC[IN_NUMSEG];
3492                ALL_TAC
3493              ] THEN
3494
3495              REWRITE_TAC[DOT_SYM] THEN
3496              FIRST_X_ASSUM MATCH_MP_TAC THEN
3497              ASM_REWRITE_TAC[];
3498            ALL_TAC
3499          ] THEN
3500
3501          REWRITE_TAC[DOT_EQ_0] THEN
3502          DISCH_TAC THEN
3503
3504          SUBGOAL_THEN `!i. i IN 1..n ==> (v:real^N)$i = &0` ASSUME_TAC THENL
3505          [
3506            MATCH_MP_TAC INDEPENDENT_EXPLICIT_NUMSEG THEN
3507              EXISTS_TAC `w:num->real^N` THEN
3508              ASM_REWRITE_TAC[] THEN
3509              UNDISCH_TAC `S:real^N->bool = IMAGE w (1..n)` THEN
3510              DISCH_THEN (fun th -> ASM_REWRITE_TAC[SYM th]);
3511            ALL_TAC
3512          ] THEN
3513
3514          SUBGOAL_THEN `v:real^N = vec 0` MP_TAC THENL
3515          [
3516            REWRITE_TAC[CART_EQ; VEC_COMPONENT] THEN
3517              REPEAT STRIP_TAC THEN
3518              ASM_CASES_TAC `i <= n:num` THENL
3519              [
3520                FIRST_X_ASSUM MATCH_MP_TAC THEN
3521                  ASM_REWRITE_TAC[IN_NUMSEG];
3522                ALL_TAC
3523              ] THEN
3524              UNDISCH_TAC `v:real^N IN span t` THEN
3525              EXPAND_TAC "t" THEN
3526              REWRITE_TAC[IN_SPAN_IMAGE_BASIS] THEN
3527              DISCH_THEN (MP_TAC o SPEC `i:num`) THEN
3528              ASM_REWRITE_TAC[IN_NUMSEG; DE_MORGAN_THM];
3529            ALL_TAC
3530          ] THEN
3531
3532          ASM_REWRITE_TAC[];
3533        ALL_TAC
3534      ] THEN
3535
3536      ABBREV_TAC `r:real^N = lambda i. if i <= n then b ((w:num->real^N) i) else &0` THEN
3537      FIRST_X_ASSUM ((fun th -> ALL_TAC) o check (is_forall o concl)) THEN
3538
3539      SUBGOAL_THEN `?p. p IN span S /\ f (p:real^N) = r:real^N` MP_TAC THENL
3540      [
3541        SUBGOAL_THEN `r:real^N IN P` MP_TAC THENL
3542          [
3543            ASM_REWRITE_TAC[] THEN
3544              EXPAND_TAC "t" THEN
3545              REWRITE_TAC[IN_SPAN_IMAGE_BASIS] THEN
3546              REWRITE_TAC[IN_NUMSEG; DE_MORGAN_THM] THEN
3547              REPEAT STRIP_TAC THEN POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN
3548              EXPAND_TAC "r" THEN
3549              ASM_SIMP_TAC[LAMBDA_BETA];
3550            ALL_TAC
3551          ] THEN
3552
3553          EXPAND_TAC "P" THEN
3554          REWRITE_TAC[IN_IMAGE] THEN
3555          STRIP_TAC THEN
3556          EXISTS_TAC `x:real^N` THEN
3557          ASM_REWRITE_TAC[];
3558        ALL_TAC
3559      ] THEN
3560
3561      STRIP_TAC THEN
3562      REWRITE_TAC[EXISTS_UNIQUE] THEN
3563      EXISTS_TAC `p:real^N` THEN
3564
3565      SUBGOAL_THEN `p:real^N IN span S /\ (!x. x IN S ==> p dot x = b x)` ASSUME_TAC THENL
3566      [
3567        ASM_REWRITE_TAC[] THEN
3568          GEN_TAC THEN REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN
3569          DISCH_THEN (X_CHOOSE_THEN `i:num` ASSUME_TAC) THEN
3570          ASM_REWRITE_TAC[] THEN
3571          UNDISCH_TAC `f (p:real^N) = r:real^N` THEN
3572          DISCH_THEN (MP_TAC o AP_TERM `(\v:real^N. v$i)`) THEN
3573          BETA_TAC THEN
3574          EXPAND_TAC "f" THEN EXPAND_TAC "r" THEN
3575          SUBGOAL_THEN `1 <= i /\ i <= dimindex (:N)` MP_TAC THENL
3576          [
3577            ASM_REWRITE_TAC[] THEN
3578              MATCH_MP_TAC LE_TRANS THEN
3579              EXISTS_TAC `n:num` THEN
3580              ASM_REWRITE_TAC[] THEN
3581              EXPAND_TAC "n" THEN
3582              REWRITE_TAC[DIM_SUBSET_UNIV];
3583            ALL_TAC
3584          ] THEN
3585
3586          SIMP_TAC[LAMBDA_BETA] THEN
3587          ASM_REWRITE_TAC[];
3588        ALL_TAC
3589      ] THEN
3590
3591      FIRST_ASSUM (fun th -> REWRITE_TAC[th]) THEN
3592      REPEAT STRIP_TAC THEN
3593
3594      ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
3595      MATCH_MP_TAC ORTHOGONAL_TO_ALL_IMP_ZERO THEN
3596      EXISTS_TAC `S:real^N->bool` THEN
3597      CONJ_TAC THENL
3598      [
3599        MATCH_MP_TAC SPAN_SUB THEN
3600          ASM_REWRITE_TAC[];
3601        ALL_TAC
3602      ] THEN
3603
3604      REPEAT STRIP_TAC THEN
3605      ASM_SIMP_TAC[DOT_LSUB; REAL_SUB_REFL]);;
3606
3607
3608
3609 let UNIQUE_SOLUTION_AFFINE_INDEPENDENT = prove(`!(S:real^N->bool) b. ~(S = {}) /\ ~affine_dependent S
3610                                                 ==> (?!p. p IN affine hull S /\
3611                                                        (!x y. x IN S /\ y IN S ==> p dot (x - y) = b x - b y))`,
3612    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
3613      REPEAT GEN_TAC THEN
3614      DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_THEN `v0:real^N` ASSUME_TAC) ASSUME_TAC) THEN
3615
3616      ABBREV_TAC `R:real^N->bool = {y - v0 | y | y IN S DELETE v0}` THEN
3617
3618      MP_TAC (SPECL [`R:real^N->bool`; `\v:real^N. (b:real^N->real) (v + v0) - b v0 - v0 dot v`] UNIQUE_SOLUTION_lemma) THEN
3619      ANTS_TAC THENL
3620      [
3621        MP_TAC (SPEC `S:real^N->bool` AFFINE_INDEPENDENT_IMP_INDEPENDENT) THEN
3622          ASM_REWRITE_TAC[] THEN
3623          DISCH_THEN (MP_TAC o SPEC `v0:real^N`) THEN
3624          ASM_SIMP_TAC[];
3625        ALL_TAC
3626      ] THEN
3627
3628      REWRITE_TAC[EXISTS_UNIQUE] THEN
3629      STRIP_TAC THEN
3630
3631      EXISTS_TAC `p + v0:real^N` THEN
3632      SUBGOAL_THEN `span (R:real^N->bool) = affine hull IMAGE (\x. --v0 + x) S` ASSUME_TAC THENL
3633      [
3634        MATCH_MP_TAC EQ_TRANS THEN
3635          EXISTS_TAC `span ((v0 - v0:real^N) INSERT R)` THEN
3636          CONJ_TAC THENL [ REWRITE_TAC[VECTOR_SUB_REFL; SPAN_INSERT_0]; ALL_TAC ] THEN
3637          SUBGOAL_THEN `(v0 - v0) INSERT R = IMAGE (\x:real^N. --v0 + x) S` (fun th -> REWRITE_TAC[th]) THENL
3638          [
3639            REWRITE_TAC[EXTENSION; IN_INSERT; IN_IMAGE; VECTOR_ARITH `--v0 + x = x - v0:real^N`] THEN
3640              EXPAND_TAC "R" THEN
3641              REWRITE_TAC[IN_ELIM_THM; IN_DELETE] THEN
3642              ASM SET_TAC[];
3643            ALL_TAC
3644          ] THEN
3645          MATCH_MP_TAC (GSYM AFFINE_HULL_EQ_SPAN) THEN
3646          MATCH_MP_TAC HULL_INC THEN
3647          REWRITE_TAC[IN_IMAGE] THEN
3648          EXISTS_TAC `v0:real^N` THEN
3649          ASM_REWRITE_TAC[VECTOR_ARITH `--v0 + v0 = vec 0:real^N`];
3650        ALL_TAC
3651      ] THEN
3652
3653      CONJ_TAC THENL
3654      [
3655        CONJ_TAC THENL
3656          [
3657            UNDISCH_TAC `p:real^N IN span R` THEN
3658              POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN
3659              REWRITE_TAC[AFFINE_HULL_TRANSLATION; IN_IMAGE] THEN
3660              REWRITE_TAC[VECTOR_ARITH `p = --v0 + x <=> p + v0:real^N = x`] THEN
3661              STRIP_TAC THEN
3662              ASM_REWRITE_TAC[];
3663            ALL_TAC
3664          ] THEN
3665
3666          SUBGOAL_THEN `!x:real^N. x IN S ==> (p + v0) dot (x - v0) = b x - b v0` ASSUME_TAC THENL
3667          [
3668            REPEAT STRIP_TAC THEN
3669              ASM_CASES_TAC `x = v0:real^N` THENL
3670              [
3671                ASM_REWRITE_TAC[VECTOR_SUB_REFL; DOT_RZERO; REAL_SUB_REFL];
3672                ALL_TAC
3673              ] THEN
3674
3675              REWRITE_TAC[DOT_LADD] THEN
3676              SUBGOAL_THEN `p:real^N dot (x - v0) = b ((x - v0) + v0) - b v0 - v0 dot (x - v0)` (fun th -> REWRITE_TAC[th]) THENL
3677              [
3678                FIRST_X_ASSUM MATCH_MP_TAC THEN
3679                  EXPAND_TAC "R" THEN
3680                  REWRITE_TAC[IN_ELIM_THM; IN_DELETE] THEN
3681                  EXISTS_TAC `x:real^N` THEN
3682                  ASM_REWRITE_TAC[];
3683                ALL_TAC
3684              ] THEN
3685
3686              REWRITE_TAC[VECTOR_ARITH `x - v0 + v0 = x:real^N`] THEN
3687              REAL_ARITH_TAC;
3688            ALL_TAC
3689          ] THEN
3690
3691          REPEAT STRIP_TAC THEN
3692          ONCE_REWRITE_TAC[VECTOR_ARITH `a - b = (a - v0:real^N) - (b - v0)`] THEN
3693          ONCE_REWRITE_TAC[DOT_RSUB] THEN
3694          FIRST_ASSUM (MP_TAC o SPEC `x:real^N`) THEN
3695          FIRST_ASSUM (MP_TAC o SPEC `y:real^N`) THEN
3696          POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN
3697          POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN
3698          REPEAT (DISCH_THEN (fun th -> REWRITE_TAC[th])) THEN
3699          REAL_ARITH_TAC;
3700        ALL_TAC
3701      ] THEN
3702
3703      GEN_TAC THEN DISCH_TAC THEN
3704      FIRST_X_ASSUM (MP_TAC o SPEC `y - v0:real^N`) THEN
3705      POP_ASSUM STRIP_ASSUME_TAC THEN
3706
3707      ANTS_TAC THENL
3708      [
3709        CONJ_TAC THENL
3710          [
3711            ASM_REWRITE_TAC[AFFINE_HULL_TRANSLATION; IN_IMAGE] THEN
3712              EXISTS_TAC `y:real^N` THEN
3713              ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC;
3714            ALL_TAC
3715          ] THEN
3716
3717          EXPAND_TAC "R" THEN
3718          REWRITE_TAC[IN_IMAGE; IN_DELETE; IN_ELIM_THM] THEN
3719          REPEAT STRIP_TAC THEN
3720          ASM_REWRITE_TAC[DOT_LSUB; VECTOR_ARITH `y - v0 + v0:real^N = y`] THEN
3721          FIRST_X_ASSUM (MP_TAC o SPECL [`y':real^N`; `v0:real^N`]) THEN
3722          ASM_REWRITE_TAC[] THEN
3723          DISCH_THEN (fun th -> REWRITE_TAC[th]);
3724        ALL_TAC
3725      ] THEN
3726
3727      VECTOR_ARITH_TAC);;
3728
3729
3730 (* QXSKIIT *)
3731
3732 let QXSKIIT = prove(`!(vf:A->real^N) b .  FINITE (IMAGE vf (:A)) /\
3733                        ~affine_dependent (IMAGE vf (:A)) /\  (!i j. (vf i = vf j) ==> (b i = b j))
3734                      ==> (?!p.  p IN affine hull (IMAGE vf (:A)) /\ (!i j.  (p dot (vf i - vf j) = (b i - b j))))`,
3735    REPEAT STRIP_TAC THEN
3736      ABBREV_TAC `S = IMAGE (vf:A->real^N) (:A)` THEN
3737      SUBGOAL_THEN `?h:real^N->real. !i:A. h (vf i) = b i` CHOOSE_TAC THENL
3738      [
3739        EXISTS_TAC `\x:real^N. if x IN S then b (inverse (vf:A->real^N) x) else &0` THEN
3740          EXPAND_TAC "S" THEN
3741          REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN
3742          GEN_TAC THEN
3743          SUBGOAL_THEN `?x:A. vf i = (vf x):real^N` (fun th -> REWRITE_TAC[th]) THENL
3744          [
3745            EXISTS_TAC `i:A` THEN REWRITE_TAC[];
3746            ALL_TAC
3747          ] THEN
3748
3749          REWRITE_TAC[inverse] THEN
3750          FIRST_X_ASSUM MATCH_MP_TAC THEN
3751          MESON_TAC[];
3752        ALL_TAC
3753      ] THEN
3754
3755      MP_TAC (SPECL [`S:real^N->bool`; `\x:real^N. (h:real^N->real) x`] UNIQUE_SOLUTION_AFFINE_INDEPENDENT) THEN
3756      ANTS_TAC THENL
3757      [
3758        ASM_REWRITE_TAC[] THEN
3759          REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
3760          EXPAND_TAC "S" THEN
3761          REWRITE_TAC[IN_IMAGE] THEN
3762          MP_TAC UNIV_NOT_EMPTY THEN
3763          REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
3764          STRIP_TAC THEN
3765          MAP_EVERY EXISTS_TAC [`(vf:A->real^N) x`; `x:A`] THEN
3766          ASM_REWRITE_TAC[];
3767        ALL_TAC
3768      ] THEN
3769
3770      REWRITE_TAC[] THEN
3771      SUBGOAL_THEN `!p. (!x y:real^N. x IN S /\ y IN S ==> p dot (x - y) = h x - h y) <=> (!i j:A. p dot (vf i - vf j) = b i - b j)` MP_TAC THENL
3772      [
3773        GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
3774          [
3775            POP_ASSUM (MP_TAC o SPECL [`(vf:A->real^N) i`; `(vf:A->real^N) j`]) THEN
3776              EXPAND_TAC "S" THEN
3777              ASM_REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN
3778              DISCH_THEN MATCH_MP_TAC THEN
3779              CONJ_TAC THENL [ EXISTS_TAC `i:A`; EXISTS_TAC `j:A` ] THEN REWRITE_TAC[];
3780            ALL_TAC
3781          ] THEN
3782          POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
3783          EXPAND_TAC "S" THEN
3784          REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN
3785          REPEAT STRIP_TAC THEN
3786          ASM_REWRITE_TAC[];
3787        ALL_TAC
3788      ] THEN
3789
3790      DISCH_THEN (fun th -> REWRITE_TAC[th])
3791                    );;
3792
3793
3794
3795 (*******************************************)
3796
3797 (***********)
3798 (* OAPVION *)
3799 (***********)
3800
3801
3802 let CIRCUMCENTER_lemma = prove(`!S:real^N->bool. ~(S = {}) /\ ~affine_dependent S ==>
3803                                 ?!p. p IN affine hull S /\
3804                                 (!x y. x IN S /\ y IN S ==> dist (p,x) = dist (p,y))`,
3805    REPEAT STRIP_TAC THEN
3806      MP_TAC (SPECL [`S:real^N->bool`; `\v:real^N. (v dot v) / &2`] UNIQUE_SOLUTION_AFFINE_INDEPENDENT) THEN
3807      ASM_REWRITE_TAC[] THEN
3808      DISCH_TAC THEN
3809      REWRITE_TAC[DIST_EQ; dist; NORM_POW_2] THEN
3810      REWRITE_TAC[DOT_LSUB; DOT_RSUB; DOT_SYM] THEN
3811      REWRITE_TAC[REAL_ARITH `p2 - px - (px - x2) = p2 - py - (py - y2) <=> px - py = x2 / &2 - y2 / &2`] THEN
3812      ONCE_REWRITE_TAC[GSYM DOT_RSUB] THEN
3813      ASM_REWRITE_TAC[]);;
3814
3815
3816 let CIRCUMCENTER_LEMMA = prove(`!S:real^N->bool. ~(S = {}) /\ ~affine_dependent S ==>
3817                                 ?!p. p IN affine hull S /\
3818                                 (?c. !w. w IN S ==> c = dist (p,w))`,
3819    GEN_TAC THEN DISCH_THEN (MP_TAC o MATCH_MP CIRCUMCENTER_lemma) THEN
3820      SUBGOAL_THEN `!p. (!x y:real^N. x IN S /\ y IN S ==> dist (p,x) = dist (p,y)) <=> (?c. !w. w IN S ==> c = dist (p,w))` ASSUME_TAC THENL
3821      [
3822        GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
3823          [
3824            ASM_CASES_TAC `S:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
3825              POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
3826              STRIP_TAC THEN
3827              EXISTS_TAC `dist (p,x:real^N)` THEN
3828              REPEAT STRIP_TAC THEN
3829              FIRST_X_ASSUM MATCH_MP_TAC THEN
3830              ASM_REWRITE_TAC[];
3831            ALL_TAC
3832          ] THEN
3833          MATCH_MP_TAC EQ_TRANS THEN
3834          EXISTS_TAC `c:real` THEN
3835          REWRITE_TAC[EQ_SYM_EQ] THEN
3836          CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[];
3837        ALL_TAC
3838      ] THEN
3839      ASM_REWRITE_TAC[]);;
3840
3841
3842
3843 let OAPVION1 = prove(`!(S:real^N->bool). ~(S = {}) /\ ~affine_dependent S ==>
3844                        (circumcenter S) IN (affine hull S)`,
3845    GEN_TAC THEN DISCH_THEN (MP_TAC o MATCH_MP CIRCUMCENTER_LEMMA) THEN
3846      REWRITE_TAC[circumcenter; IN] THEN
3847      MESON_TAC[]);;
3848
3849
3850
3851 let OAPVION2 = prove(`!(S:real^N->bool). ~affine_dependent S ==>
3852                        (!w. w IN S ==> (radV S = dist(circumcenter S, w)))`,
3853    REPEAT STRIP_TAC THEN
3854      SUBGOAL_THEN `~(S:real^N->bool = {})` ASSUME_TAC THENL
3855      [
3856        REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
3857          EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[];
3858        ALL_TAC
3859      ] THEN
3860      MP_TAC (SPEC `S:real^N->bool` CIRCUMCENTER_LEMMA) THEN
3861      ASM_REWRITE_TAC[IN; radV; EXISTS_UNIQUE] THEN
3862      STRIP_TAC THEN
3863      SUBGOAL_THEN `circumcenter S = p:real^N` (fun th -> REWRITE_TAC[th]) THENL
3864      [
3865        REWRITE_TAC[circumcenter] THEN
3866          MATCH_MP_TAC SELECT_UNIQUE THEN
3867          ASM_MESON_TAC[];
3868        ALL_TAC
3869      ] THEN
3870
3871      MATCH_MP_TAC SELECT_UNIQUE THEN
3872      X_GEN_TAC `r:real` THEN
3873      EQ_TAC THENL
3874      [
3875        REWRITE_TAC[] THEN
3876          DISCH_THEN (MP_TAC o SPEC `w:real^N`) THEN
3877          UNDISCH_TAC `w:real^N IN S` THEN
3878          SIMP_TAC[IN];
3879        ALL_TAC
3880      ] THEN
3881
3882      BETA_TAC THEN
3883      REMOVE_ASSUM THEN
3884      FIRST_ASSUM (MP_TAC o SPEC `w:real^N`) THEN
3885      UNDISCH_TAC `w:real^N IN S` THEN
3886      SIMP_TAC[IN] THEN
3887      DISCH_TAC THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN DISCH_TAC THEN
3888      ASM_REWRITE_TAC[]);;
3889
3890
3891
3892 let OAPVION3 = prove(`!(S:real^N->bool).  ~affine_dependent S ==>
3893                        (!p.  (p IN affine hull S) /\ (?c. !w. (w IN S) ==> (dist(p,w) = c)) ==> (p = circumcenter S))`,
3894    REPEAT STRIP_TAC THEN
3895      SUBGOAL_THEN `~(S:real^N->bool = {})` ASSUME_TAC THENL
3896      [
3897        DISCH_TAC THEN
3898          UNDISCH_TAC `p:real^N IN affine hull S` THEN
3899          ASM_REWRITE_TAC[AFFINE_HULL_EMPTY; NOT_IN_EMPTY];
3900        ALL_TAC
3901      ] THEN
3902
3903      MP_TAC (SPEC `S:real^N->bool` CIRCUMCENTER_LEMMA) THEN
3904      ASM_REWRITE_TAC[EXISTS_UNIQUE; circumcenter] THEN
3905      REPEAT STRIP_TAC THEN
3906
3907      REPEAT (POP_ASSUM MP_TAC) THEN REWRITE_TAC[IN] THEN REPEAT DISCH_TAC THEN
3908
3909      MATCH_MP_TAC (GSYM SELECT_UNIQUE) THEN
3910      BETA_TAC THEN GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
3911      [
3912        ASM_REWRITE_TAC[] THEN
3913          EXISTS_TAC `c:real` THEN
3914          UNDISCH_TAC `!w:real^N. S w ==> dist (p,w) = c` THEN
3915          SIMP_TAC[EQ_SYM_EQ];
3916        ALL_TAC
3917      ] THEN
3918
3919      MATCH_MP_TAC EQ_TRANS THEN
3920      EXISTS_TAC `p':real^N` THEN
3921      CONJ_TAC THENL
3922      [
3923        FIRST_X_ASSUM MATCH_MP_TAC THEN
3924          ASM_REWRITE_TAC[];
3925        ALL_TAC
3926      ] THEN
3927      MATCH_MP_TAC EQ_SYM THEN
3928      FIRST_X_ASSUM MATCH_MP_TAC THEN
3929      ASM_REWRITE_TAC[] THEN
3930      EXISTS_TAC `c:real` THEN
3931      UNDISCH_TAC `!w:real^N. S w ==> dist (p,w) = c` THEN
3932      SIMP_TAC[EQ_SYM_EQ]);;
3933
3934
3935 let CIRCUMCENTER_1 = prove(`!x:real^N. circumcenter {x} = x`,
3936    GEN_TAC THEN
3937      MP_TAC (SPEC `{x:real^N}` OAPVION3) THEN
3938      REWRITE_TAC[AFFINE_INDEPENDENT_1; AFFINE_HULL_SING; IN_SING] THEN
3939      DISCH_THEN (fun th -> MATCH_MP_TAC (GSYM th)) THEN
3940      REWRITE_TAC[] THEN
3941      EXISTS_TAC `&0` THEN
3942      SIMP_TAC[DIST_REFL]);;
3943
3944
3945 let CIRCUMCENTER_NOT_EQ = prove(`!S:real^N->bool. ~affine_dependent S /\ 1 < CARD S ==>
3946                                           !x. x IN S ==> ~(circumcenter S = x)`,
3947    REPEAT STRIP_TAC THEN
3948      SUBGOAL_THEN `?y. y IN S DELETE (x:real^N)` MP_TAC THENL
3949      [
3950        REWRITE_TAC[MEMBER_NOT_EMPTY] THEN
3951          DISCH_THEN (MP_TAC o AP_TERM `\s:real^N->bool. CARD s`) THEN
3952          REWRITE_TAC[CARD_CLAUSES] THEN
3953          MP_TAC (ISPECL [`x:real^N`; `S:real^N->bool`] CARD_DELETE) THEN
3954          ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE] THEN
3955          UNDISCH_TAC `1 < CARD (S:real^N->bool)` THEN
3956          ARITH_TAC;
3957        ALL_TAC
3958      ] THEN
3959
3960      REWRITE_TAC[IN_DELETE] THEN
3961      STRIP_TAC THEN
3962      MP_TAC (SPEC `S:real^N->bool` OAPVION2) THEN
3963      ASM_REWRITE_TAC[] THEN
3964      DISCH_TAC THEN
3965      FIRST_ASSUM (MP_TAC o SPEC `x:real^N`) THEN
3966      REWRITE_TAC[DIST_REFL] THEN
3967      ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
3968      FIRST_X_ASSUM (MP_TAC o SPEC `y:real^N`) THEN
3969      ASM_REWRITE_TAC[EQ_SYM_EQ; DIST_EQ_0]);;
3970
3971
3972 let CIRCUMCENTER_TRANSLATION = prove(`!s (a:real^N). ~(s = {}) /\ ~affine_dependent s ==>
3973                                        circumcenter (IMAGE (\x. a + x) s) = a + circumcenter s`,
3974    REPEAT STRIP_TAC THEN
3975      MP_TAC (SPEC `IMAGE (\x:real^N. a + x) s` OAPVION3) THEN
3976      ASM_REWRITE_TAC[AFFINE_DEPENDENT_TRANSLATION_EQ] THEN
3977      DISCH_THEN (fun th -> MATCH_MP_TAC (GSYM th)) THEN
3978      CONJ_TAC THENL
3979      [
3980        REWRITE_TAC[AFFINE_HULL_TRANSLATION; IN_IMAGE] THEN
3981          EXISTS_TAC `circumcenter (s:real^N->bool)` THEN
3982          MP_TAC (SPEC `s:real^N->bool` OAPVION1) THEN
3983          ASM_REWRITE_TAC[];
3984        ALL_TAC
3985      ] THEN
3986
3987      EXISTS_TAC `radV (s:real^N->bool)` THEN
3988      REWRITE_TAC[IN_IMAGE] THEN
3989      REPEAT STRIP_TAC THEN
3990      MP_TAC (SPEC `s:real^N->bool` OAPVION2) THEN
3991      ASM_REWRITE_TAC[] THEN
3992      DISCH_THEN (MP_TAC o SPEC `x:real^N`) THEN
3993      ASM_REWRITE_TAC[] THEN
3994      DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
3995      REWRITE_TAC[dist] THEN
3996      AP_TERM_TAC THEN
3997      VECTOR_ARITH_TAC);;
3998
3999
4000
4001
4002 let RADV_TRANSLATION = prove(`!s (a:real^N). ~affine_dependent s ==>
4003                                radV (IMAGE (\x. a + x) s) = radV s`,
4004    REPEAT STRIP_TAC THEN
4005      ASM_CASES_TAC `s:real^N->bool = {}` THENL
4006      [
4007        ASM_REWRITE_TAC[IMAGE_CLAUSES];
4008        ALL_TAC
4009      ] THEN
4010
4011      MP_TAC (SPEC `IMAGE (\x:real^N. a + x) s` OAPVION2) THEN
4012      ASM_REWRITE_TAC[AFFINE_DEPENDENT_TRANSLATION_EQ] THEN
4013      FIRST_ASSUM MP_TAC THEN
4014      REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
4015      STRIP_TAC THEN
4016      DISCH_THEN (MP_TAC o SPEC `a + x:real^N`) THEN
4017      ANTS_TAC THENL
4018      [
4019        REWRITE_TAC[IN_IMAGE] THEN
4020          EXISTS_TAC `x:real^N` THEN
4021          ASM_REWRITE_TAC[];
4022        ALL_TAC
4023      ] THEN
4024
4025      DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
4026      ASM_SIMP_TAC[CIRCUMCENTER_TRANSLATION; dist; VECTOR_ARITH `(a + b) - (a + x) = b - x:real^N`] THEN
4027      REWRITE_TAC[GSYM dist] THEN
4028      MATCH_MP_TAC EQ_SYM THEN
4029
4030      MP_TAC (SPEC `s:real^N->bool` OAPVION2) THEN
4031      ASM_REWRITE_TAC[] THEN
4032      DISCH_THEN (MP_TAC o SPEC `x:real^N`) THEN
4033      ASM_REWRITE_TAC[]);;
4034
4035
4036
4037
4038
4039 (**************************************)
4040
4041 (***********)
4042 (* MHFTTZN *)
4043 (***********)
4044
4045
4046 let AFF_INTER_SUBSET_INTER_AFF = prove(`!s t:real^N->bool. affine hull (s INTER t) SUBSET affine hull s INTER affine hull t`,
4047    REPEAT STRIP_TAC THEN
4048      REWRITE_TAC[SUBSET_INTER] THEN
4049      CONJ_TAC THEN MATCH_MP_TAC HULL_MONO THEN REWRITE_TAC[INTER_SUBSET]);;
4050
4051
4052
4053 let MHFTTZN_lemma = prove(`!V ul k. packing V /\ barV V k ul ==>
4054                             affine hull voronoi_list V ul = INTERS {bis (HD ul) u | u | u IN set_of_list ul}`,
4055    REPEAT GEN_TAC THEN
4056      SPEC_TAC (`ul:(real^3)list`, `ul:(real^3)list`) THEN
4057      SPEC_TAC (`k:num`, `k:num`) THEN
4058      INDUCT_TAC THENL
4059      [
4060        REWRITE_TAC[BARV; VORONOI_NONDG; ARITH] THEN
4061          REPEAT STRIP_TAC THEN
4062          MATCH_MP_TAC EQ_TRANS THEN
4063          EXISTS_TAC `UNIV:real^3->bool` THEN
4064          REWRITE_TAC[VORONOI_LIST; VORONOI_SET] THEN
4065          MP_TAC (ISPEC `ul:(real^3)list` LENGTH_1_LEMMA) THEN
4066          ASM_REWRITE_TAC[] THEN
4067          DISCH_THEN (fun th -> ONCE_REWRITE_TAC[th]) THEN
4068          REWRITE_TAC[set_of_list; IN_SING; HD] THEN
4069          CONJ_TAC THENL
4070          [
4071            MATCH_MP_TAC CONTAINS_BALL_AFFINE_HULL THEN
4072              SUBGOAL_THEN `INTERS {voronoi_closed V v | v:real^3 = HD ul} = voronoi_closed V (HD ul)` (fun th -> REWRITE_TAC[th]) THENL
4073              [
4074                SET_TAC[];
4075                ALL_TAC
4076              ] THEN
4077              EXISTS_TAC `(HD ul):real^3` THEN
4078              MATCH_MP_TAC VORONOI_CLOSED_CONTAINS_BALL THEN
4079              ASM_REWRITE_TAC[];
4080            ALL_TAC
4081          ] THEN
4082
4083          SUBGOAL_THEN `INTERS {bis (HD ul) u | u | u:real^3 = HD ul} = bis (HD ul) (HD ul)` (fun th -> REWRITE_TAC[th]) THENL
4084          [
4085            SET_TAC[];
4086            ALL_TAC
4087          ] THEN
4088
4089          REWRITE_TAC[bis] THEN
4090          SET_TAC[];
4091        ALL_TAC
4092      ] THEN
4093
4094      REPEAT STRIP_TAC THEN
4095      SUBGOAL_THEN `SUC k <= 3` ASSUME_TAC THENL
4096      [
4097        MATCH_MP_TAC BARV_IMP_K_LE_3 THEN
4098          EXISTS_TAC `V:real^3->bool` THEN EXISTS_TAC `ul:(real^3)list` THEN
4099          ASM_REWRITE_TAC[];
4100        ALL_TAC
4101      ] THEN
4102      ABBREV_TAC `vl:(real^3)list = BUTLAST ul` THEN
4103      POP_ASSUM (LABEL_TAC "vl") THEN
4104
4105      SUBGOAL_THEN `LENGTH (ul:(real^3)list) = k + 2` ASSUME_TAC THENL
4106      [
4107        UNDISCH_TAC `barV V (SUC k) ul` THEN
4108          REWRITE_TAC[BARV] THEN
4109          ARITH_TAC;
4110        ALL_TAC
4111      ] THEN
4112
4113      SUBGOAL_THEN `truncate_simplex k (ul:(real^3)list) = vl` (LABEL_TAC "vl2") THENL
4114      [
4115        MP_TAC (ISPEC `ul:(real^3)list` TRUNCATE_SIMPLEX_EQ_BUTLAST) THEN
4116          ASM_REWRITE_TAC[ARITH_RULE `2 <= k + 2`; ARITH_RULE `(k + 2) - 2 = k`];
4117        ALL_TAC
4118      ] THEN
4119
4120      SUBGOAL_THEN `barV V k vl` ASSUME_TAC THENL
4121      [
4122        REMOVE_THEN "vl2" (fun th -> REWRITE_TAC[SYM th]) THEN
4123          MATCH_MP_TAC TRUNCATE_SIMPLEX_BARV THEN
4124          EXISTS_TAC `SUC k` THEN
4125          ASM_SIMP_TAC[ARITH_RULE `k <= SUC k`];
4126        ALL_TAC
4127      ] THEN
4128
4129      FIRST_X_ASSUM (MP_TAC o SPEC `vl:(real^3)list`) THEN
4130      ASM_REWRITE_TAC[] THEN
4131
4132      SUBGOAL_THEN `HD vl = (HD ul):real^3` ASSUME_TAC THENL
4133      [
4134        EXPAND_TAC "vl" THEN
4135          MATCH_MP_TAC HD_TRUNCATE_SIMPLEX THEN
4136          UNDISCH_TAC `barV V (SUC k) ul` THEN
4137          REWRITE_TAC[BARV] THEN
4138          ARITH_TAC;
4139        ALL_TAC
4140      ] THEN
4141      ASM_REWRITE_TAC[] THEN
4142      DISCH_TAC THEN
4143
4144      ABBREV_TAC `A0 = INTERS {bis (HD ul) u | u | u:real^3 IN set_of_list vl}` THEN
4145      ABBREV_TAC `A1 = INTERS {bis (HD ul) u | u | u:real^3 IN set_of_list ul}` THEN
4146
4147      SUBGOAL_THEN `voronoi_list V ul = voronoi_list V vl INTER bis (HD ul) (LAST ul)` (LABEL_TAC "B1") THENL
4148      [
4149        MP_TAC (SPECL [`V:real^3->bool`; `vl:(real^3)list`; `LAST ul:real^3`; `HD vl:real^3`; `TL vl:(real^3)list`] VORONOI_LIST_INTER_BIS) THEN
4150          SUBGOAL_THEN `APPEND vl [LAST ul:real^3] = ul` (fun th -> REWRITE_TAC[th]) THENL
4151          [
4152            REMOVE_THEN "vl" (fun th -> REWRITE_TAC[SYM th]) THEN
4153              MATCH_MP_TAC APPEND_BUTLAST_LAST THEN
4154              ASM_REWRITE_TAC[GSYM LENGTH_EQ_NIL] THEN
4155              ARITH_TAC;
4156            ALL_TAC
4157          ] THEN
4158
4159          UNDISCH_TAC `HD vl = HD ul:real^3` THEN
4160          DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
4161          DISCH_THEN (fun th -> MATCH_MP_TAC (GSYM th)) THEN
4162          MP_TAC (SPECL [`V:real^3->bool`; `k:num`; `vl:(real^3)list`] BARV_SUBSET) THEN
4163          ASM_REWRITE_TAC[] THEN
4164          DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
4165
4166          CONJ_TAC THENL
4167          [
4168            MATCH_MP_TAC IN_TRANS THEN
4169              EXISTS_TAC `set_of_list (ul:(real^3)list)` THEN
4170              MP_TAC (SPECL [`V:real^3->bool`; `SUC k`; `ul:(real^3)list`] BARV_SUBSET) THEN
4171              ASM_SIMP_TAC[] THEN
4172              DISCH_THEN (fun th -> ALL_TAC) THEN
4173              REWRITE_TAC[IN_SET_OF_LIST] THEN
4174              MP_TAC (ISPEC `ul:(real^3)list` LAST_EL) THEN
4175              ASM_REWRITE_TAC[GSYM LENGTH_EQ_NIL; ARITH_RULE `~(k + 2 = 0)`] THEN
4176              DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
4177              MATCH_MP_TAC MEM_EL THEN
4178              ASM_REWRITE_TAC[] THEN
4179              ARITH_TAC;
4180            ALL_TAC
4181          ] THEN
4182
4183          MP_TAC (ISPEC `vl:(real^3)list` LENGTH_IMP_CONS) THEN
4184          ANTS_TAC THENL
4185          [
4186            UNDISCH_TAC `barV V k vl` THEN
4187              REWRITE_TAC[BARV] THEN
4188              ARITH_TAC;
4189            ALL_TAC
4190          ] THEN
4191
4192          STRIP_TAC THEN
4193          ASM_REWRITE_TAC[HD; TL];
4194        ALL_TAC
4195      ] THEN
4196
4197      SUBGOAL_THEN `A0 INTER bis ((HD ul):real^3) (LAST ul) = A1` (LABEL_TAC "A1") THENL
4198      [
4199        EXPAND_TAC "A0" THEN EXPAND_TAC "A1" THEN
4200          SUBGOAL_THEN `set_of_list ul = set_of_list vl UNION {LAST ul:real^3}` (fun th -> REWRITE_TAC[th]) THENL
4201          [
4202            MP_TAC (ISPEC `ul:(real^3)list` APPEND_BUTLAST_LAST) THEN
4203              ASM_REWRITE_TAC[GSYM LENGTH_EQ_NIL; ARITH_RULE `~(k + 2 = 0)`] THEN
4204              DISCH_THEN (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN
4205              REWRITE_TAC[SET_OF_LIST_APPEND; set_of_list];
4206            ALL_TAC
4207          ] THEN
4208          SET_TAC[];
4209        ALL_TAC
4210      ] THEN
4211
4212      ASM_CASES_TAC `A1 = A0:real^3->bool` THENL
4213      [
4214        SUBGOAL_THEN `voronoi_list V ul = voronoi_list V vl` (fun th -> ASM_REWRITE_TAC[th]) THEN
4215          SUBGOAL_THEN `voronoi_list V vl = voronoi_list V vl INTER A0` MP_TAC THENL
4216          [
4217            MATCH_MP_TAC (SET_RULE `A SUBSET B ==> A = A INTER B:A->bool`) THEN
4218              MATCH_MP_TAC SUBSET_TRANS THEN
4219              EXISTS_TAC `affine hull voronoi_list V vl` THEN
4220              ASM_REWRITE_TAC[HULL_SUBSET; SUBSET_REFL];
4221            ALL_TAC
4222          ] THEN
4223
4224          ASM_REWRITE_TAC[] THEN
4225          DISCH_TAC THEN
4226          ONCE_ASM_REWRITE_TAC[] THEN
4227          ASM_REWRITE_TAC[INTER_ASSOC];
4228        ALL_TAC
4229      ] THEN
4230
4231      SUBGOAL_THEN `affine (A1:real^3->bool)` ASSUME_TAC THENL
4232      [
4233        REMOVE_THEN "A1" (fun th -> ALL_TAC) THEN
4234          EXPAND_TAC "A1" THEN
4235          MATCH_MP_TAC AFFINE_INTERS THEN
4236          REWRITE_TAC[IN_ELIM_THM; BIS_EQ_HYPERPLANE] THEN
4237          REPEAT STRIP_TAC THEN
4238          ASM_REWRITE_TAC[AFFINE_HYPERPLANE];
4239        ALL_TAC
4240      ] THEN
4241
4242      SUBGOAL_THEN `A1:real^3->bool = affine hull A1` (fun th -> ONCE_REWRITE_TAC[th]) THENL
4243      [
4244        MATCH_MP_TAC EQ_SYM THEN
4245          ASM_REWRITE_TAC[AFFINE_HULL_EQ];
4246        ALL_TAC
4247      ] THEN
4248
4249      MATCH_MP_TAC AFF_DIM_EQ_AFFINE_HULL THEN
4250      CONJ_TAC THENL
4251      [
4252        MATCH_MP_TAC SUBSET_TRANS THEN
4253          EXISTS_TAC `affine hull voronoi_list V ul` THEN
4254          ASM_REWRITE_TAC[HULL_SUBSET] THEN
4255          MATCH_MP_TAC SUBSET_TRANS THEN
4256          EXISTS_TAC `affine hull (voronoi_list V vl) INTER affine hull (bis (HD ul) (LAST ul))` THEN
4257          ASM_REWRITE_TAC[AFF_INTER_SUBSET_INTER_AFF] THEN
4258          SUBGOAL_THEN `affine hull bis ((HD ul):real^3) (LAST ul) = bis (HD ul) (LAST ul)` (fun th -> REWRITE_TAC[th]) THENL
4259          [
4260            REWRITE_TAC[AFFINE_HULL_EQ] THEN
4261              REWRITE_TAC[BIS_EQ_HYPERPLANE; AFFINE_HYPERPLANE];
4262            ALL_TAC
4263          ] THEN
4264
4265          ASM_REWRITE_TAC[SUBSET_REFL];
4266        ALL_TAC
4267      ] THEN
4268
4269      SUBGOAL_THEN `aff_dim (voronoi_list V ul) = &(3 - SUC k)` (fun th -> REWRITE_TAC[th]) THENL
4270      [
4271        UNDISCH_TAC `barV V (SUC k) ul` THEN
4272          REWRITE_TAC[BARV; VORONOI_NONDG] THEN
4273          STRIP_TAC THEN
4274          POP_ASSUM (MP_TAC o SPEC `ul:(real^3)list`) THEN
4275          ASM_REWRITE_TAC[INITIAL_SUBLIST_REFL; ARITH_RULE `0 < k + 2`] THEN
4276          ASM_SIMP_TAC[GSYM INT_OF_NUM_SUB] THEN
4277          REWRITE_TAC[GSYM INT_OF_NUM_ADD; ADD1] THEN
4278          INT_ARITH_TAC;
4279        ALL_TAC
4280      ] THEN
4281
4282      SUBGOAL_THEN `aff_dim (A1:real^3->bool) = aff_dim (A0:real^3->bool) - &1 \/ aff_dim A1 = -- &1` MP_TAC THENL
4283      [
4284        USE_THEN "A1" (fun th -> REWRITE_TAC[SYM th]) THEN
4285          REWRITE_TAC[BIS_EQ_HYPERPLANE] THEN
4286          ABBREV_TAC `a:real^3 = &2 % (LAST ul - HD ul)` THEN
4287          ABBREV_TAC `b = LAST ul dot LAST ul - HD ul dot HD (ul:(real^3)list)` THEN
4288          MP_TAC (ISPECL [`a:real^3`; `b:real`; `A0:real^3->bool`] AFF_DIM_AFFINE_INTER_HYPERPLANE) THEN
4289          ANTS_TAC THENL
4290          [
4291            EXPAND_TAC "A0" THEN
4292              MATCH_MP_TAC AFFINE_INTERS THEN
4293              REWRITE_TAC[IN_ELIM_THM; BIS_EQ_HYPERPLANE] THEN
4294              REPEAT STRIP_TAC THEN
4295              ASM_REWRITE_TAC[AFFINE_HYPERPLANE];
4296            ALL_TAC
4297          ] THEN
4298
4299          DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
4300          COND_CASES_TAC THEN REWRITE_TAC[] THEN
4301          COND_CASES_TAC THEN REWRITE_TAC[] THEN
4302
4303          POP_ASSUM MP_TAC THEN
4304          EXPAND_TAC "a" THEN EXPAND_TAC "b" THEN
4305          REWRITE_TAC[GSYM BIS_EQ_HYPERPLANE] THEN
4306          DISCH_TAC THEN
4307          SUBGOAL_THEN `A0 = A1:real^3->bool` MP_TAC THENL
4308          [
4309            REMOVE_THEN "A1" (fun th -> REWRITE_TAC[SYM th]) THEN
4310              POP_ASSUM MP_TAC THEN
4311              SET_TAC[];
4312            ALL_TAC
4313          ] THEN
4314          ASM_REWRITE_TAC[];
4315        ALL_TAC
4316      ] THEN
4317
4318      STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
4319      [
4320        UNDISCH_TAC `affine hull voronoi_list V vl = A0:real^3->bool` THEN
4321        DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
4322        UNDISCH_TAC `barV V k vl` THEN
4323        REWRITE_TAC[BARV; VORONOI_NONDG; AFF_DIM_AFFINE_HULL] THEN
4324        STRIP_TAC THEN
4325        POP_ASSUM (MP_TAC o SPEC `vl:(real^3)list`) THEN
4326        ASM_REWRITE_TAC[INITIAL_SUBLIST_REFL; ARITH_RULE `0 < k + 1`] THEN
4327        ASM_SIMP_TAC[GSYM INT_OF_NUM_SUB] THEN
4328        ASM_REWRITE_TAC[GSYM INT_OF_NUM_ADD; ADD1] THEN
4329        INT_ARITH_TAC;
4330        ALL_TAC
4331      ] THEN
4332
4333      ASM_SIMP_TAC[GSYM INT_OF_NUM_SUB] THEN
4334      UNDISCH_TAC `SUC k <= 3` THEN
4335      REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN
4336      INT_ARITH_TAC);;
4337
4338
4339
4340 let MHFTTZN_lemma2 = prove(`!V ul k. packing V /\ barV V k ul ==>
4341                              aff_dim (set_of_list ul) = &k /\
4342                                (!u v. u IN affine hull voronoi_list V ul /\ v IN affine hull (set_of_list ul)
4343                                   ==> (u - circumcenter (set_of_list ul)) dot (v - circumcenter (set_of_list ul)) = &0)`,
4344    REPEAT GEN_TAC THEN
4345      SPEC_TAC (`ul:(real^3)list`, `ul:(real^3)list`) THEN
4346      SPEC_TAC (`k:num`, `k:num`) THEN
4347      INDUCT_TAC THENL
4348      [
4349        REWRITE_TAC[BARV; ARITH] THEN
4350          GEN_TAC THEN STRIP_TAC THEN
4351          MP_TAC (ISPEC `ul:(real^3)list` LENGTH_1_LEMMA) THEN
4352          ASM_REWRITE_TAC[] THEN
4353          DISCH_THEN (fun th -> ONCE_REWRITE_TAC[th]) THEN
4354          REWRITE_TAC[set_of_list; CIRCUMCENTER_1; AFFINE_HULL_SING; IN_SING] THEN
4355          SIMP_TAC[AFF_DIM_SING; VECTOR_SUB_REFL; DOT_RZERO];
4356        ALL_TAC
4357      ] THEN
4358
4359      GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN
4360      SUBGOAL_THEN `SUC k <= 3` ASSUME_TAC THENL
4361      [
4362        MATCH_MP_TAC BARV_IMP_K_LE_3 THEN
4363          MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `ul:(real^3)list`] THEN
4364          ASM_REWRITE_TAC[];
4365        ALL_TAC
4366      ] THEN
4367
4368      ABBREV_TAC `vl:(real^3)list = BUTLAST ul` THEN
4369      POP_ASSUM (LABEL_TAC "vl") THEN
4370
4371      SUBGOAL_THEN `LENGTH (ul:(real^3)list) = k + 2` ASSUME_TAC THENL
4372      [
4373        UNDISCH_TAC `barV V (SUC k) ul` THEN
4374          REWRITE_TAC[BARV] THEN
4375          ARITH_TAC;
4376        ALL_TAC
4377      ] THEN
4378
4379      SUBGOAL_THEN `truncate_simplex k (ul:(real^3)list) = vl` (LABEL_TAC "vl2") THENL
4380      [
4381        MP_TAC (ISPEC `ul:(real^3)list` TRUNCATE_SIMPLEX_EQ_BUTLAST) THEN
4382          ASM_REWRITE_TAC[ARITH_RULE `2 <= k + 2`; ARITH_RULE `(k + 2) - 2 = k`];
4383        ALL_TAC
4384      ] THEN
4385
4386      SUBGOAL_THEN `barV V k vl` ASSUME_TAC THENL
4387      [
4388        REMOVE_THEN "vl2" (fun th -> REWRITE_TAC[SYM th]) THEN
4389          MATCH_MP_TAC TRUNCATE_SIMPLEX_BARV THEN
4390          EXISTS_TAC `SUC k` THEN
4391          ASM_SIMP_TAC[ARITH_RULE `k <= SUC k`];
4392        ALL_TAC
4393      ] THEN
4394
4395      FIRST_X_ASSUM (MP_TAC o SPEC `vl:(real^3)list`) THEN
4396      ANTS_TAC THENL
4397      [
4398        ASM_SIMP_TAC[ARITH_RULE `SUC k <= 3 ==> k <= 3`];
4399        ALL_TAC
4400      ] THEN
4401
4402      SUBGOAL_THEN `HD vl = (HD ul):real^3` ASSUME_TAC THENL
4403      [
4404        EXPAND_TAC "vl" THEN
4405          MATCH_MP_TAC HD_TRUNCATE_SIMPLEX THEN
4406          UNDISCH_TAC `barV V (SUC k) ul` THEN
4407          REWRITE_TAC[BARV] THEN
4408          ARITH_TAC;
4409        ALL_TAC
4410      ] THEN
4411
4412      DISCH_THEN STRIP_ASSUME_TAC THEN
4413      SUBGOAL_THEN `aff_dim (set_of_list (ul:(real^3)list)) = &(SUC k)` ASSUME_TAC THENL
4414      [
4415        ASM_CASES_TAC `&(SUC k) <= aff_dim (set_of_list (ul:(real^3)list))` THENL
4416          [
4417            MP_TAC (ISPEC `set_of_list (ul:(real^3)list)` AFF_DIM_LE_CARD) THEN
4418              REWRITE_TAC[FINITE_SET_OF_LIST] THEN
4419              MP_TAC (ISPEC `ul:(real^3)list` CARD_SET_OF_LIST_LE) THEN
4420              POP_ASSUM MP_TAC THEN
4421              ASM_REWRITE_TAC[GSYM INT_OF_NUM_LE; GSYM INT_OF_NUM_ADD; ADD1] THEN
4422              INT_ARITH_TAC;
4423            ALL_TAC
4424          ] THEN
4425
4426          POP_ASSUM MP_TAC THEN REWRITE_TAC[INT_NOT_LE] THEN DISCH_TAC THEN
4427          SUBGOAL_THEN `set_of_list ul = (LAST ul) INSERT (set_of_list vl):real^3->bool` ASSUME_TAC THENL
4428          [
4429            MP_TAC (ISPEC `ul:(real^3)list` APPEND_BUTLAST_LAST) THEN
4430              ASM_REWRITE_TAC[GSYM LENGTH_EQ_NIL; ARITH_RULE `~(k + 2 = 0)`] THEN
4431              DISCH_THEN (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN
4432              REWRITE_TAC[SET_OF_LIST_APPEND; set_of_list] THEN
4433              REWRITE_TAC[EXTENSION; IN_UNION; IN_INSERT; NOT_IN_EMPTY; DISJ_SYM];
4434            ALL_TAC
4435          ] THEN
4436
4437          SUBGOAL_THEN `LAST ul IN affine hull (set_of_list vl):real^3->bool` ASSUME_TAC THENL
4438          [
4439            UNDISCH_TAC `aff_dim (set_of_list (ul:(real^3)list)) < &(SUC k)` THEN
4440              ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
4441              DISCH_TAC THEN
4442              MP_TAC (ISPECL [`LAST ul:real^3`; `set_of_list vl:real^3->bool`] AFF_DIM_INSERT) THEN
4443              ASM_REWRITE_TAC[ADD1; GSYM INT_OF_NUM_ADD] THEN
4444              INT_ARITH_TAC;
4445            ALL_TAC
4446          ] THEN
4447
4448          ABBREV_TAC `y:real^3 = LAST ul` THEN
4449          ABBREV_TAC `q:real^3 = circumcenter (set_of_list vl)` THEN
4450
4451          SUBGOAL_THEN `affine hull voronoi_list V vl SUBSET affine hull voronoi_list V ul` MP_TAC THENL
4452          [
4453            SUBGOAL_THEN `!p. p IN affine hull voronoi_list V vl ==> (p - q) dot (y - q) = &0` ASSUME_TAC THENL
4454                [
4455                  REPEAT STRIP_TAC THEN
4456                    FIRST_X_ASSUM MATCH_MP_TAC THEN
4457                    ASM_REWRITE_TAC[];
4458                  ALL_TAC
4459                ] THEN
4460
4461                SUBGOAL_THEN `!p. p IN affine hull voronoi_list V vl ==> &2 * ((y - HD ul) dot q) = &2 * ((y - HD ul) dot p:real^3)` ASSUME_TAC THENL
4462                [
4463                  REPEAT STRIP_TAC THEN
4464                    AP_TERM_TAC THEN
4465                    ONCE_REWRITE_TAC[REAL_ARITH `a = b <=> b - a = &0`] THEN
4466                    REWRITE_TAC[GSYM DOT_RSUB] THEN
4467                    GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [VECTOR_ARITH `y - u0:real^3 = (y - q) - (u0 - q)`] THEN
4468                    ONCE_REWRITE_TAC[DOT_LSUB] THEN
4469                    ASM_SIMP_TAC[DOT_SYM; REAL_ARITH `&0 - x = &0 <=> x = &0`] THEN
4470                    FIRST_X_ASSUM MATCH_MP_TAC THEN
4471                    ASM_REWRITE_TAC[] THEN
4472                    MATCH_MP_TAC IN_TRANS THEN
4473                    EXISTS_TAC `set_of_list vl:real^3->bool` THEN
4474                    REWRITE_TAC[HULL_SUBSET; IN_SET_OF_LIST] THEN
4475                    UNDISCH_TAC `HD vl = HD ul:real^3` THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
4476                    ONCE_REWRITE_TAC[GSYM EL] THEN
4477                    MATCH_MP_TAC MEM_EL THEN
4478                    UNDISCH_TAC `barV V k vl` THEN
4479                    REWRITE_TAC[BARV] THEN
4480                    ARITH_TAC;
4481                  ALL_TAC
4482                ] THEN
4483
4484                SUBGOAL_THEN `?w. w IN affine hull voronoi_list V ul` CHOOSE_TAC THENL
4485                [
4486                  REWRITE_TAC[MEMBER_NOT_EMPTY; AFFINE_HULL_EQ_EMPTY] THEN
4487                    DISCH_TAC THEN
4488                    UNDISCH_TAC `barV V (SUC k) ul` THEN
4489                    REWRITE_TAC[BARV; VORONOI_NONDG] THEN
4490                    STRIP_TAC THEN
4491                    POP_ASSUM (MP_TAC o SPEC `ul:(real^3)list`) THEN
4492                    ASM_REWRITE_TAC[INITIAL_SUBLIST_REFL; ARITH_RULE `0 < k + 2`; AFF_DIM_EMPTY; DE_MORGAN_THM] THEN
4493                    DISJ2_TAC THEN DISJ2_TAC THEN
4494                    UNDISCH_TAC `SUC k <= 3` THEN
4495                    REWRITE_TAC[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_LE; ADD1] THEN
4496                    INT_ARITH_TAC;
4497                  ALL_TAC
4498                ] THEN
4499
4500                SUBGOAL_THEN `affine hull voronoi_list V ul = affine hull voronoi_list V vl INTER bis (HD ul) y` ASSUME_TAC THENL
4501                [
4502                  MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `SUC k`] MHFTTZN_lemma) THEN
4503                    MP_TAC (SPECL [`V:real^3->bool`; `vl:(real^3)list`; `k:num`] MHFTTZN_lemma) THEN
4504                    ASM_SIMP_TAC[ARITH_RULE `SUC k <= 3 ==> k <= 3`] THEN
4505                    REPEAT DISCH_TAC THEN
4506                    SET_TAC[];
4507                  ALL_TAC
4508                ] THEN
4509
4510                ASM_REWRITE_TAC[SUBSET_INTER; SUBSET_REFL; SUBSET] THEN
4511                REPEAT STRIP_TAC THEN
4512                ASM_REWRITE_TAC[IN_INTER] THEN
4513                REWRITE_TAC[BIS_EQ_HYPERPLANE; IN_ELIM_THM] THEN
4514                MATCH_MP_TAC EQ_TRANS THEN
4515                EXISTS_TAC `&2 % ((y:real^3) - HD ul) dot q` THEN
4516                CONJ_TAC THENL
4517                [
4518                  MATCH_MP_TAC EQ_SYM THEN
4519                    REWRITE_TAC[DOT_LMUL] THEN
4520                    FIRST_X_ASSUM MATCH_MP_TAC THEN
4521                    ASM_REWRITE_TAC[];
4522                  ALL_TAC
4523                ] THEN
4524
4525                MATCH_MP_TAC EQ_TRANS THEN
4526                EXISTS_TAC `&2 % ((y:real^3) - HD ul) dot w` THEN
4527                CONJ_TAC THENL
4528                [
4529                  REWRITE_TAC[DOT_LMUL] THEN
4530                    FIRST_X_ASSUM MATCH_MP_TAC THEN
4531                    UNDISCH_TAC `w:real^3 IN affine hull voronoi_list V ul` THEN
4532                    ASM_SIMP_TAC[IN_INTER];
4533                  ALL_TAC
4534                ] THEN
4535
4536                UNDISCH_TAC `w:real^3 IN affine hull voronoi_list V ul` THEN
4537                ASM_SIMP_TAC[IN_INTER; BIS_EQ_HYPERPLANE; IN_ELIM_THM];
4538            ALL_TAC
4539          ] THEN
4540
4541          DISCH_THEN (MP_TAC o MATCH_MP AFF_DIM_SUBSET) THEN
4542          UNDISCH_TAC `barV V (SUC k) ul` THEN
4543          UNDISCH_TAC `barV V k vl` THEN
4544          REWRITE_TAC[BARV; VORONOI_NONDG] THEN
4545          REPEAT STRIP_TAC THEN
4546          POP_ASSUM MP_TAC THEN
4547          POP_ASSUM (MP_TAC o SPEC `ul:(real^3)list`) THEN
4548          POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN
4549          POP_ASSUM (MP_TAC o SPEC `vl:(real^3)list`) THEN
4550          POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN
4551
4552          REWRITE_TAC[INITIAL_SUBLIST_REFL; ARITH_RULE `0 < k + 1 /\ 0 < SUC k + 1`] THEN
4553          STRIP_TAC THEN STRIP_TAC THEN
4554          POP_ASSUM MP_TAC THEN REMOVE_ASSUM THEN REMOVE_ASSUM THEN POP_ASSUM MP_TAC THEN
4555          REWRITE_TAC[GSYM INT_OF_NUM_ADD; ADD1] THEN
4556          REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN
4557          INT_ARITH_TAC;
4558        ALL_TAC
4559      ] THEN
4560
4561      ASM_REWRITE_TAC[] THEN
4562      REPEAT STRIP_TAC THEN
4563
4564      ABBREV_TAC `q:real^3 = circumcenter (set_of_list ul)` THEN
4565      ABBREV_TAC `S:real^3->bool = affine hull set_of_list ul` THEN
4566
4567      SUBGOAL_THEN `CARD (set_of_list (ul:(real^3)list)) = k + 2` ASSUME_TAC THENL
4568      [
4569        SUBGOAL_THEN `CARD (set_of_list (ul:(real^3)list)) <= k + 2` MP_TAC THENL
4570          [
4571            MATCH_MP_TAC LE_TRANS THEN
4572              EXISTS_TAC `LENGTH (ul:(real^3)list)` THEN
4573              REWRITE_TAC[CARD_SET_OF_LIST_LE] THEN
4574              ASM_REWRITE_TAC[LE_REFL];
4575            ALL_TAC
4576          ] THEN
4577          MP_TAC (ISPEC `set_of_list (ul:(real^3)list)` AFF_DIM_LE_CARD) THEN
4578          ASM_REWRITE_TAC[FINITE_SET_OF_LIST] THEN
4579          REWRITE_TAC[GSYM INT_OF_NUM_ADD; ADD1; GSYM INT_OF_NUM_LE; GSYM INT_OF_NUM_EQ] THEN
4580          INT_ARITH_TAC;
4581        ALL_TAC
4582      ] THEN
4583
4584      SUBGOAL_THEN `~affine_dependent (set_of_list ul:real^3->bool)` ASSUME_TAC THENL
4585      [
4586        ASM_REWRITE_TAC[AFFINE_INDEPENDENT_IFF_CARD; FINITE_SET_OF_LIST] THEN
4587          REWRITE_TAC[GSYM INT_OF_NUM_ADD; ADD1] THEN
4588          INT_ARITH_TAC;
4589        ALL_TAC
4590      ] THEN
4591
4592      MP_TAC (ISPEC `set_of_list ul:real^3->bool` OAPVION1) THEN
4593      MP_TAC (ISPEC `set_of_list ul:real^3->bool` OAPVION2) THEN
4594      ASM_REWRITE_TAC[] THEN
4595      DISCH_TAC THEN
4596      ANTS_TAC THENL
4597      [
4598        ASM_REWRITE_TAC[SET_OF_LIST_EQ_EMPTY; GSYM LENGTH_EQ_NIL] THEN
4599          ARITH_TAC;
4600        ALL_TAC
4601      ] THEN
4602      DISCH_TAC THEN
4603
4604      SUBGOAL_THEN `IMAGE (\x:real^3. x - q) S = span {y - HD ul | y | y IN set_of_list ul}` ASSUME_TAC THENL
4605      [
4606        MATCH_MP_TAC EQ_TRANS THEN
4607          EXISTS_TAC `span {y - q | y | y:real^3 IN set_of_list ul}` THEN
4608          SUBGOAL_THEN `IMAGE (\x. x - q) S = span {y - q:real^3 | y IN set_of_list ul}` ASSUME_TAC THENL
4609          [
4610            EXPAND_TAC "S" THEN
4611              SUBGOAL_THEN `affine hull set_of_list ul = affine hull (q:real^3 INSERT set_of_list ul)` (fun th -> REWRITE_TAC[th]) THENL
4612              [
4613                MATCH_MP_TAC AFFINE_HULLS_EQ THEN
4614                  CONJ_TAC THENL
4615                  [
4616                    MATCH_MP_TAC SUBSET_TRANS THEN
4617                      EXISTS_TAC `q:real^3 INSERT set_of_list ul` THEN
4618                      REWRITE_TAC[HULL_SUBSET] THEN
4619                      SIMP_TAC[SUBSET; IN_INSERT];
4620                    ALL_TAC
4621                  ] THEN
4622                  REWRITE_TAC[SUBSET; IN_INSERT] THEN
4623                  REPEAT STRIP_TAC THENL
4624                  [
4625                    ASM_REWRITE_TAC[];
4626                    ALL_TAC
4627                  ] THEN
4628                  MATCH_MP_TAC IN_TRANS THEN
4629                  EXISTS_TAC `set_of_list ul:real^3->bool` THEN
4630                  ASM_REWRITE_TAC[HULL_SUBSET];
4631                ALL_TAC
4632              ] THEN
4633
4634
4635              SUBGOAL_THEN `span {y - q | y | y IN set_of_list ul} = span {y - q:real^3 | y | y IN (q INSERT set_of_list ul)}` (fun th -> REWRITE_TAC[th]) THENL
4636              [
4637                SUBGOAL_THEN `{y - q:real^3 | y | y IN q INSERT set_of_list ul} = vec 0 INSERT {y - q | y IN set_of_list ul}` (fun th -> REWRITE_TAC[th]) THENL
4638                  [
4639                    REWRITE_TAC[EXTENSION; IN_INSERT; IN_ELIM_THM] THEN
4640                      GEN_TAC THEN EQ_TAC THENL
4641                      [
4642                        REPEAT STRIP_TAC THENL
4643                          [
4644                            ASM_REWRITE_TAC[VECTOR_SUB_REFL];
4645                            ALL_TAC
4646                          ] THEN
4647                          DISJ2_TAC THEN
4648                          EXISTS_TAC `y:real^3` THEN
4649                          ASM_REWRITE_TAC[];
4650                        ALL_TAC
4651                      ] THEN
4652
4653                      REPEAT STRIP_TAC THENL
4654                      [
4655                        EXISTS_TAC `q:real^3` THEN
4656                          ASM_REWRITE_TAC[VECTOR_SUB_REFL];
4657                        ALL_TAC
4658                      ] THEN
4659
4660                      EXISTS_TAC `y:real^3` THEN
4661                      ASM_REWRITE_TAC[];
4662                    ALL_TAC
4663                  ] THEN
4664
4665                  REWRITE_TAC[SPAN_INSERT_0];
4666                ALL_TAC
4667              ] THEN
4668
4669              MP_TAC (ISPECL [`q:real^3`; `q:real^3 INSERT set_of_list ul`] DIFFS_AFFINE_HULL_SPAN) THEN
4670              ANTS_TAC THENL
4671              [
4672                REWRITE_TAC[IN_INSERT];
4673                ALL_TAC
4674              ] THEN
4675
4676              DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
4677              REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; CONJ_SYM];
4678            ALL_TAC
4679          ] THEN
4680
4681
4682          ASM_REWRITE_TAC[] THEN
4683          GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM SPAN_SPAN] THEN
4684          MATCH_MP_TAC EQ_SYM THEN
4685          MATCH_MP_TAC DIM_EQ_SPAN THEN
4686          CONJ_TAC THENL
4687          [
4688            REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
4689              REPEAT STRIP_TAC THEN
4690              ASM_REWRITE_TAC[] THEN
4691              GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [VECTOR_ARITH `y - u = (y - q) - (u - q):real^3`] THEN
4692              MATCH_MP_TAC SPAN_SUB THEN
4693              CONJ_TAC THEN MATCH_MP_TAC IN_TRANS THEN EXISTS_TAC `{y - q:real^3 | y IN set_of_list ul}` THEN REWRITE_TAC[span; HULL_SUBSET; IN_ELIM_THM] THENL
4694              [
4695                EXISTS_TAC `y:real^3` THEN
4696                  ASM_REWRITE_TAC[];
4697                ALL_TAC
4698              ] THEN
4699
4700              EXISTS_TAC `HD ul:real^3` THEN
4701              REWRITE_TAC[] THEN
4702              MATCH_MP_TAC HD_IN_SET_OF_LIST THEN
4703              ASM_REWRITE_TAC[ARITH_RULE `1 <= k + 2`];
4704            ALL_TAC
4705          ] THEN
4706
4707          SUBGOAL_THEN `dim (span {y - q:real^3 | y IN set_of_list ul}) = k + 1` (fun th -> REWRITE_TAC[th]) THENL
4708          [
4709            REWRITE_TAC[GSYM INT_OF_NUM_EQ] THEN
4710              MATCH_MP_TAC EQ_TRANS THEN
4711              EXISTS_TAC `aff_dim (span {y - q:real^3 | y IN set_of_list ul})` THEN
4712              CONJ_TAC THENL
4713              [
4714                MATCH_MP_TAC (GSYM AFF_DIM_DIM_0) THEN
4715                  POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
4716                  MATCH_MP_TAC IN_TRANS THEN
4717                  EXISTS_TAC `IMAGE (\x:real^3. x - q) S` THEN
4718                  REWRITE_TAC[HULL_SUBSET; IN_IMAGE] THEN
4719                  EXISTS_TAC `q:real^3` THEN
4720                  ASM_REWRITE_TAC[VECTOR_SUB_REFL];
4721                ALL_TAC
4722              ] THEN
4723
4724              POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
4725              REWRITE_TAC[VECTOR_ARITH `x - q = --q + x:real^3`] THEN
4726              REWRITE_TAC[AFF_DIM_TRANSLATION_EQ] THEN
4727              EXPAND_TAC "S" THEN
4728              REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN
4729              ASM_REWRITE_TAC[ADD1];
4730            ALL_TAC
4731          ] THEN
4732
4733          MATCH_MP_TAC LE_TRANS THEN
4734          EXISTS_TAC `dim {y - HD ul:real^3 | y | y IN set_of_list ul DELETE HD ul}` THEN
4735          CONJ_TAC THENL
4736          [
4737            MATCH_MP_TAC (ARITH_RULE `a = k + 1 ==> k + 1 <= a`) THEN
4738              SUBGOAL_THEN `k + 1 = CARD ({y - HD ul:real^3 | y | y IN set_of_list ul DELETE HD ul})` (fun th -> REWRITE_TAC[th]) THENL
4739              [
4740                MATCH_MP_TAC EQ_TRANS THEN
4741                  EXISTS_TAC `CARD (set_of_list ul DELETE ((HD ul):real^3))` THEN
4742                  CONJ_TAC THENL
4743                  [
4744                    ASM_SIMP_TAC[FINITE_SET_OF_LIST; CARD_DELETE] THEN
4745                      MP_TAC (ISPEC `ul:(real^3)list` HD_IN_SET_OF_LIST) THEN
4746                      ASM_REWRITE_TAC[ARITH_RULE `1 <= k + 2`] THEN
4747                      DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
4748                      ARITH_TAC;
4749                    ALL_TAC
4750                  ] THEN
4751
4752                  ONCE_REWRITE_TAC[GSYM IMAGE_LEMMA] THEN
4753                  MATCH_MP_TAC (GSYM CARD_IMAGE_INJ) THEN
4754                  CONJ_TAC THENL
4755                  [
4756                    BETA_TAC THEN
4757                      SIMP_TAC[VECTOR_ARITH `y - u = x - u <=> y = x:real^3`];
4758                    ALL_TAC
4759                  ] THEN
4760
4761                  MATCH_MP_TAC FINITE_SUBSET THEN
4762                  EXISTS_TAC `set_of_list ul:real^3->bool` THEN
4763                  REWRITE_TAC[FINITE_SET_OF_LIST; DELETE_SUBSET];
4764                ALL_TAC
4765              ] THEN
4766
4767              MATCH_MP_TAC DIM_EQ_CARD THEN
4768              MP_TAC (ISPEC `set_of_list ul:real^3->bool` AFFINE_INDEPENDENT_IMP_INDEPENDENT) THEN
4769              ASM_REWRITE_TAC[] THEN
4770              DISCH_THEN MATCH_MP_TAC THEN
4771              MATCH_MP_TAC HD_IN_SET_OF_LIST THEN
4772              ASM_REWRITE_TAC[ARITH_RULE `1 <= k + 2`];
4773            ALL_TAC
4774          ] THEN
4775
4776          MATCH_MP_TAC DIM_SUBSET THEN
4777          SIMP_TAC[SUBSET; IN_ELIM_THM; IN_DELETE] THEN
4778          REPEAT STRIP_TAC THEN
4779          EXISTS_TAC `y:real^3` THEN
4780          ASM_REWRITE_TAC[];
4781        ALL_TAC
4782      ] THEN
4783
4784      ABBREV_TAC `w = v - q:real^3` THEN
4785      SUBGOAL_THEN `w IN span {y - HD ul | y | y:real^3 IN set_of_list ul}` MP_TAC THENL
4786      [
4787        POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
4788          POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
4789          REWRITE_TAC[IN_IMAGE] THEN
4790          EXISTS_TAC `v:real^3` THEN
4791          ASM_REWRITE_TAC[];
4792        ALL_TAC
4793      ] THEN
4794
4795      REMOVE_ASSUM THEN
4796      SPEC_TAC (`w:real^3`, `w:real^3`) THEN
4797      REWRITE_TAC[GSYM orthogonal] THEN
4798      MATCH_MP_TAC ORTHOGONAL_TO_SPAN THEN
4799
4800      REWRITE_TAC[IN_ELIM_THM] THEN
4801      REPEAT STRIP_TAC THEN
4802      POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN
4803
4804      REWRITE_TAC[orthogonal] THEN
4805      SUBGOAL_THEN `&0 = (norm (u - HD ul:real^3) pow 2 - norm (u - y) pow 2) / &2` (fun th -> REWRITE_TAC[th]) THENL
4806      [
4807        REWRITE_TAC[REAL_ARITH `&0 = (a - b) / &2 <=> a = b`] THEN
4808          REWRITE_TAC[GSYM dist; GSYM DIST_EQ] THEN
4809          MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `SUC k`] MHFTTZN_lemma) THEN
4810          ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
4811          UNDISCH_TAC `u IN affine hull voronoi_list V ul` THEN
4812          ASM_REWRITE_TAC[IN_INTERS; IN_ELIM_THM] THEN
4813          DISCH_THEN (MP_TAC o SPEC `bis (HD ul) (y:real^3)`) THEN
4814          ANTS_TAC THENL
4815          [
4816            EXISTS_TAC `y:real^3` THEN
4817              ASM_REWRITE_TAC[];
4818            ALL_TAC
4819          ] THEN
4820          REWRITE_TAC[bis; IN_ELIM_THM];
4821        ALL_TAC
4822      ] THEN
4823
4824      GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [VECTOR_ARITH `u - x:real^3 = (u - q) - (x - q)`] THEN
4825      REWRITE_TAC[NORM_POW_2] THEN
4826      ONCE_REWRITE_TAC[DOT_LSUB] THEN
4827      ONCE_REWRITE_TAC[DOT_RSUB] THEN
4828      REWRITE_TAC[DOT_SQUARE_NORM; DOT_SYM] THEN
4829      REWRITE_TAC[REAL_ARITH `uq - a - (a - u0q) - (uq - b - (b - yq)) = &2 * (b - a) + (u0q - yq)`] THEN
4830
4831      SUBGOAL_THEN `norm (HD ul - q:real^3) pow 2 - norm (y - q) pow 2 = &0` (fun th -> REWRITE_TAC[th]) THENL
4832      [
4833        REWRITE_TAC[REAL_ARITH `a - b = &0 <=> a = b`] THEN
4834          REWRITE_TAC[GSYM dist; GSYM DIST_EQ] THEN
4835          MATCH_MP_TAC EQ_TRANS THEN
4836          EXISTS_TAC `radV (set_of_list ul:real^3->bool)` THEN
4837          CONJ_TAC THENL
4838          [
4839            MATCH_MP_TAC EQ_SYM THEN
4840              REWRITE_TAC[DIST_SYM] THEN
4841              FIRST_X_ASSUM MATCH_MP_TAC THEN
4842              MATCH_MP_TAC HD_IN_SET_OF_LIST THEN
4843              ASM_REWRITE_TAC[ARITH_RULE `1 <= k + 2`];
4844            ALL_TAC
4845          ] THEN
4846
4847          REWRITE_TAC[DIST_SYM] THEN
4848          FIRST_X_ASSUM MATCH_MP_TAC THEN
4849          ASM_REWRITE_TAC[];
4850        ALL_TAC
4851      ] THEN
4852
4853      REWRITE_TAC[GSYM DOT_RSUB] THEN
4854      REWRITE_TAC[VECTOR_ARITH `y - q - (u0 - q):real^3 = y - u0`] THEN
4855      REWRITE_TAC[GSYM DOT_LSUB] THEN
4856      REAL_ARITH_TAC);;
4857
4858
4859
4860 (* MHFTTZN1 *)
4861
4862 let MHFTTZN1 = prove(`!V ul k.  packing V /\ barV V k ul ==>
4863                       aff_dim (set_of_list ul) = &k`,
4864    REPEAT STRIP_TAC THEN
4865      MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `k:num`] MHFTTZN_lemma2) THEN
4866      ASM_SIMP_TAC[]);;
4867
4868
4869 (* MHFTTZN2 *)
4870
4871 let MHFTTZN2 = prove(`!V ul k.  packing V /\ barV V k ul ==>
4872    (!p. p IN   affine hull voronoi_list V ul <=> (!u.  (u IN set_of_list ul  ==> p IN bis (HD ul) u)))`,
4873    REPEAT GEN_TAC THEN
4874      DISCH_THEN (MP_TAC o MATCH_MP MHFTTZN_lemma) THEN
4875      REWRITE_TAC[EXTENSION; IN_INTERS; IN_ELIM_THM] THEN
4876      SET_TAC[]);;
4877
4878
4879 (* MHFTTZN3 *)
4880
4881 let MHFTTZN3 = prove(`!V ul k. packing V /\ barV V k ul ==>
4882    ((affine hull (voronoi_list V ul)) INTER (affine hull (set_of_list ul)) =
4883    { circumcenter (set_of_list ul) } )`,
4884    REPEAT GEN_TAC THEN
4885      DISCH_TAC THEN
4886      FIRST_ASSUM (MP_TAC o MATCH_MP MHFTTZN_lemma) THEN
4887      FIRST_ASSUM (MP_TAC o MATCH_MP MHFTTZN_lemma2) THEN
4888      DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC (fun th -> ALL_TAC)) THEN
4889      DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
4890      REWRITE_TAC[EXTENSION; IN_SING] THEN
4891      GEN_TAC THEN
4892
4893      SUBGOAL_THEN `LENGTH (ul:(real^3)list) = k + 1` ASSUME_TAC THENL
4894      [
4895        REMOVE_ASSUM THEN POP_ASSUM MP_TAC THEN
4896          SIMP_TAC[BARV];
4897        ALL_TAC
4898      ] THEN
4899
4900      SUBGOAL_THEN `HD ul:real^3 IN set_of_list ul` ASSUME_TAC THENL
4901      [
4902        MATCH_MP_TAC HD_IN_SET_OF_LIST THEN
4903          ASM_REWRITE_TAC[ARITH_RULE `1 <= k + 1`];
4904        ALL_TAC
4905      ] THEN
4906
4907      SUBGOAL_THEN `CARD (set_of_list (ul:(real^3)list)) = k + 1` ASSUME_TAC THENL
4908      [
4909        SUBGOAL_THEN `CARD (set_of_list (ul:(real^3)list)) <= k + 1` MP_TAC THENL
4910          [
4911            MATCH_MP_TAC LE_TRANS THEN
4912              EXISTS_TAC `LENGTH (ul:(real^3)list)` THEN
4913              ASM_REWRITE_TAC[CARD_SET_OF_LIST_LE; LE_REFL];
4914            ALL_TAC
4915          ] THEN
4916          MP_TAC (ISPEC `set_of_list (ul:(real^3)list)` AFF_DIM_LE_CARD) THEN
4917          ASM_REWRITE_TAC[FINITE_SET_OF_LIST] THEN
4918          REWRITE_TAC[GSYM INT_OF_NUM_ADD; ADD1; GSYM INT_OF_NUM_LE; GSYM INT_OF_NUM_EQ] THEN
4919          INT_ARITH_TAC;
4920        ALL_TAC
4921      ] THEN
4922
4923      SUBGOAL_THEN `~affine_dependent (set_of_list ul:real^3->bool)` ASSUME_TAC THENL
4924      [
4925        ASM_REWRITE_TAC[AFFINE_INDEPENDENT_IFF_CARD; FINITE_SET_OF_LIST] THEN
4926          REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN
4927          INT_ARITH_TAC;
4928        ALL_TAC
4929      ] THEN
4930
4931      REWRITE_TAC[IN_INTER; IN_INTERS; IN_ELIM_THM] THEN
4932      EQ_TAC THENL
4933      [
4934        REPEAT STRIP_TAC THEN
4935          MP_TAC (ISPEC `set_of_list ul:real^3->bool` OAPVION3) THEN
4936          ASM_REWRITE_TAC[] THEN
4937          DISCH_THEN MATCH_MP_TAC THEN
4938          ASM_REWRITE_TAC[] THEN
4939          EXISTS_TAC `dist (x, HD ul:real^3)` THEN
4940          REPEAT STRIP_TAC THEN
4941          FIRST_X_ASSUM (MP_TAC o SPEC `bis (HD ul) (w:real^3)`) THEN
4942          ANTS_TAC THENL
4943          [
4944            EXISTS_TAC `w:real^3` THEN
4945              ASM_REWRITE_TAC[];
4946            ALL_TAC
4947          ] THEN
4948
4949          SIMP_TAC[bis; IN_ELIM_THM];
4950        ALL_TAC
4951      ] THEN
4952
4953      SUBGOAL_THEN `~(set_of_list ul = {}:real^3->bool)` ASSUME_TAC THENL
4954      [
4955        REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
4956          EXISTS_TAC `HD ul:real^3` THEN
4957          ASM_REWRITE_TAC[];
4958        ALL_TAC
4959      ] THEN
4960
4961      ASM_SIMP_TAC[OAPVION1] THEN
4962      REPEAT STRIP_TAC THEN
4963      POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN
4964      REWRITE_TAC[bis; IN_ELIM_THM] THEN
4965      MATCH_MP_TAC EQ_TRANS THEN
4966      EXISTS_TAC `radV (set_of_list ul:real^3->bool)` THEN
4967      MP_TAC (ISPEC `set_of_list ul:real^3->bool` OAPVION2) THEN
4968      ASM_REWRITE_TAC[DIST_SYM] THEN
4969      DISCH_TAC THEN
4970
4971      CONJ_TAC THENL
4972      [
4973        MATCH_MP_TAC EQ_SYM THEN
4974          FIRST_X_ASSUM MATCH_MP_TAC THEN
4975          ASM_REWRITE_TAC[];
4976        ALL_TAC
4977      ] THEN
4978
4979      FIRST_X_ASSUM MATCH_MP_TAC THEN
4980      ASM_REWRITE_TAC[]);;
4981
4982
4983 (* MHFTTZN4 *)
4984
4985 let MHFTTZN4 = prove(`!V ul k u v. packing V /\ barV V k ul /\
4986   u IN affine hull voronoi_list V ul /\ v IN affine hull (set_of_list ul) ==>
4987    ((u - circumcenter (set_of_list ul)) dot (v - circumcenter (set_of_list ul)) = &0)`,
4988    REPEAT STRIP_TAC THEN
4989      MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `k:num`] MHFTTZN_lemma2) THEN
4990      ASM_REWRITE_TAC[] THEN
4991      REPEAT STRIP_TAC THEN
4992      FIRST_X_ASSUM MATCH_MP_TAC THEN
4993      ASM_REWRITE_TAC[]);;
4994
4995
4996 (*****************************************)
4997
4998 (***********)
4999 (* XYOFCGX *)
5000 (***********)
5001
5002
5003 let ARCV_GT_PI2 = prove(`!p u v:real^N. pi / &2 < arcV p u v <=> cos(arcV p u v) < &0`,
5004    REPEAT GEN_TAC THEN
5005      EQ_TAC THENL
5006      [
5007        DISCH_TAC THEN
5008          REWRITE_TAC[GSYM COS_PI2] THEN
5009          MATCH_MP_TAC COS_MONO_LT THEN
5010          ASM_REWRITE_TAC[ARCV_ANGLE; ANGLE_RANGE] THEN
5011          MP_TAC PI_POS THEN REAL_ARITH_TAC;
5012        ALL_TAC
5013      ] THEN
5014      ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
5015      REWRITE_TAC[REAL_NOT_LT; REAL_NOT_LE] THEN
5016      DISCH_TAC THEN
5017      MATCH_MP_TAC COS_POS_PI_LE THEN
5018      ASM_SIMP_TAC[ARCV_ANGLE; PI_POS; ANGLE_RANGE; REAL_ARITH `&0 < pi /\ &0 <= x ==> --(pi / &2) <= x`]);;
5019
5020
5021
5022 let XYOFCGX_lemma0 = prove(`!V S p w. packing V /\ S SUBSET V /\ ~affine_dependent S /\
5023                              (p = circumcenter S) /\ (radV S < sqrt(&2)) /\
5024                              w IN V DIFF S /\ dist (p,w) <= radV S /\ 1 < CARD S
5025                              ==> (!u. u IN S ==> pi / &2 < arcV p w u) /\
5026                                  (!u v. u IN S /\ v IN S /\ ~(u = v) ==> pi / &2 < arcV p u v)`,
5027    REPEAT GEN_TAC THEN
5028      REWRITE_TAC[packing; ARCV_GT_PI2] THEN
5029      DISCH_THEN STRIP_ASSUME_TAC THEN
5030      SUBGOAL_THEN `!p u w:real^3. ~(p = u) /\ ~(p = w) /\ dist (p,u) < sqrt(&2) /\ dist (p,w) < sqrt(&2) /\ &2 <= dist(u,w) ==> cos(arcV p u w) < &0` ASSUME_TAC THENL
5031      [
5032        REPEAT STRIP_TAC THEN
5033          REWRITE_TAC[ARCV_ANGLE] THEN
5034          MP_TAC (ISPECL [`p':real^3`; `u:real^3`; `w':real^3`] LAW_OF_COSINES) THEN
5035          ABBREV_TAC `d0 = dist(u:real^3,w')` THEN
5036          ABBREV_TAC `d1 = dist(p':real^3,u)` THEN
5037          ABBREV_TAC `d2 = dist(p':real^3,w')` THEN
5038          ABBREV_TAC `x = cos(angle (u:real^3,p',w'))` THEN
5039          SUBGOAL_THEN `(d1 pow 2 + d2 pow 2) - d0 pow 2 < &0` ASSUME_TAC THENL
5040          [
5041            REWRITE_TAC[REAL_ARITH `a - b < &0 <=> a < b`] THEN
5042              MATCH_MP_TAC REAL_LTE_TRANS THEN
5043              EXISTS_TAC `&4` THEN
5044              CONJ_TAC THENL
5045              [
5046                REWRITE_TAC[REAL_ARITH `&4 = &2 + &2`] THEN
5047                  MATCH_MP_TAC REAL_LT_ADD2 THEN
5048                  MP_TAC (SPEC `&2` SQRT_WORKS) THEN
5049                  REWRITE_TAC[REAL_ARITH `&0 <= &2`] THEN
5050                  DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC (fun th -> ONCE_REWRITE_TAC[SYM th])) THEN
5051                  REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS] THEN
5052                  POP_ASSUM MP_TAC THEN
5053                  ONCE_REWRITE_TAC[GSYM REAL_ABS_REFL] THEN
5054                  DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
5055                  EXPAND_TAC "d1" THEN EXPAND_TAC "d2" THEN
5056                  REWRITE_TAC[dist; REAL_ABS_NORM] THEN
5057                  ASM_REWRITE_TAC[GSYM dist];
5058                ALL_TAC
5059              ] THEN
5060
5061              REWRITE_TAC[REAL_ARITH `&4 = &2 pow 2`] THEN
5062              REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS; REAL_ARITH `abs(&2) = &2`] THEN
5063              EXPAND_TAC "d0" THEN
5064              REWRITE_TAC[dist; REAL_ABS_NORM] THEN
5065              ASM_REWRITE_TAC[GSYM dist];
5066            ALL_TAC
5067          ] THEN
5068
5069          REWRITE_TAC[REAL_ARITH `d0 = d12 - x <=> x = d12 - d0:real`] THEN
5070          DISCH_TAC THEN
5071          MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN
5072          EXISTS_TAC `&2 * d1 * d2` THEN
5073          CONJ_TAC THENL
5074          [
5075            MATCH_MP_TAC REAL_LT_MUL THEN
5076              REWRITE_TAC[REAL_ARITH `&0 < &2`] THEN
5077              MATCH_MP_TAC REAL_LT_MUL THEN
5078              EXPAND_TAC "d1" THEN EXPAND_TAC "d2" THEN
5079              ASM_REWRITE_TAC[GSYM DIST_NZ];
5080            ALL_TAC
5081          ] THEN
5082
5083          ASM_REWRITE_TAC[REAL_MUL_RZERO; GSYM REAL_MUL_ASSOC];
5084        ALL_TAC
5085      ] THEN
5086
5087      MP_TAC (ISPEC `S:real^3->bool` OAPVION2) THEN
5088      ASM_REWRITE_TAC[] THEN
5089      DISCH_TAC THEN
5090      SUBGOAL_THEN `!x. x IN S ==> dist(p:real^3,x) < sqrt(&2)` ASSUME_TAC THENL
5091      [
5092        REPEAT STRIP_TAC THEN
5093          FIRST_X_ASSUM (MP_TAC o SPEC `x:real^3`) THEN
5094          ASM_REWRITE_TAC[] THEN
5095          DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
5096          ASM_REWRITE_TAC[];
5097        ALL_TAC
5098      ] THEN
5099
5100      SUBGOAL_THEN `!u:real^3. u IN S ==> V u /\ ~(u = w)` (LABEL_TAC "A") THENL
5101      [
5102        REPEAT STRIP_TAC THENL
5103          [
5104            ONCE_REWRITE_TAC[GSYM IN] THEN
5105              MATCH_MP_TAC IN_TRANS THEN
5106              EXISTS_TAC `S:real^3->bool` THEN
5107              ASM_REWRITE_TAC[];
5108            ALL_TAC
5109          ] THEN
5110
5111          UNDISCH_TAC `u:real^3 IN S` THEN
5112          UNDISCH_TAC `w:real^3 IN V DIFF S` THEN
5113          ASM_SIMP_TAC[IN_DIFF];
5114        ALL_TAC
5115      ] THEN
5116
5117      SUBGOAL_THEN `(V:real^3->bool) w` ASSUME_TAC THENL
5118      [
5119        UNDISCH_TAC `w:real^3 IN V DIFF S` THEN
5120          SIMP_TAC[IN_DIFF; IN];
5121        ALL_TAC
5122      ] THEN
5123
5124      CONJ_TAC THEN REPEAT STRIP_TAC THENL
5125      [
5126        FIRST_X_ASSUM MATCH_MP_TAC THEN
5127          SUBGOAL_THEN `~(circumcenter S = u:real^3)` ASSUME_TAC THENL
5128          [
5129            MP_TAC (ISPEC `S:real^3->bool` CIRCUMCENTER_NOT_EQ) THEN
5130              ASM_REWRITE_TAC[] THEN
5131              DISCH_THEN MATCH_MP_TAC THEN
5132              ASM_REWRITE_TAC[];
5133            ALL_TAC
5134          ] THEN
5135          ASM_REWRITE_TAC[] THEN
5136
5137          REPEAT CONJ_TAC THENL
5138          [
5139            DISCH_TAC THEN
5140              FIRST_X_ASSUM (MP_TAC o SPEC `u:real^3`) THEN
5141              ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
5142              FIRST_X_ASSUM (MP_TAC o SPEC `u:real^3`) THEN
5143              ASM_REWRITE_TAC[REAL_NOT_LT] THEN
5144              MATCH_MP_TAC REAL_LE_TRANS THEN
5145              EXISTS_TAC `&2` THEN
5146              CONJ_TAC THENL
5147              [
5148                MATCH_MP_TAC REAL_LE_LSQRT THEN
5149                  REAL_ARITH_TAC;
5150                ALL_TAC
5151              ] THEN
5152              FIRST_X_ASSUM MATCH_MP_TAC THEN
5153              ASM_REWRITE_TAC[];
5154
5155            MATCH_MP_TAC REAL_LET_TRANS THEN
5156              EXISTS_TAC `radV (S:real^3->bool)` THEN
5157              ASM_REWRITE_TAC[] THEN
5158              UNDISCH_TAC `p = circumcenter S:real^3` THEN
5159              DISCH_THEN (fun th -> ASM_REWRITE_TAC[SYM th]);
5160
5161            REMOVE_THEN "A" (fun th -> ALL_TAC) THEN
5162              FIRST_X_ASSUM (MP_TAC o SPEC `u:real^3`) THEN
5163              ASM_SIMP_TAC[];
5164
5165            FIRST_X_ASSUM MATCH_MP_TAC THEN
5166              ASM_SIMP_TAC[]
5167          ];
5168
5169        ALL_TAC
5170      ] THEN
5171
5172      FIRST_X_ASSUM MATCH_MP_TAC THEN
5173      ASM_SIMP_TAC[CIRCUMCENTER_NOT_EQ] THEN
5174      UNDISCH_TAC `p:real^3 = circumcenter S` THEN
5175      DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
5176      ASM_SIMP_TAC[]);;
5177
5178
5179
5180 let CARD_1_IMP_SING = prove(`!s:A->bool. FINITE s /\ CARD s = 1 ==> ?x. s = {x}`,
5181    REWRITE_TAC[GSYM HAS_SIZE] THEN
5182      REWRITE_TAC[HAS_SIZE_1_EXISTS; EXISTS_UNIQUE] THEN
5183      REPEAT STRIP_TAC THEN
5184      EXISTS_TAC `x:A` THEN
5185      REWRITE_TAC[EXTENSION; IN_SING] THEN
5186      GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
5187      [
5188        FIRST_X_ASSUM MATCH_MP_TAC THEN
5189          ASM_REWRITE_TAC[];
5190        ASM_REWRITE_TAC[]
5191      ]);;
5192
5193
5194 (* CARD S <= 1 *)
5195 let XYOFCGX_1 = prove(`!V S p. packing V /\ S SUBSET V /\ ~affine_dependent S /\
5196                         p = circumcenter S /\ radV S < sqrt(&2) /\
5197                         CARD S <= 1 ==>
5198                         (!u v. u IN S /\ v IN (V DIFF S) ==> dist (v,p) > dist (u,p))`,
5199    REWRITE_TAC[ARITH_RULE `a <= 1 <=> a = 0 \/ a = 1`] THEN
5200      REPEAT STRIP_TAC THENL
5201      [
5202        MP_TAC (ISPEC `S:real^3->bool` CARD_EQ_0) THEN
5203          ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE] THEN
5204          DISCH_TAC THEN
5205          UNDISCH_TAC `u:real^3 IN S` THEN
5206          ASM_REWRITE_TAC[NOT_IN_EMPTY];
5207        ALL_TAC
5208      ] THEN
5209
5210      MP_TAC (ISPEC `S:real^3->bool` Hypermap.set_one_point) THEN
5211      ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE] THEN
5212      DISCH_THEN (MP_TAC o SPEC `u:real^3`) THEN
5213      ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
5214      ASM_REWRITE_TAC[CIRCUMCENTER_1; DIST_REFL; GSYM DIST_NZ; real_gt] THEN
5215      UNDISCH_TAC `v:real^3 IN V DIFF S` THEN
5216      ASM_REWRITE_TAC[IN_DIFF; IN_SING] THEN
5217      SIMP_TAC[]);;
5218
5219
5220
5221 (* CARD S = 2 *)
5222 let CIRCUMCENTER_2 = prove(`!a b:real^N. circumcenter {a, b} = midpoint (a,b)`,
5223    REPEAT GEN_TAC THEN
5224      MATCH_MP_TAC EQ_SYM THEN
5225      MP_TAC (SPEC `{a,b:real^N}` OAPVION3) THEN
5226      REWRITE_TAC[AFFINE_INDEPENDENT_2] THEN
5227      DISCH_THEN MATCH_MP_TAC THEN
5228
5229      CONJ_TAC THENL
5230      [
5231        REWRITE_TAC[AFFINE_HULL_2; midpoint; IN_ELIM_THM] THEN
5232          MAP_EVERY EXISTS_TAC [`inv(&2)`; `inv(&2)`] THEN
5233          REWRITE_TAC[VECTOR_ADD_LDISTRIB] THEN
5234          REAL_ARITH_TAC;
5235        ALL_TAC
5236      ] THEN
5237
5238      EXISTS_TAC `dist(a:real^N,b) / &2` THEN
5239      REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN
5240      REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[DIST_MIDPOINT]);;
5241
5242
5243 let CARD_2_IMP_DOUBLE = prove(`!s:A->bool. FINITE s /\ CARD s = 2 ==> (?a b. s = {a, b} /\ ~(a = b))`,
5244    REWRITE_TAC[GSYM HAS_SIZE; HAS_SIZE_2_EXISTS] THEN
5245      REPEAT STRIP_TAC THEN
5246      MAP_EVERY EXISTS_TAC [`x:A`; `y:A`] THEN
5247      ASM_REWRITE_TAC[EXTENSION; IN_INSERT; NOT_IN_EMPTY]);;
5248
5249
5250
5251
5252 let XYOFCGX_2 = prove(`!V S p. packing V /\ S SUBSET V /\ ~affine_dependent S /\
5253                         p = circumcenter S /\ radV S < sqrt(&2) /\
5254                         CARD S = 2 ==>
5255                         (!u v. u IN S /\ v IN (V DIFF S) ==> dist (v,p) > dist (u,p))`,
5256    REPEAT STRIP_TAC THEN
5257      ASM_CASES_TAC `dist (v,p:real^3) > dist(u,p)` THEN ASM_REWRITE_TAC[] THEN
5258      POP_ASSUM MP_TAC THEN PURE_REWRITE_TAC[real_gt; REAL_NOT_LT; DIST_SYM] THEN DISCH_TAC THEN
5259      SUBGOAL_THEN `dist (p:real^3,v) <= radV (S:real^3->bool)` ASSUME_TAC THENL
5260      [
5261        MATCH_MP_TAC REAL_LE_TRANS THEN
5262          EXISTS_TAC `dist (p,u:real^3)` THEN
5263          POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN
5264          REWRITE_TAC[REAL_LE_LT] THEN DISJ2_TAC THEN
5265          MP_TAC (ISPEC `S:real^3->bool` OAPVION2) THEN
5266          ASM_REWRITE_TAC[] THEN
5267          DISCH_THEN (fun th -> MATCH_MP_TAC (GSYM th)) THEN
5268          ASM_REWRITE_TAC[];
5269        ALL_TAC
5270      ] THEN
5271
5272      MP_TAC (SPECL [`V:real^3->bool`; `S:real^3->bool`; `p:real^3`; `v:real^3`] XYOFCGX_lemma0) THEN
5273      ASM_REWRITE_TAC[ARITH_RULE `1 < 2`] THEN
5274      MP_TAC (ISPEC `S:real^3->bool`CARD_2_IMP_DOUBLE) THEN
5275      ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE] THEN
5276      STRIP_TAC THEN
5277      DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC (fun th -> ALL_TAC)) THEN
5278      FIRST_ASSUM (MP_TAC o SPEC `a:real^3`) THEN
5279      FIRST_X_ASSUM (MP_TAC o SPEC `b:real^3`) THEN
5280      ASM_REWRITE_TAC[IN_INSERT; CIRCUMCENTER_2; ARCV_ANGLE] THEN
5281      REPEAT DISCH_TAC THEN
5282      MP_TAC (ISPECL [`a:real^3`; `b:real^3`; `midpoint (a:real^3,b)`; `v:real^3`] ANGLES_ALONG_LINE) THEN
5283      ASM_REWRITE_TAC[BETWEEN_MIDPOINT; MIDPOINT_EQ_ENDPOINT] THEN
5284      ONCE_REWRITE_TAC[ANGLE_SYM] THEN
5285      POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
5286      REAL_ARITH_TAC);;
5287
5288
5289
5290 (* CARD S = 3 *)
5291
5292 let ANGLE_GT_PI2 = prove(`!a b c:real^N. pi / &2 < angle (a,b,c) <=> (a - b) dot (c - b) < &0`,
5293    REPEAT STRIP_TAC THEN
5294      REWRITE_TAC[angle; vector_angle] THEN
5295      ASM_CASES_TAC `a - b = vec 0:real^N \/ c - b = vec 0` THEN ASM_REWRITE_TAC[] THENL
5296      [
5297        REWRITE_TAC[REAL_LT_REFL; REAL_NOT_LT; REAL_LE_LT] THEN
5298          DISJ2_TAC THEN
5299          POP_ASSUM DISJ_CASES_TAC THEN ASM_REWRITE_TAC[DOT_LZERO; DOT_RZERO];
5300        ALL_TAC
5301      ] THEN
5302
5303      ABBREV_TAC `x = (a - b:real^N) dot (c - b)` THEN
5304      ABBREV_TAC `y = norm (a - b:real^N) * norm (c - b)` THEN
5305      SUBGOAL_THEN `-- &1 <= x / y /\ x / y <= &1` ASSUME_TAC THENL
5306      [
5307        EXPAND_TAC "x" THEN EXPAND_TAC "y" THEN
5308          MATCH_MP_TAC Trigonometry1.NORM_CAUCHY_SCHWARZ_FRAC THEN
5309          ASM_REWRITE_TAC[GSYM DE_MORGAN_THM];
5310        ALL_TAC
5311      ] THEN
5312
5313      EQ_TAC THENL
5314      [
5315        REWRITE_TAC[GSYM ACS_0] THEN
5316          MP_TAC (SPECL [`&0`; `x / y`] ACS_MONO_LT_EQ) THEN
5317          ANTS_TAC THENL
5318          [
5319            ASM_REWRITE_TAC[REAL_ARITH `abs a <= &1 <=> -- &1 <= a /\ a <= &1`] THEN
5320              REAL_ARITH_TAC;
5321            ALL_TAC
5322          ] THEN
5323
5324          DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
5325          ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
5326          REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN
5327          MATCH_MP_TAC REAL_LE_DIV THEN
5328          ASM_REWRITE_TAC[] THEN
5329          EXPAND_TAC "y" THEN
5330          MATCH_MP_TAC REAL_LE_MUL THEN
5331          REWRITE_TAC[NORM_POS_LE];
5332        ALL_TAC
5333      ] THEN
5334
5335      REWRITE_TAC[GSYM ACS_0] THEN DISCH_TAC THEN
5336      MATCH_MP_TAC ACS_MONO_LT THEN
5337      ASM_REWRITE_TAC[REAL_ARITH `&0 <= &1`] THEN
5338      ONCE_REWRITE_TAC[REAL_ARITH `x / y < &0 <=> &0 < --x / y`] THEN
5339      MATCH_MP_TAC REAL_LT_DIV THEN
5340      ASM_REWRITE_TAC[REAL_NEG_GT0] THEN
5341      EXPAND_TAC "y" THEN
5342      MATCH_MP_TAC REAL_LT_MUL THEN
5343      ASM_REWRITE_TAC[NORM_POS_LT; GSYM DE_MORGAN_THM]);;
5344
5345
5346
5347
5348 let AZIM_COMPL_EXT = prove(`!v w a b. azim v w b a = if azim v w a b = &0 then &0 else &2 * pi - azim v w a b`,
5349    REPEAT GEN_TAC THEN
5350      ASM_CASES_TAC `collinear {v, w, a:real^3}` THENL
5351      [
5352        ASM_REWRITE_TAC[azim_def];
5353        ALL_TAC
5354      ] THEN
5355      ASM_CASES_TAC `collinear {v, w, b:real^3}` THENL
5356      [
5357        ASM_REWRITE_TAC[azim_def];
5358        ALL_TAC
5359      ] THEN
5360      MATCH_MP_TAC AZIM_COMPL THEN
5361      ASM_REWRITE_TAC[]);;
5362
5363
5364
5365 let AZIM_EQ_SYM = prove(`!v w a b c. azim v w b a = azim v w c a <=> azim v w a b = azim v w a c`,
5366    REPEAT GEN_TAC THEN
5367      EQ_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[AZIM_COMPL_EXT] THEN ASM_REWRITE_TAC[]);;
5368
5369
5370
5371
5372 (* A special configuration of points is a fan *)
5373 let STRICT_CYCLIC_IMP_FAN = prove(`!V p. FINITE V /\ 2 <= CARD V /\
5374                                     (!v w. v IN V /\ w IN V /\ ~(v = w) ==> &0 < azim (vec 0) p v w)
5375                                     ==> FAN (vec 0, V UNION {p}, {{p, v} | v | v IN V})`,
5376    REPEAT STRIP_TAC THEN
5377      SUBGOAL_THEN `?v w:real^3. v IN V /\ w IN V /\ ~(v = w)` MP_TAC THENL
5378      [
5379        MP_TAC (ISPEC `V:real^3->bool` CHOOSE_SUBSET) THEN
5380          ASM_REWRITE_TAC[] THEN
5381          DISCH_THEN (MP_TAC o SPEC `2`) THEN
5382          ASM_REWRITE_TAC[LE_REFL; HAS_SIZE_2_EXISTS] THEN
5383          REPEAT STRIP_TAC THEN
5384          MAP_EVERY EXISTS_TAC [`x:real^3`; `y:real^3`] THEN
5385          ASM_REWRITE_TAC[] THEN
5386          CONJ_TAC THEN MATCH_MP_TAC IN_TRANS THEN EXISTS_TAC `t:real^3->bool` THEN ASM_REWRITE_TAC[];
5387        ALL_TAC
5388      ] THEN
5389      STRIP_TAC THEN
5390
5391      SUBGOAL_THEN `!v:real^3. v IN V ==> ~collinear {vec 0, p, v}` (LABEL_TAC "c") THENL
5392      [
5393        REPEAT STRIP_TAC THEN
5394          ASM_CASES_TAC `v:real^3 = v'` THENL
5395          [
5396            FIRST_X_ASSUM (MP_TAC o SPECL [`v:real^3`; `w:real^3`]) THEN
5397              ASM_REWRITE_TAC[azim_def; REAL_LT_REFL];
5398            ALL_TAC
5399          ] THEN
5400
5401          FIRST_X_ASSUM (MP_TAC o SPECL [`v':real^3`; `v:real^3`]) THEN
5402          ASM_REWRITE_TAC[azim_def; REAL_LT_REFL];
5403        ALL_TAC
5404      ] THEN
5405
5406      SUBGOAL_THEN `!v:real^3. v IN V ==> DISJOINT {vec 0, p} {v} /\ DISJOINT {vec 0} {p, v}` (LABEL_TAC "d") THENL
5407      [
5408        REPEAT STRIP_TAC THENL
5409          [
5410            MATCH_MP_TAC Collect_geom.COLLINEAR_DISJOINT3 THEN
5411              FIRST_X_ASSUM (MP_TAC o SPEC `v':real^3`) THEN
5412              ASM_REWRITE_TAC[] THEN
5413              SIMP_TAC[Collect_geom.PER_SET3];
5414            REWRITE_TAC[DISJOINT; INTER_ACI] THEN
5415              REWRITE_TAC[GSYM DISJOINT] THEN
5416              MATCH_MP_TAC Collect_geom.COLLINEAR_DISJOINT3 THEN
5417              FIRST_X_ASSUM MATCH_MP_TAC THEN
5418              ASM_REWRITE_TAC[]
5419          ];
5420        ALL_TAC
5421      ] THEN
5422
5423
5424      SUBGOAL_THEN `~(p:real^3 = vec 0) /\ ~(p IN V) /\ ~(vec 0 IN V)` ASSUME_TAC THENL
5425      [
5426        REPEAT STRIP_TAC THENL
5427          [
5428            REMOVE_THEN "c" (MP_TAC o  SPEC `v:real^3`) THEN
5429              ASM_REWRITE_TAC[COLLINEAR_LEMMA_ALT];
5430
5431            REMOVE_THEN "c" (MP_TAC o SPEC `p:real^3`) THEN
5432              ASM_REWRITE_TAC[COLLINEAR_LEMMA_ALT] THEN
5433              DISJ2_TAC THEN EXISTS_TAC `&1` THEN
5434              REWRITE_TAC[VECTOR_MUL_LID];
5435
5436            REMOVE_THEN "c" (MP_TAC o SPEC `vec 0:real^3`) THEN
5437              ASM_REWRITE_TAC[COLLINEAR_LEMMA_ALT] THEN
5438              DISJ2_TAC THEN EXISTS_TAC `&0` THEN
5439              REWRITE_TAC[VECTOR_MUL_LZERO]
5440          ];
5441        ALL_TAC
5442      ] THEN
5443      POP_ASSUM STRIP_ASSUME_TAC THEN
5444
5445      SUBGOAL_THEN `!v:real^3. v IN V ==> ~(v = p)` ASSUME_TAC THENL
5446      [
5447        REPEAT STRIP_TAC THEN POP_ASSUM (ASSUME_TAC o SYM) THEN
5448          UNDISCH_TAC `~(p:real^3 IN V)` THEN
5449          ASM_REWRITE_TAC[];
5450        ALL_TAC
5451      ] THEN
5452
5453      REWRITE_TAC[Fan_defs.FAN] THEN
5454      REPEAT STRIP_TAC THENL
5455      [
5456        (* UNIONS E SUBSET (V UNION {p}) *)
5457        REWRITE_TAC[SUBSET; IN_UNIONS; IN_UNION; IN_ELIM_THM; IN_SING] THEN
5458          REPEAT STRIP_TAC THEN
5459          POP_ASSUM MP_TAC THEN
5460          ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN
5461          STRIP_TAC THEN ASM_REWRITE_TAC[];
5462
5463        (* graph E *)
5464        REWRITE_TAC[Fan_defs.graph; IN_ELIM_THM] THEN
5465          REPEAT STRIP_TAC THEN
5466          ASM_REWRITE_TAC[HAS_SIZE_2_EXISTS; IN_INSERT; NOT_IN_EMPTY] THEN
5467          MAP_EVERY EXISTS_TAC [`p:real^3`; `v':real^3`] THEN
5468          REWRITE_TAC[] THEN
5469          ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
5470          FIRST_X_ASSUM MATCH_MP_TAC THEN
5471          ASM_REWRITE_TAC[];
5472
5473        (* FINITE V /\ ~(V = {}) *)
5474        ASM_REWRITE_TAC[Fan_defs.fan1; FINITE_UNION; FINITE_SING; SUBSET_EMPTY] THEN
5475          REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
5476          EXISTS_TAC `p:real^3` THEN
5477          REWRITE_TAC[IN_UNION; IN_SING];
5478
5479        (* ~(vec 0 IN V) *)
5480        ASM_REWRITE_TAC[Fan_defs.fan2; IN_UNION; IN_SING];
5481
5482        (* ~collinear {vec 0, e} *)
5483        REWRITE_TAC[Fan_defs.fan6; IN_ELIM_THM] THEN
5484          REPEAT STRIP_TAC THEN
5485          POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN
5486          SUBGOAL_THEN `{vec 0:real^3} UNION {p, v'} = {vec 0, p, v'}` (fun th -> REWRITE_TAC[th]) THENL
5487          [
5488            REWRITE_TAC[EXTENSION; IN_UNION; IN_INSERT; NOT_IN_EMPTY];
5489            ALL_TAC
5490          ] THEN
5491
5492          FIRST_X_ASSUM MATCH_MP_TAC THEN
5493          ASM_REWRITE_TAC[];
5494        ALL_TAC
5495      ] THEN
5496
5497      (* fan7 *)
5498      REWRITE_TAC[Fan_defs.fan7; IN_UNION; IN_ELIM_THM; IN_SING] THEN
5499
5500      SUBGOAL_THEN `!t1 t2 r1 r2 x y v w:real^3. v IN V /\ w IN V /\ x = t1 % p + t2 % v /\ y = r1 % p + r2 % w /\ &0 < t2 /\ &0 < r2 ==> azim (vec 0) p x y = azim (vec 0) p v w` ASSUME_TAC THENL
5501      [
5502        REPEAT STRIP_TAC THEN
5503          FIRST_X_ASSUM ((fun th -> ALL_TAC) o SPEC `v:real^3`) THEN
5504          SUBGOAL_THEN `~collinear {vec 0, p, x:real^3} /\ ~collinear {vec 0, p, y}` ASSUME_TAC THENL
5505          [
5506            ASM_REWRITE_TAC[COLLINEAR_LEMMA_ALT; DE_MORGAN_THM; NOT_EXISTS_THM] THEN
5507              REWRITE_TAC[VECTOR_ARITH `t1 % p + t2 % v = c % p <=> t2 % v = (c - t1) % p:real^3`] THEN
5508              CONJ_TAC THEN GEN_TAC THENL
5509              [
5510                DISCH_THEN (MP_TAC o AP_TERM `\v:real^3. inv(t2) % v`) THEN
5511                  ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_ARITH `&0 < a ==> ~(a = &0)`; REAL_MUL_LINV] THEN
5512                  REMOVE_THEN "c" (MP_TAC o SPEC `v':real^3`) THEN
5513                  ASM_SIMP_TAC[COLLINEAR_LEMMA_ALT; VECTOR_MUL_LID; NOT_EXISTS_THM];
5514                DISCH_THEN (MP_TAC o AP_TERM `\v:real^3. inv(r2) % v`) THEN
5515                  ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_ARITH `&0 < a ==> ~(a = &0)`; REAL_MUL_LINV] THEN
5516                  REMOVE_THEN "c" (MP_TAC o SPEC `w':real^3`) THEN
5517                  ASM_SIMP_TAC[COLLINEAR_LEMMA_ALT; VECTOR_MUL_LID; NOT_EXISTS_THM]
5518              ];
5519            ALL_TAC
5520          ] THEN
5521
5522          MATCH_MP_TAC EQ_TRANS THEN
5523          EXISTS_TAC `azim (vec 0) p v' y` THEN
5524          CONJ_TAC THENL
5525          [
5526            ONCE_REWRITE_TAC[AZIM_EQ_SYM] THEN
5527              MATCH_MP_TAC EQ_SYM THEN
5528              MP_TAC (SPECL [`vec 0:real^3`; `p:real^3`; `y:real^3`; `v':real^3`; `x:real^3`] AZIM_EQ) THEN
5529              ASM_SIMP_TAC[] THEN DISCH_TAC THEN
5530
5531              ASM_SIMP_TAC[AFF_GT_2_1; IN_ELIM_THM] THEN
5532              MAP_EVERY EXISTS_TAC [`&1 - t1 - t2`; `t1:real`; `t2:real`] THEN
5533              ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
5534              REAL_ARITH_TAC;
5535            ALL_TAC
5536          ] THEN
5537
5538          MATCH_MP_TAC EQ_SYM THEN
5539          MP_TAC (SPECL [`vec 0:real^3`; `p:real^3`; `v':real^3`; `w':real^3`; `y:real^3`] AZIM_EQ) THEN
5540          ASM_SIMP_TAC[] THEN DISCH_TAC THEN
5541          ASM_SIMP_TAC[AFF_GT_2_1; IN_ELIM_THM] THEN
5542          MAP_EVERY EXISTS_TAC [`&1 - r1 - r2`; `r1:real`; `r2:real`] THEN
5543          ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
5544          REAL_ARITH_TAC;
5545        ALL_TAC
5546      ] THEN
5547
5548      SUBGOAL_THEN `!v w:real^3. v IN V /\ w IN V ==> aff_ge {vec 0} {p, v} INTER aff_ge {vec 0} {p, w} = if (v = w) then aff_ge {vec 0} {p, v} else aff_ge {vec 0} {p}` ASSUME_TAC THENL
5549      [
5550        REPEAT STRIP_TAC THEN
5551          COND_CASES_TAC THEN ASM_REWRITE_TAC[INTER_ACI] THEN
5552          ASM_SIMP_TAC[Fan.AFF_GE_1_2; HALFLINE] THEN
5553          REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; EXTENSION; IN_ELIM_THM; IN_INTER] THEN
5554          GEN_TAC THEN EQ_TAC THENL
5555          [
5556            REPEAT STRIP_TAC THEN
5557              ASM_CASES_TAC `t3 = &0` THENL
5558              [
5559                EXISTS_TAC `t2:real` THEN
5560                  UNDISCH_TAC `x = t2 % p + t3 % v':real^3` THEN
5561                  ASM_REWRITE_TAC[] THEN
5562                  VECTOR_ARITH_TAC;
5563                ALL_TAC
5564              ] THEN
5565
5566              ASM_CASES_TAC `t3' = &0` THENL
5567              [
5568                EXISTS_TAC `t2':real` THEN
5569                  UNDISCH_TAC `x = t2' % p + t3' % w':real^3` THEN
5570                  ASM_REWRITE_TAC[] THEN
5571                  VECTOR_ARITH_TAC;
5572                ALL_TAC
5573              ] THEN
5574
5575              SUBGOAL_THEN `azim (vec 0) p x x = azim (vec 0) p v' w'` MP_TAC THENL
5576              [
5577                FIRST_X_ASSUM MATCH_MP_TAC THEN
5578                  MAP_EVERY EXISTS_TAC [`t2:real`; `t3:real`; `t2':real`; `t3':real`] THEN
5579                  ASM_REWRITE_TAC[REAL_LT_LE] THEN
5580                  UNDISCH_TAC `x = t2 % p + t3 % v':real^3` THEN
5581                  DISCH_THEN (fun th -> ASM_REWRITE_TAC[SYM th]);
5582                ALL_TAC
5583              ] THEN
5584
5585              FIRST_X_ASSUM (MP_TAC o SPECL [`v':real^3`; `w':real^3`]) THEN
5586              ASM_REWRITE_TAC[AZIM_REFL] THEN
5587              REAL_ARITH_TAC;
5588            ALL_TAC
5589          ] THEN
5590
5591          STRIP_TAC THEN
5592          CONJ_TAC THEN MAP_EVERY EXISTS_TAC [`&1 - t`; `t:real`; `&0`] THEN ASM_REWRITE_TAC[REAL_LE_REFL] THENL
5593          [
5594            CONJ_TAC THENL [ REAL_ARITH_TAC; VECTOR_ARITH_TAC ];
5595            CONJ_TAC THENL [ REAL_ARITH_TAC; VECTOR_ARITH_TAC ]
5596          ];
5597        ALL_TAC
5598      ] THEN
5599
5600      SUBGOAL_THEN `!v w:real^3. v IN V /\ w IN V ==> aff_ge {vec 0} {p, v} INTER aff_ge {vec 0} {w} = if (v = w) then aff_ge {vec 0} {v} else aff_ge {vec 0} {}` ASSUME_TAC THENL
5601      [
5602        REPEAT STRIP_TAC THEN
5603          COND_CASES_TAC THENL
5604          [
5605            ASM_REWRITE_TAC[] THEN
5606              ONCE_REWRITE_TAC[INTER_ACI] THEN
5607              REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION] THEN
5608              MATCH_MP_TAC AFF_GE_MONO_RIGHT THEN
5609              ASM_SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY];
5610            ALL_TAC
5611          ] THEN
5612
5613          REWRITE_TAC[AFF_GE_EQ_AFFINE_HULL; AFFINE_HULL_SING] THEN
5614          ASM_SIMP_TAC[Fan.AFF_GE_1_2] THEN
5615          REWRITE_TAC[EXTENSION; IN_SING; HALFLINE; IN_INTER; IN_ELIM_THM; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
5616          GEN_TAC THEN EQ_TAC THENL
5617          [
5618            REPEAT STRIP_TAC THEN
5619              ASM_CASES_TAC `t = &0` THENL
5620              [
5621                UNDISCH_TAC `x = t % w':real^3` THEN
5622                  ASM_REWRITE_TAC[VECTOR_MUL_LZERO];
5623                ALL_TAC
5624              ] THEN
5625
5626              ASM_CASES_TAC `t3 = &0` THENL
5627              [
5628                UNDISCH_TAC `x = t % w':real^3` THEN
5629                  ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN
5630                  REMOVE_THEN "c" (MP_TAC o SPEC `w':real^3`) THEN
5631                  ASM_REWRITE_TAC[COLLINEAR_LEMMA_ALT; NOT_EXISTS_THM] THEN
5632                  DISCH_TAC THEN
5633                  DISCH_THEN (MP_TAC o AP_TERM `\v:real^3. inv t % v`) THEN
5634                  ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID];
5635                ALL_TAC
5636              ] THEN
5637
5638              SUBGOAL_THEN `azim (vec 0) p x x = azim (vec 0) p v' w'` MP_TAC THENL
5639              [
5640                FIRST_X_ASSUM MATCH_MP_TAC THEN
5641                  MAP_EVERY EXISTS_TAC [`t2:real`; `t3:real`; `&0`; `t:real`] THEN
5642                  ASM_REWRITE_TAC[REAL_LT_LE; VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN
5643                  UNDISCH_TAC `x = t % w':real^3` THEN DISCH_THEN (fun th -> ASM_REWRITE_TAC[SYM th]);
5644                ALL_TAC
5645              ] THEN
5646
5647              REPLICATE_TAC 2 (FIRST_X_ASSUM (MP_TAC o SPECL [`v':real^3`; `w':real^3`])) THEN
5648              ASM_REWRITE_TAC[AZIM_REFL] THEN
5649              REAL_ARITH_TAC;
5650            ALL_TAC
5651          ] THEN
5652
5653          DISCH_TAC THEN
5654          CONJ_TAC THENL
5655          [
5656            MAP_EVERY EXISTS_TAC [`&1`; `&0`; `&0`] THEN
5657              ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN
5658              REAL_ARITH_TAC;
5659            ALL_TAC
5660          ] THEN
5661
5662          EXISTS_TAC `&0` THEN
5663          ASM_REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LE_REFL];
5664        ALL_TAC
5665      ] THEN
5666
5667
5668      SUBGOAL_THEN `!v:real^3. v IN V ==> aff_ge {vec 0} {p, v} INTER aff_ge {vec 0} {p} = aff_ge {vec 0} {p}` ASSUME_TAC THENL
5669      [
5670        REPEAT STRIP_TAC THEN
5671          ONCE_REWRITE_TAC[INTER_ACI] THEN
5672          REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION] THEN
5673          MATCH_MP_TAC AFF_GE_MONO_RIGHT THEN
5674          ASM_SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY];
5675        ALL_TAC
5676      ] THEN
5677
5678
5679
5680      SUBGOAL_THEN `!v w:real^3. {p, v} INTER {p, w} = if (v = w) then {p, v} else {p}` ASSUME_TAC THENL
5681      [
5682        REPEAT STRIP_TAC THEN
5683          COND_CASES_TAC THENL
5684          [
5685            ASM_REWRITE_TAC[INTER_ACI];
5686            ALL_TAC
5687          ] THEN
5688
5689          REWRITE_TAC[EXTENSION; IN_INTER; IN_INSERT; NOT_IN_EMPTY] THEN
5690          GEN_TAC THEN EQ_TAC THENL
5691          [
5692            REPEAT STRIP_TAC THEN
5693              UNDISCH_TAC `~(v' = w':real^3)` THEN
5694              POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
5695              POP_ASSUM (fun th -> REWRITE_TAC[SYM th]);
5696            ALL_TAC
5697          ] THEN
5698          SIMP_TAC[];
5699        ALL_TAC
5700      ] THEN
5701
5702      SUBGOAL_THEN `!v:real^3. {p, v} INTER {p} = {p} /\ {p} INTER {p, v} = {p}` ASSUME_TAC THENL
5703      [
5704        REWRITE_TAC[INTER_ACI; GSYM SUBSET_INTER_ABSORPTION; SUBSET; IN_INSERT; NOT_IN_EMPTY] THEN
5705          SIMP_TAC[];
5706        ALL_TAC
5707      ] THEN
5708
5709      SUBGOAL_THEN `!v w:real^3. w IN V ==> {p, v} INTER {w} = if (v = w) then {v} else {}` ASSUME_TAC THENL
5710      [
5711        REPEAT STRIP_TAC THEN
5712          COND_CASES_TAC THENL
5713          [
5714            ASM_REWRITE_TAC[] THEN
5715              ONCE_REWRITE_TAC[INTER_ACI] THEN
5716              ASM_REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION; SUBSET] THEN
5717              SIMP_TAC[IN_INSERT];
5718            ALL_TAC
5719          ] THEN
5720
5721          REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_INSERT; DE_MORGAN_THM] THEN
5722          GEN_TAC THEN ASM_CASES_TAC `~(x = w':real^3)` THEN ASM_REWRITE_TAC[] THEN
5723          POP_ASSUM MP_TAC THEN REWRITE_TAC[NOT_CLAUSES] THEN
5724          DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
5725          ASM_REWRITE_TAC[] THEN
5726          FIRST_X_ASSUM MATCH_MP_TAC THEN
5727          ASM_REWRITE_TAC[];
5728        ALL_TAC
5729      ] THEN
5730
5731
5732      SUBGOAL_THEN `!v w:real^3. v IN V /\ w IN V ==> aff_ge {vec 0} {v} INTER aff_ge {vec 0} {w} = if (v = w) then aff_ge {vec 0} {v} else aff_ge {vec 0} {}` ASSUME_TAC THENL
5733      [
5734        REPEAT STRIP_TAC THEN
5735          COND_CASES_TAC THEN ASM_REWRITE_TAC[INTER_ACI] THEN
5736
5737          REWRITE_TAC[AFF_GE_EQ_AFFINE_HULL; AFFINE_HULL_SING] THEN
5738          REWRITE_TAC[EXTENSION; IN_SING; HALFLINE; IN_INTER; IN_ELIM_THM; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
5739          GEN_TAC THEN EQ_TAC THENL
5740          [
5741            REPEAT STRIP_TAC THEN
5742              ASM_CASES_TAC `t = &0` THENL
5743              [
5744                UNDISCH_TAC `x = t % v':real^3` THEN
5745                  ASM_REWRITE_TAC[VECTOR_MUL_LZERO];
5746                ALL_TAC
5747              ] THEN
5748
5749              ASM_CASES_TAC `t' = &0` THENL
5750              [
5751                UNDISCH_TAC `x = t' % w':real^3` THEN
5752                  ASM_REWRITE_TAC[VECTOR_MUL_LZERO];
5753                ALL_TAC
5754              ] THEN
5755
5756              SUBGOAL_THEN `azim (vec 0) p x x = azim (vec 0) p v' w'` MP_TAC THENL
5757              [
5758                FIRST_X_ASSUM MATCH_MP_TAC THEN
5759                  MAP_EVERY EXISTS_TAC [`&0`; `t:real`; `&0`; `t':real`] THEN
5760                  ASM_REWRITE_TAC[REAL_LT_LE; VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN
5761                  UNDISCH_TAC `x = t % v':real^3` THEN DISCH_THEN (fun th -> ASM_REWRITE_TAC[SYM th]);
5762                ALL_TAC
5763              ] THEN
5764
5765              SUBGOAL_THEN `&0 < azim (vec 0) p v' w'` MP_TAC THENL
5766              [
5767                FIRST_X_ASSUM MATCH_MP_TAC THEN
5768                  ASM_REWRITE_TAC[];
5769                ALL_TAC
5770              ] THEN
5771
5772              ASM_REWRITE_TAC[AZIM_REFL] THEN
5773              REAL_ARITH_TAC;
5774            ALL_TAC
5775          ] THEN
5776
5777          DISCH_TAC THEN
5778          CONJ_TAC THEN EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_LE_REFL; VECTOR_MUL_LZERO];
5779        ALL_TAC
5780      ] THEN
5781
5782      SUBGOAL_THEN `!v w:real^3. {v} INTER {w} = if (v = w) then {v} else {}` ASSUME_TAC THENL
5783      [
5784        REPEAT GEN_TAC THEN
5785          COND_CASES_TAC THEN ASM_REWRITE_TAC[INTER_ACI] THEN
5786          REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_SING] THEN
5787          GEN_TAC THEN REWRITE_TAC[DE_MORGAN_THM] THEN
5788          ASM_CASES_TAC `x = v':real^3` THEN ASM_REWRITE_TAC[];
5789        ALL_TAC
5790      ] THEN
5791
5792      SUBGOAL_THEN `!v:real^3. v IN V ==> aff_ge {vec 0} {v} INTER aff_ge {vec 0} {p} = aff_ge {vec 0} {}` ASSUME_TAC THENL
5793      [
5794        REPEAT STRIP_TAC THEN
5795          REWRITE_TAC[HALFLINE; AFF_GE_EQ_AFFINE_HULL; AFFINE_HULL_SING; IN_INTER; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
5796          REWRITE_TAC[EXTENSION; IN_INTER; IN_SING; IN_ELIM_THM] THEN
5797          GEN_TAC THEN EQ_TAC THENL
5798          [
5799            REPEAT STRIP_TAC THEN
5800              REMOVE_THEN "c" (MP_TAC o SPEC `v':real^3`) THEN
5801              ASM_REWRITE_TAC[COLLINEAR_LEMMA_ALT; NOT_EXISTS_THM] THEN
5802              DISCH_TAC THEN
5803              ASM_CASES_TAC `t = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
5804              UNDISCH_TAC `x = t % v':real^3` THEN
5805              DISCH_THEN (MP_TAC o AP_TERM `\v:real^3. inv t % v`) THEN
5806              ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID];
5807            ALL_TAC
5808          ] THEN
5809          DISCH_TAC THEN
5810          CONJ_TAC THEN EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_LE_REFL; VECTOR_MUL_LZERO];
5811        ALL_TAC
5812      ] THEN
5813
5814      SUBGOAL_THEN `!v:real^3. v IN V ==> {v} INTER {p} = {}` ASSUME_TAC THENL
5815      [
5816        REPEAT STRIP_TAC THEN
5817          REWRITE_TAC[IN_INTER; EXTENSION; NOT_IN_EMPTY; IN_SING; DE_MORGAN_THM] THEN
5818          GEN_TAC THEN ASM_CASES_TAC `x = p:real^3` THEN ASM_REWRITE_TAC[] THEN
5819          DISCH_THEN (ASSUME_TAC o SYM) THEN
5820          UNDISCH_TAC `v':real^3 IN V` THEN
5821          ASM_REWRITE_TAC[];
5822        ALL_TAC
5823      ] THEN
5824
5825      REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN
5826      ONCE_REWRITE_TAC[INTER_ACI] THEN ASM_SIMP_TAC[]
5827      THEN TRY (COND_CASES_TAC THEN ASM_REWRITE_TAC[])
5828                                  );;
5829
5830
5831
5832 let STRICT_CYCLIC_FAN_PROPERTIES = prove(`!V p. let W = V UNION {p} in let E = {{p,v} | v | v IN V} in
5833                                            FAN (vec 0, W, E) ==>
5834                                              (!v. v IN V ==> (p, v) IN dart1_of_fan (W,E)) /\
5835                                              set_of_edge p W E = V /\
5836                                              (!v. v IN V ==> node (hypermap_of_fan (W,E)) (p,v) = {(p,w) | w | w IN V})`,
5837    REPEAT GEN_TAC THEN CONV_TAC (DEPTH_CONV let_CONV) THEN
5838      ABBREV_TAC `W = V UNION {p:real^3}` THEN
5839      ABBREV_TAC `E = {{p, v:real^3} | v | v IN V}` THEN
5840      DISCH_TAC THEN
5841      SUBGOAL_THEN `!v:real^3. v IN V ==> (p, v) IN dart1_of_fan (W,E)` ASSUME_TAC THENL
5842      [
5843        REPEAT STRIP_TAC THEN
5844          EXPAND_TAC "E" THEN
5845          REWRITE_TAC[Fan_defs.dart1_of_fan; IN_ELIM_THM] THEN
5846          MAP_EVERY EXISTS_TAC [`p:real^3`; `v:real^3`] THEN
5847          REWRITE_TAC[] THEN
5848          EXISTS_TAC `v:real^3` THEN
5849          ASM_REWRITE_TAC[];
5850        ALL_TAC
5851      ] THEN
5852
5853      ASM_REWRITE_TAC[] THEN
5854
5855      SUBGOAL_THEN `set_of_edge p W E = V:real^3->bool` ASSUME_TAC THENL
5856      [
5857        SUBGOAL_THEN `~(p:real^3 IN V)` MP_TAC THENL
5858          [
5859            DISCH_TAC THEN
5860              UNDISCH_TAC `FAN (vec 0:real^3,W,E)` THEN
5861              REWRITE_TAC[Fan_defs.FAN; Fan_defs.graph] THEN
5862              DISCH_THEN (CONJUNCTS_THEN2 (fun th -> ALL_TAC) MP_TAC) THEN
5863              DISCH_THEN (CONJUNCTS_THEN2 MP_TAC (fun th -> ALL_TAC)) THEN
5864              DISCH_THEN (MP_TAC o SPEC `{p:real^3, p}`) THEN
5865              EXPAND_TAC "E" THEN
5866              REWRITE_TAC[IN_ELIM_THM; NOT_IMP] THEN
5867              SUBGOAL_THEN `{p:real^3,p} = {p}` ASSUME_TAC THENL [ REWRITE_TAC[EXTENSION; IN_INSERT; NOT_IN_EMPTY]; ALL_TAC ] THEN
5868              ASM_SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_EMPTY; NOT_IN_EMPTY] THEN
5869              REWRITE_TAC[DE_MORGAN_THM; ARITH_RULE `~(SUC 0 = 2)`] THEN
5870              EXISTS_TAC `p:real^3` THEN
5871              ASM_REWRITE_TAC[];
5872            ALL_TAC
5873          ] THEN
5874
5875          REWRITE_TAC[Fan_defs.set_of_edge] THEN
5876          EXPAND_TAC "E" THEN EXPAND_TAC "W" THEN
5877          REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM; IN_SING] THEN
5878          REPEAT STRIP_TAC THEN
5879          EQ_TAC THENL
5880          [
5881            REPEAT STRIP_TAC THEN
5882              FIRST_X_ASSUM (MP_TAC o SPEC `v:real^3`) THEN
5883              ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN
5884              DISCH_TAC THEN UNDISCH_TAC `v:real^3 IN V` THEN ASM_REWRITE_TAC[];
5885            ALL_TAC
5886          ] THEN
5887
5888          DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
5889          EXISTS_TAC `x:real^3` THEN
5890          ASM_REWRITE_TAC[];
5891        ALL_TAC
5892      ] THEN
5893
5894      ASM_REWRITE_TAC[] THEN
5895      REPEAT STRIP_TAC THEN
5896      ASM_SIMP_TAC[Hypermap_and_fan.NODE_HYPERMAP_OF_FAN_ALT]);;
5897
5898
5899
5900
5901 let ANGLE_SUM_lemma = prove(`!V p. FINITE V /\ 2 <= CARD V /\
5902                               (!v w. v IN V /\ w IN V /\ ~(v = w) ==> &0 < azim (vec 0) p v w)
5903                               ==> ?f. (!x. x IN V ==> f x IN V /\ ~(x = f x)) /\
5904                                     sum V (\x. azim (vec 0) p x (f x)) = &2 * pi`,
5905    REPEAT GEN_TAC THEN DISCH_TAC THEN
5906      FIRST_ASSUM (MP_TAC o MATCH_MP STRICT_CYCLIC_IMP_FAN) THEN DISCH_TAC THEN
5907
5908      ABBREV_TAC `W = V UNION {p:real^3}` THEN
5909      ABBREV_TAC `E = {{p, v:real^3} | v | v IN V}` THEN
5910
5911      MP_TAC (SPEC_ALL STRICT_CYCLIC_FAN_PROPERTIES) THEN
5912      CONV_TAC (DEPTH_CONV let_CONV) THEN ASM_REWRITE_TAC[] THEN
5913      REPEAT STRIP_TAC THEN
5914
5915      EXISTS_TAC `sigma_fan (vec 0) W E p` THEN
5916      CONJ_TAC THENL
5917      [
5918        GEN_TAC THEN DISCH_TAC THEN
5919          MP_TAC (SPECL [`vec 0:real^3`; `W:real^3->bool`; `E:(real^3->bool)->bool`; `p:real^3`; `x:real^3`] Fan.SIGMA_FAN) THEN
5920          ANTS_TAC THENL
5921          [
5922            ASM_REWRITE_TAC[] THEN
5923              DISCH_TAC THEN
5924              FIRST_X_ASSUM (MP_TAC o check (is_conj o concl)) THEN
5925              ASM_SIMP_TAC[CARD_CLAUSES; FINITE_EMPTY; NOT_IN_EMPTY] THEN
5926              ARITH_TAC;
5927            ALL_TAC
5928          ] THEN
5929
5930          ASM_SIMP_TAC[];
5931        ALL_TAC
5932      ] THEN
5933
5934      SUBGOAL_THEN `?v:real^3. v IN V` CHOOSE_TAC THENL
5935      [
5936        REWRITE_TAC[MEMBER_NOT_EMPTY] THEN DISCH_TAC THEN
5937          FIRST_X_ASSUM (MP_TAC o check (is_conj o concl)) THEN
5938          ASM_REWRITE_TAC[CARD_CLAUSES] THEN
5939          ARITH_TAC;
5940        ALL_TAC
5941      ] THEN
5942
5943      MP_TAC (SPECL [`W:real^3->bool`; `E:(real^3->bool)->bool`; `(p:real^3,v:real^3)`] Hypermap_and_fan.SUM_AZIM_DART) THEN
5944      ANTS_TAC THENL
5945      [
5946        ASM_REWRITE_TAC[] THEN
5947          MATCH_MP_TAC IN_TRANS THEN
5948          EXISTS_TAC `dart1_of_fan (W:real^3->bool,E)` THEN
5949          ASM_SIMP_TAC[Hypermap_and_fan.DART1_OF_FAN_SUBSET_DART_OF_FAN];
5950        ALL_TAC
5951      ] THEN
5952
5953      DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
5954      ASM_SIMP_TAC[] THEN
5955
5956      SUBGOAL_THEN `{p:real^3, w:real^3 | w IN V} = IMAGE (\v. p, v) V` (fun th -> REWRITE_TAC[th]) THENL
5957      [
5958        REWRITE_TAC[IMAGE_LEMMA];
5959        ALL_TAC
5960      ] THEN
5961
5962      MP_TAC (ISPECL [`\x. azim (vec 0) p x (sigma_fan (vec 0) W E p x)`; `V:real^3->bool`] SUM_RESTRICT) THEN
5963      ASM_REWRITE_TAC[] THEN
5964
5965      SUBGOAL_THEN `(\x. if x IN V then azim (vec 0) p x (sigma_fan (vec 0) W E p x) else &0) = (\x. if x IN V then ((azim_dart (W,E)) o (\v. p, v)) x else &0)` (fun th -> REWRITE_TAC[th]) THENL
5966      [
5967        REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN
5968          COND_CASES_TAC THEN ASM_REWRITE_TAC[o_THM] THEN
5969          REWRITE_TAC[Fan_defs.azim_dart; Fan_defs.azim_fan] THEN
5970          SUBGOAL_THEN `~(p = x:real^3)` (fun th -> REWRITE_TAC[th]) THENL
5971          [
5972            MATCH_MP_TAC Hypermap_and_fan.PAIR_IN_DART1_OF_FAN_IMP_NOT_EQ THEN
5973              MAP_EVERY EXISTS_TAC [`W:real^3->bool`; `E:(real^3->bool)->bool`] THEN
5974              ASM_SIMP_TAC[];
5975            ALL_TAC
5976          ] THEN
5977
5978          ASM_SIMP_TAC[ARITH_RULE `2 <= a ==> a > 1`];
5979        ALL_TAC
5980      ] THEN
5981
5982      MP_TAC (ISPECL [`azim_dart (W,E) o (\v. p,v)`; `V:real^3->bool`] SUM_RESTRICT) THEN
5983      ASM_REWRITE_TAC[] THEN
5984      DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
5985      DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
5986      MATCH_MP_TAC (GSYM SUM_IMAGE) THEN
5987      SIMP_TAC[PAIR_EQ]);;
5988
5989
5990
5991
5992 let ANGLE_SUM_BOUND = prove(`!V (p:real^3) a. &0 <= a /\ FINITE V /\ 2 <= CARD V /\
5993                                     (!v w. v IN V /\ w IN V /\ ~(v = w) ==> a < azim (vec 0) p v w)
5994                                       ==> a * &(CARD V) < &2 * pi`,
5995    REPEAT STRIP_TAC THEN
5996      MP_TAC (SPEC_ALL ANGLE_SUM_lemma) THEN
5997      ANTS_TAC THENL
5998      [
5999        ASM_REWRITE_TAC[] THEN
6000          REPEAT STRIP_TAC THEN
6001          MATCH_MP_TAC REAL_LET_TRANS THEN
6002          EXISTS_TAC `a:real` THEN
6003          ASM_SIMP_TAC[];
6004        ALL_TAC
6005      ] THEN
6006
6007      STRIP_TAC THEN
6008      MATCH_MP_TAC REAL_LTE_TRANS THEN
6009      EXISTS_TAC `sum V (\x. azim (vec 0) p x (f x))` THEN
6010      CONJ_TAC THENL
6011      [
6012        REMOVE_ASSUM THEN
6013          SUBGOAL_THEN `!x. azim (vec 0) p x (f x) = -- (--azim (vec 0) p x (f x))` (fun th -> ONCE_REWRITE_TAC[th]) THENL [ REAL_ARITH_TAC; ALL_TAC ] THEN
6014          ONCE_REWRITE_TAC[SUM_NEG] THEN
6015          REWRITE_TAC[REAL_ARITH `a * b < --c <=> c < b * (--a)`] THEN
6016          MATCH_MP_TAC SUM_BOUND_LT THEN
6017          ASM_REWRITE_TAC[REAL_LE_NEG] THEN
6018          ASM_SIMP_TAC[REAL_LE_LT] THEN
6019          SUBGOAL_THEN `?x:real^3. x IN V` CHOOSE_TAC THENL
6020          [
6021            REWRITE_TAC[MEMBER_NOT_EMPTY] THEN
6022              DISCH_TAC THEN UNDISCH_TAC `2 <= CARD (V:real^3->bool)` THEN
6023              ASM_REWRITE_TAC[CARD_CLAUSES; ARITH_RULE `~(2 <= 0)`];
6024            ALL_TAC
6025          ] THEN
6026          EXISTS_TAC `x:real^3` THEN
6027          ASM_SIMP_TAC[REAL_LT_NEG];
6028
6029        ALL_TAC
6030      ] THEN
6031
6032      ASM_REWRITE_TAC[REAL_LE_REFL]);;
6033
6034
6035
6036
6037 let DIHV_LE_AZIM = prove(`!v w x y. ~collinear {v, w, x} /\ ~collinear {v, w, y}
6038                            ==> dihV v w x y <= azim v w x y`,
6039    REPEAT STRIP_TAC THEN
6040      MP_TAC (SPECL [`v:real^3`; `w:real^3`; `x:real^3`; `y:real^3`] AZIM_DIVH) THEN
6041      ASM_REWRITE_TAC[] THEN
6042      COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN
6043      DISCH_TAC THEN
6044      REWRITE_TAC[REAL_ARITH `a <= &2 * b - a <=> a <= b`] THEN
6045      REWRITE_TAC[DIHV_RANGE]);;
6046
6047
6048
6049 let IN_PLANE_NOT_COLLINEAR = prove(`!v n:real^N. ~(v = vec 0) /\ ~(n = vec 0) /\ n dot v = &0 ==> ~collinear {vec 0, n, v}`,
6050    REWRITE_TAC[COLLINEAR_LEMMA_ALT; DE_MORGAN_THM] THEN
6051      REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN
6052      GEN_TAC THEN
6053      ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
6054      DISCH_THEN (MP_TAC o AP_TERM `\v:real^N. n dot v`) THEN
6055      ASM_REWRITE_TAC[DOT_RMUL; EQ_SYM_EQ; REAL_ENTIRE; DOT_EQ_0]);;
6056
6057
6058
6059 let ANGLE_EQ_DIHV = prove(`!v w n:real^N. ~(v = vec 0) /\ ~(w = vec 0) /\ ~(n = vec 0) /\ n dot v = &0 /\ n dot w = &0
6060                            ==> angle (v, vec 0, w) = dihV (vec 0) n v w`,
6061    REPEAT STRIP_TAC THEN
6062      ASM_REWRITE_TAC[angle; dihV; VECTOR_SUB_RZERO; vector_angle; arcV] THEN
6063      CONV_TAC (DEPTH_CONV let_CONV) THEN
6064      ASM_REWRITE_TAC[DOT_SYM; VECTOR_MUL_LZERO; VECTOR_SUB_RZERO; DOT_LMUL; DOT_RMUL; NORM_MUL] THEN
6065      AP_TERM_TAC THEN
6066      REWRITE_TAC[DOT_SQUARE_NORM; REAL_ABS_POW; REAL_ABS_NORM; real_div; REAL_INV_MUL]  THEN
6067      REWRITE_TAC[REAL_ARITH `(nn * nn * vw) * (inn * iv) * inn * iw = (vw * iv * iw) * (nn * inn) * (nn * inn)`] THEN
6068
6069      SUBGOAL_THEN `~(norm (n:real^N) pow 2 = &0)` MP_TAC THENL
6070      [
6071        ASM_REWRITE_TAC[NORM_POW_2; DOT_EQ_0];
6072        ALL_TAC
6073      ] THEN
6074
6075      SIMP_TAC[REAL_MUL_RINV; REAL_MUL_RID]);;
6076
6077
6078
6079 let PYTHAGORAS_PROJECTION = prove(`!x y n:real^N. x dot n = &0 ==> dist (x, y) pow 2 = dist (x, projection n y) pow 2 + dist (projection n y, y) pow 2`,
6080    REPEAT STRIP_TAC THEN
6081      MP_TAC (SPECL [`y:real^N`; `projection (n:real^N) y`; `x:real^N`] PYTHAGORAS) THEN
6082      ANTS_TAC THENL
6083      [
6084        REWRITE_TAC[projection; VECTOR_ARITH `y - (y - a % n) = a % n:real^N`] THEN
6085          REWRITE_TAC[orthogonal; DOT_RSUB; DOT_LMUL; DOT_RMUL] THEN
6086          POP_ASSUM MP_TAC THEN SIMP_TAC[DOT_SYM] THEN DISCH_TAC THEN
6087          REWRITE_TAC[REAL_ENTIRE] THEN
6088          DISJ2_TAC THEN
6089          ASM_CASES_TAC `n dot (n:real^N) = &0` THENL
6090          [
6091            SUBGOAL_THEN `n = vec 0:real^N` ASSUME_TAC THENL
6092              [
6093                ASM_REWRITE_TAC[GSYM DOT_EQ_0];
6094                ALL_TAC
6095              ] THEN
6096              ASM_REWRITE_TAC[DOT_LZERO] THEN
6097              REAL_ARITH_TAC;
6098            ALL_TAC
6099          ] THEN
6100
6101          POP_ASSUM MP_TAC THEN
6102          CONV_TAC REAL_FIELD;
6103        ALL_TAC
6104      ] THEN
6105
6106      REWRITE_TAC[dist] THEN
6107      REAL_ARITH_TAC);;
6108
6109
6110
6111
6112
6113 let OBTUSE_ANGLE_PROJECTION = prove(`!a w n:real^N. pi / &2 < angle (a,vec 0,w) /\ a dot n = &0
6114                                    ==> pi / &2 < angle (a, vec 0, projection n w)`,
6115    REWRITE_TAC[ANGLE_GT_PI2; VECTOR_SUB_RZERO; projection] THEN
6116      SIMP_TAC[DOT_RSUB; DOT_RMUL; REAL_MUL_RZERO; REAL_SUB_RZERO]);;
6117
6118
6119
6120
6121 let XYOFCGX_3_0 = prove(`!V S. packing V /\ S SUBSET V /\ ~affine_dependent S /\
6122                         circumcenter S = vec 0 /\ radV S < sqrt(&2) /\
6123                         CARD S = 3 ==>
6124                         (!u v. u IN S /\ v IN (V DIFF S) ==> dist (v,vec 0) > dist (u,vec 0))`,
6125    REPEAT STRIP_TAC THEN
6126      ASM_CASES_TAC `dist (v,vec 0:real^3) > dist(u,vec 0:real^3)` THEN ASM_REWRITE_TAC[] THEN
6127      POP_ASSUM MP_TAC THEN PURE_REWRITE_TAC[real_gt; REAL_NOT_LT; DIST_SYM] THEN DISCH_TAC THEN
6128
6129      SUBGOAL_THEN `!u:real^3. u IN S ==> dist (u, vec 0) = radV S` (LABEL_TAC "r") THENL
6130      [
6131        REPEAT STRIP_TAC THEN
6132          MP_TAC (ISPEC `S:real^3->bool` OAPVION2) THEN
6133          ASM_REWRITE_TAC[DIST_SYM] THEN
6134          DISCH_THEN (MATCH_MP_TAC o GSYM) THEN
6135          ASM_REWRITE_TAC[];
6136        ALL_TAC
6137      ] THEN
6138
6139      SUBGOAL_THEN `dist (v:real^3, vec 0) <= radV (S:real^3->bool)` ASSUME_TAC THENL
6140      [
6141        MATCH_MP_TAC REAL_LE_TRANS THEN
6142          EXISTS_TAC `dist (u:real^3, vec 0)` THEN
6143          ASM_REWRITE_TAC[REAL_LE_LT] THEN
6144          DISJ2_TAC THEN
6145          FIRST_X_ASSUM MATCH_MP_TAC THEN
6146          ASM_REWRITE_TAC[];
6147        ALL_TAC
6148      ] THEN
6149
6150      SUBGOAL_THEN `~(S = {}:real^3->bool)` ASSUME_TAC THENL
6151      [
6152        DISCH_TAC THEN
6153          UNDISCH_TAC `CARD (S:real^3->bool) = 3` THEN
6154          ASM_REWRITE_TAC[CARD_CLAUSES; ARITH_RULE `~(0 = 3)`];
6155        ALL_TAC
6156      ] THEN
6157
6158      MP_TAC (SPECL [`V:real^3->bool`; `S:real^3->bool`; `vec 0:real^3`; `v:real^3`] XYOFCGX_lemma0) THEN
6159      ASM_REWRITE_TAC[DIST_SYM; ARITH_RULE `1 < 3`; ARCV_ANGLE] THEN
6160      STRIP_TAC THEN
6161
6162      SUBGOAL_THEN `?n:real^3. ~(n = vec 0) /\ (!u. u IN S ==> n dot u = &0)` MP_TAC THENL
6163      [
6164        MP_TAC (ISPEC `S:real^3->bool` LOWDIM_SUBSET_HYPERPLANE) THEN
6165          ANTS_TAC THENL
6166          [
6167            MP_TAC (ISPEC `S:real^3->bool` AFF_DIM_DIM_0) THEN
6168              ANTS_TAC THENL
6169              [
6170                MP_TAC (ISPEC `S:real^3->bool` OAPVION1) THEN
6171                  ASM_REWRITE_TAC[];
6172                ALL_TAC
6173              ] THEN
6174
6175              MP_TAC (ISPEC `S:real^3->bool` AFF_DIM_LE_CARD) THEN
6176              ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE] THEN
6177              REWRITE_TAC[GSYM INT_OF_NUM_LT; DIMINDEX_3] THEN
6178              INT_ARITH_TAC;
6179            ALL_TAC
6180          ] THEN
6181
6182          STRIP_TAC THEN POP_ASSUM MP_TAC THEN
6183          REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_TAC THEN
6184          EXISTS_TAC `a:real^3` THEN
6185          ASM_REWRITE_TAC[] THEN
6186          REPEAT STRIP_TAC THEN
6187          FIRST_X_ASSUM MATCH_MP_TAC THEN
6188          MATCH_MP_TAC IN_TRANS THEN
6189          EXISTS_TAC `S:real^3->bool` THEN
6190          ASM_REWRITE_TAC[SPAN_INC];
6191        ALL_TAC
6192      ] THEN
6193
6194      STRIP_TAC THEN
6195
6196      ABBREV_TAC `w:real^3 = projection n v` THEN
6197      ABBREV_TAC `W = (w:real^3) INSERT S` THEN
6198
6199      SUBGOAL_THEN `(!u:real^3. u IN S ==> ~(u = vec 0)) /\ ~(w:real^3 = vec 0)` STRIP_ASSUME_TAC THENL
6200      [
6201        CONJ_TAC THENL
6202          [
6203            REPEAT STRIP_TAC THEN
6204              MP_TAC (ISPEC `S:real^3->bool` CIRCUMCENTER_NOT_EQ) THEN
6205              ASM_REWRITE_TAC[ARITH_RULE `1 < 3`] THEN
6206              DISCH_THEN (MP_TAC o SPEC `u':real^3`) THEN
6207              ASM_REWRITE_TAC[];
6208            ALL_TAC
6209          ] THEN
6210
6211          DISCH_TAC THEN
6212          MP_TAC (ISPECL [`u:real^3`; `v:real^3`; `n:real^3`] PYTHAGORAS_PROJECTION) THEN
6213          ASM_SIMP_TAC[DOT_SYM] THEN
6214          SUBGOAL_THEN `&4 <= dist (u:real^3, v) pow 2` MP_TAC THENL
6215          [
6216            REWRITE_TAC[REAL_ARITH `&4 = &2 pow 2`] THEN
6217              REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS; dist; REAL_ABS_NORM; REAL_ARITH `abs(&2) = &2`] THEN
6218              REWRITE_TAC[GSYM dist] THEN
6219              UNDISCH_TAC `packing (V:real^3->bool)` THEN
6220              REWRITE_TAC[packing] THEN
6221              DISCH_THEN MATCH_MP_TAC THEN
6222              CONJ_TAC THENL
6223              [
6224                ONCE_REWRITE_TAC[GSYM IN] THEN
6225                  MATCH_MP_TAC IN_TRANS THEN
6226                  EXISTS_TAC `S:real^3->bool` THEN
6227                  ASM_REWRITE_TAC[];
6228                ALL_TAC
6229              ] THEN
6230
6231              CONJ_TAC THENL
6232              [
6233                ONCE_REWRITE_TAC[GSYM IN] THEN
6234                  MATCH_MP_TAC IN_TRANS THEN
6235                  EXISTS_TAC `V DIFF S:real^3->bool` THEN
6236                  ASM_REWRITE_TAC[SUBSET_DIFF];
6237                ALL_TAC
6238              ] THEN
6239
6240              DISCH_TAC THEN UNDISCH_TAC `v:real^3 IN V DIFF S` THEN
6241              ASM_REWRITE_TAC[IN_DIFF; DE_MORGAN_THM] THEN
6242              DISJ2_TAC THEN
6243              POP_ASSUM (fun th -> ASM_REWRITE_TAC[SYM th]);
6244            ALL_TAC
6245          ] THEN
6246
6247          SUBGOAL_THEN `radV (S:real^3->bool) pow 2 + dist (vec 0, v:real^3) pow 2 < &2 + &2` MP_TAC THENL
6248          [
6249            MATCH_MP_TAC REAL_LT_ADD2 THEN
6250              MP_TAC (SPEC `&2` SQRT_WORKS) THEN
6251              REWRITE_TAC[REAL_ARITH `&0 <= &2`] THEN
6252              DISCH_TAC THEN
6253              FIRST_ASSUM (fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN
6254              REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS] THEN
6255              CONJ_TAC THENL
6256              [
6257                SUBGOAL_THEN `abs (radV (S:real^3->bool)) = radV S` (fun th -> REWRITE_TAC[th]) THENL
6258                  [
6259                    REWRITE_TAC[REAL_ABS_REFL] THEN
6260                      REMOVE_THEN "r" (MP_TAC o SPEC `u:real^3`) THEN
6261                      ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
6262                      REWRITE_TAC[dist; NORM_POS_LE];
6263                    ALL_TAC
6264                  ] THEN
6265
6266                  POP_ASSUM MP_TAC THEN
6267                  UNDISCH_TAC `radV (S:real^3->bool) < sqrt (&2)` THEN
6268                  REAL_ARITH_TAC;
6269                ALL_TAC
6270              ] THEN
6271
6272              REWRITE_TAC[dist; REAL_ABS_NORM] THEN REWRITE_TAC[GSYM dist] THEN
6273              MATCH_MP_TAC REAL_LET_TRANS THEN
6274              EXISTS_TAC `radV (S:real^3->bool)` THEN
6275              ASM_REWRITE_TAC[DIST_SYM] THEN
6276              POP_ASSUM MP_TAC THEN UNDISCH_TAC `radV (S:real^3->bool) < sqrt (&2)` THEN
6277              REAL_ARITH_TAC;
6278            ALL_TAC
6279          ] THEN
6280
6281          REAL_ARITH_TAC;
6282        ALL_TAC
6283      ] THEN
6284
6285      REPEAT (FIRST_X_ASSUM ((fun th -> ALL_TAC) o check (free_in `u:real^3` o concl))) THEN
6286
6287      SUBGOAL_THEN `!u:real^3. u IN S ==> pi / &2 < angle (u, vec 0, w)` ASSUME_TAC THENL
6288      [
6289        REPEAT STRIP_TAC THEN
6290          EXPAND_TAC "w" THEN
6291          MATCH_MP_TAC OBTUSE_ANGLE_PROJECTION THEN
6292          CONJ_TAC THENL
6293          [
6294            FIRST_X_ASSUM ((fun th -> ALL_TAC) o SPECL [`v:real^3`; `w:real^3`]) THEN
6295              ONCE_REWRITE_TAC[ANGLE_SYM] THEN
6296              FIRST_X_ASSUM MATCH_MP_TAC THEN
6297              ASM_REWRITE_TAC[];
6298            ALL_TAC
6299          ] THEN
6300
6301          REWRITE_TAC[DOT_SYM] THEN
6302          FIRST_X_ASSUM MATCH_MP_TAC THEN
6303          ASM_REWRITE_TAC[];
6304        ALL_TAC
6305      ] THEN
6306
6307
6308      SUBGOAL_THEN `FINITE (W:real^3->bool) /\ CARD W = 4` ASSUME_TAC THENL
6309      [
6310        UNDISCH_TAC `w:real^3 INSERT S = W` THEN
6311          DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
6312          ASM_SIMP_TAC[FINITE_INSERT; AFFINE_INDEPENDENT_IMP_FINITE; CARD_CLAUSES] THEN
6313          SUBGOAL_THEN `~(w:real^3 IN S)` (fun th -> REWRITE_TAC[th]) THENL
6314          [
6315            DISCH_TAC THEN
6316              FIRST_X_ASSUM (MP_TAC o SPEC `w:real^3`) THEN
6317              ASM_SIMP_TAC[ANGLE_REFL_MID] THEN
6318              MP_TAC PI_POS THEN REAL_ARITH_TAC;
6319            ALL_TAC
6320          ] THEN
6321
6322          ARITH_TAC;
6323        ALL_TAC
6324      ] THEN
6325
6326      MP_TAC (SPECL [`W:real^3->bool`; `n:real^3`; `pi / &2`] ANGLE_SUM_BOUND) THEN
6327      ANTS_TAC THENL
6328      [
6329        ASM_REWRITE_TAC[ARITH_RULE `2 <= 4`] THEN
6330          CONJ_TAC THENL [ MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC ] THEN
6331          EXPAND_TAC "W" THEN
6332          REWRITE_TAC[IN_INSERT] THEN
6333
6334          SUBGOAL_THEN `n dot (w:real^3) = &0` ASSUME_TAC THENL
6335          [
6336            EXPAND_TAC "w" THEN
6337              MP_TAC (ISPECL [`n:real^3`; `v:real^3`] PROJECTION_ORTHOGONAL) THEN
6338              SIMP_TAC[DOT_SYM];
6339            ALL_TAC
6340          ] THEN
6341
6342          REPEAT STRIP_TAC THENL
6343          [
6344            POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[];
6345            MATCH_MP_TAC REAL_LTE_TRANS THEN
6346              EXISTS_TAC `angle (w':real^3, vec 0, w)` THEN
6347              ASM_SIMP_TAC[] THEN
6348              ONCE_REWRITE_TAC[ANGLE_SYM] THEN
6349              ASM_SIMP_TAC[ANGLE_EQ_DIHV] THEN
6350              ASM_SIMP_TAC[IN_PLANE_NOT_COLLINEAR; DIHV_LE_AZIM];
6351            MATCH_MP_TAC REAL_LTE_TRANS THEN
6352              EXISTS_TAC `angle (v':real^3, vec 0, w)` THEN
6353              ASM_SIMP_TAC[ANGLE_EQ_DIHV] THEN
6354              ASM_SIMP_TAC[IN_PLANE_NOT_COLLINEAR; DIHV_LE_AZIM];
6355            MATCH_MP_TAC REAL_LTE_TRANS THEN
6356              EXISTS_TAC `angle (v':real^3, vec 0, w':real^3)` THEN
6357              ASM_SIMP_TAC[ANGLE_EQ_DIHV] THEN
6358              ASM_SIMP_TAC[IN_PLANE_NOT_COLLINEAR; DIHV_LE_AZIM]
6359          ];
6360        ALL_TAC
6361      ] THEN
6362
6363      ASM_REWRITE_TAC[] THEN MP_TAC PI_POS THEN
6364      REAL_ARITH_TAC);;
6365
6366
6367
6368 (* CARD S = 4 *)
6369
6370 let DIHV_GT_PI2 = prove(`!v w x y:real^N. pi / &2 < dihV v w x y <=> cos (dihV v w x y) < &0`,
6371    REPEAT STRIP_TAC THEN
6372      REWRITE_TAC[dihV] THEN
6373      CONV_TAC (DEPTH_CONV let_CONV) THEN
6374      ASM_REWRITE_TAC[ARCV_GT_PI2]);;
6375
6376
6377 let XYOFCGX_4_0 = prove(`!V S. packing V /\ S SUBSET V /\ ~affine_dependent S /\
6378                           circumcenter S = vec 0 /\ radV S < sqrt (&2) /\ CARD S = 4
6379                           ==> (!u v. u IN S /\ v IN V DIFF S ==> dist (v, vec 0) > dist (u, vec 0))`,
6380    REPEAT STRIP_TAC THEN
6381      ASM_CASES_TAC `dist (v,vec 0:real^3) > dist(u,vec 0:real^3)` THEN ASM_REWRITE_TAC[] THEN
6382      POP_ASSUM MP_TAC THEN PURE_REWRITE_TAC[real_gt; REAL_NOT_LT; DIST_SYM] THEN DISCH_TAC THEN
6383
6384      SUBGOAL_THEN `!u:real^3. u IN S ==> dist (u, vec 0) = radV S` (LABEL_TAC "r") THENL
6385      [
6386        REPEAT STRIP_TAC THEN
6387          MP_TAC (ISPEC `S:real^3->bool` OAPVION2) THEN
6388          ASM_REWRITE_TAC[DIST_SYM] THEN
6389          DISCH_THEN (MATCH_MP_TAC o GSYM) THEN
6390          ASM_REWRITE_TAC[];
6391        ALL_TAC
6392      ] THEN
6393
6394      SUBGOAL_THEN `dist (v:real^3, vec 0) <= radV (S:real^3->bool)` ASSUME_TAC THENL
6395      [
6396        MATCH_MP_TAC REAL_LE_TRANS THEN
6397          EXISTS_TAC `dist (u:real^3, vec 0)` THEN
6398          ASM_REWRITE_TAC[REAL_LE_LT] THEN
6399          DISJ2_TAC THEN
6400          FIRST_X_ASSUM MATCH_MP_TAC THEN
6401          ASM_REWRITE_TAC[];
6402        ALL_TAC
6403      ] THEN
6404
6405      SUBGOAL_THEN `~(S = {}:real^3->bool)` ASSUME_TAC THENL
6406      [
6407        DISCH_TAC THEN
6408          UNDISCH_TAC `CARD (S:real^3->bool) = 4` THEN
6409          ASM_REWRITE_TAC[CARD_CLAUSES; ARITH_RULE `~(0 = 4)`];
6410        ALL_TAC
6411      ] THEN
6412
6413      MP_TAC (SPECL [`V:real^3->bool`; `S:real^3->bool`; `vec 0:real^3`; `v:real^3`] XYOFCGX_lemma0) THEN
6414      ASM_REWRITE_TAC[DIST_SYM; ARITH_RULE `1 < 4`] THEN
6415      STRIP_TAC THEN
6416
6417      REPEAT (FIRST_X_ASSUM ((fun th -> ALL_TAC) o check (free_in `u:real^3` o concl))) THEN
6418
6419      SUBGOAL_THEN `!u:real^3. u IN S ==> ~collinear {vec 0, v, u}` ASSUME_TAC THENL
6420      [
6421        REPEAT STRIP_TAC THEN
6422          POP_ASSUM MP_TAC THEN
6423          PURE_REWRITE_TAC[CONJUNCT1 Collect_geom.PER_SET3] THEN
6424          REWRITE_TAC[COLLINEAR_LEMMA_ALT; DE_MORGAN_THM] THEN
6425          CONJ_TAC THENL
6426          [
6427            MP_TAC (ISPEC `S:real^3->bool` CIRCUMCENTER_NOT_EQ) THEN
6428              ASM_REWRITE_TAC[ARITH_RULE `1 < 4`] THEN
6429              ASM_SIMP_TAC[];
6430            ALL_TAC
6431          ] THEN
6432
6433          REWRITE_TAC[NOT_EXISTS_THM] THEN GEN_TAC THEN DISCH_TAC THEN
6434          SUBGOAL_THEN `?w:real^3. w IN S /\ ~(u = w)` CHOOSE_TAC THENL
6435          [
6436            SUBGOAL_THEN `~(S DELETE u:real^3 = {})` MP_TAC THENL
6437              [
6438                DISCH_THEN (MP_TAC o AP_TERM `\s:real^3->bool. CARD s`) THEN
6439                  ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE; FINITE_DELETE; CARD_DELETE; CARD_CLAUSES] THEN
6440                  ARITH_TAC;
6441                ALL_TAC
6442              ] THEN
6443
6444              REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_DELETE] THEN
6445              STRIP_TAC THEN
6446              EXISTS_TAC `x:real^3` THEN ASM_REWRITE_TAC[];
6447            ALL_TAC
6448          ] THEN
6449
6450          FIRST_X_ASSUM (MP_TAC o SPECL [`u:real^3`; `w:real^3`]) THEN
6451          FIRST_ASSUM (MP_TAC o SPEC `w:real^3`) THEN
6452          FIRST_X_ASSUM (MP_TAC o SPEC `u:real^3`) THEN
6453          ASM_REWRITE_TAC[ARCV_ANGLE; ANGLE_GT_PI2; VECTOR_SUB_RZERO; DOT_LMUL] THEN
6454          DISCH_TAC THEN
6455          SUBGOAL_THEN `c < &0` MP_TAC THENL
6456          [
6457            POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
6458              REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN
6459              MATCH_MP_TAC REAL_LE_MUL THEN
6460              ASM_REWRITE_TAC[DOT_POS_LE];
6461            ALL_TAC
6462          ] THEN
6463
6464          DISCH_TAC THEN
6465          ASM_CASES_TAC `u dot w:real^3 < &0` THEN ASM_REWRITE_TAC[] THEN
6466          REWRITE_TAC[REAL_NOT_LT] THEN
6467          ONCE_REWRITE_TAC[REAL_ARITH `a * b = (--a) * (--b)`] THEN
6468          MATCH_MP_TAC REAL_LE_MUL THEN
6469          ASM_REWRITE_TAC[REAL_NEG_GE0; REAL_LE_LT];
6470        ALL_TAC
6471      ] THEN
6472
6473      MP_TAC (SPECL [`S:real^3->bool`; `v:real^3`; `pi / &2`] ANGLE_SUM_BOUND) THEN
6474      ANTS_TAC THENL
6475      [
6476        ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE; ARITH_RULE `2 <= 4`] THEN
6477          CONJ_TAC THENL [ MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC ] THEN
6478          X_GEN_TAC `u:real^3` THEN X_GEN_TAC `w:real^3` THEN
6479          STRIP_TAC THEN
6480          MATCH_MP_TAC REAL_LTE_TRANS THEN
6481          EXISTS_TAC `dihV (vec 0:real^3) v u w` THEN
6482
6483          CONJ_TAC THENL
6484          [
6485            REWRITE_TAC[DIHV_GT_PI2] THEN
6486              MP_TAC (ISPECL [`vec 0:real^3`; `u:real^3`; `w:real^3`; `v:real^3`] Trigonometry.RLXWSTK) THEN
6487              ASM_SIMP_TAC[] THEN
6488              CONV_TAC (DEPTH_CONV let_CONV) THEN
6489              DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
6490              REWRITE_TAC[REAL_ARITH `(a - b) / c < &0 <=> &0 < (b + --a) / c`] THEN
6491              MATCH_MP_TAC REAL_LT_DIV THEN
6492              CONJ_TAC THENL
6493              [
6494                MATCH_MP_TAC REAL_LT_ADD THEN
6495                  CONJ_TAC THENL
6496                  [
6497                    ONCE_REWRITE_TAC[REAL_ARITH `a * b = (--a) * (--b)`] THEN
6498                      MATCH_MP_TAC REAL_LT_MUL THEN
6499                      REWRITE_TAC[REAL_NEG_GT0; GSYM ARCV_GT_PI2] THEN
6500                      ASM_SIMP_TAC[];
6501                    ALL_TAC
6502                  ] THEN
6503
6504                  REWRITE_TAC[REAL_NEG_GT0; GSYM ARCV_GT_PI2] THEN
6505                  ASM_SIMP_TAC[];
6506                ALL_TAC
6507              ] THEN
6508
6509              MATCH_MP_TAC REAL_LT_MUL THEN
6510              REWRITE_TAC[ARCV_ANGLE; REAL_LT_LE; SIN_ANGLE_POS] THEN
6511
6512              CONJ_TAC THENL
6513              [
6514                FIRST_X_ASSUM (MP_TAC o SPEC `w:real^3`) THEN
6515                  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
6516                  MP_TAC (ISPECL [`v:real^3`; `vec 0:real^3`; `w:real^3`] COLLINEAR_SIN_ANGLE) THEN
6517                  ANTS_TAC THENL
6518                  [
6519                    POP_ASSUM MP_TAC THEN SIMP_TAC[COLLINEAR_LEMMA; DE_MORGAN_THM];
6520                    ALL_TAC
6521                  ] THEN
6522                  DISCH_TAC THEN
6523                  DISCH_THEN (MP_TAC o SYM) THEN
6524                  POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
6525                  POP_ASSUM MP_TAC THEN
6526                  REWRITE_TAC[Collect_geom.PER_SET3];
6527
6528                FIRST_X_ASSUM (MP_TAC o SPEC `u:real^3`) THEN
6529                  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
6530                  MP_TAC (ISPECL [`v:real^3`; `vec 0:real^3`; `u:real^3`] COLLINEAR_SIN_ANGLE) THEN
6531                  ANTS_TAC THENL
6532                  [
6533                    POP_ASSUM MP_TAC THEN SIMP_TAC[COLLINEAR_LEMMA; DE_MORGAN_THM];
6534                    ALL_TAC
6535                  ] THEN
6536                  DISCH_TAC THEN
6537                  DISCH_THEN (MP_TAC o SYM) THEN
6538                  POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
6539                  POP_ASSUM MP_TAC THEN
6540                  REWRITE_TAC[Collect_geom.PER_SET3]
6541              ];
6542            ALL_TAC
6543          ] THEN
6544
6545          MATCH_MP_TAC DIHV_LE_AZIM THEN
6546          ASM_SIMP_TAC[];
6547        ALL_TAC
6548      ] THEN
6549
6550      ASM_REWRITE_TAC[] THEN MP_TAC PI_POS THEN
6551      REAL_ARITH_TAC);;
6552
6553
6554
6555 (***********)
6556 (* XYOFCGX *)
6557 (***********)
6558
6559 let XYOFCGX = prove(`!V S (p:real^3). packing V /\ S SUBSET V /\ ~affine_dependent S /\
6560                       (p = circumcenter S) /\ (radV S < sqrt(&2)) ==>
6561                       (!u v. u IN S /\ v IN (V DIFF S) ==> dist(v,p) > dist(u,p))`,
6562    REPEAT GEN_TAC THEN STRIP_TAC THEN
6563      ASM_CASES_TAC `S = {}:real^3->bool` THENL
6564      [
6565        ASM_REWRITE_TAC[NOT_IN_EMPTY];
6566        ALL_TAC
6567      ] THEN
6568
6569      ABBREV_TAC `W = IMAGE (\x:real^3. --p + x) V` THEN
6570      ABBREV_TAC `K = IMAGE (\x:real^3. --p + x) S` THEN
6571      SUBGOAL_THEN `(!u v:real^3. u IN K /\ v IN W DIFF K ==> dist (v,vec 0) > dist(u,vec 0)) ==> (!u v:real^3. u IN S /\ v IN V DIFF S ==> dist (v,p) > dist(u,p))` MP_TAC THENL
6572      [
6573        POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
6574          POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
6575          REPEAT STRIP_TAC THEN
6576          FIRST_X_ASSUM (MP_TAC o SPECL [`--p + u:real^3`; `--p + v:real^3`]) THEN
6577          REWRITE_TAC[dist; VECTOR_SUB_RZERO; VECTOR_ARITH `--a + b = b - a:real^3`] THEN
6578          DISCH_THEN MATCH_MP_TAC THEN
6579          REWRITE_TAC[IN_IMAGE; IN_DIFF] THEN
6580          POP_ASSUM MP_TAC THEN REWRITE_TAC[IN_DIFF] THEN DISCH_TAC THEN
6581          REPEAT CONJ_TAC THENL
6582          [
6583            EXISTS_TAC `u:real^3` THEN ASM_REWRITE_TAC[];
6584            EXISTS_TAC `v:real^3` THEN ASM_REWRITE_TAC[];
6585            REWRITE_TAC[VECTOR_ARITH `v - p = x - p <=> x = v:real^3`; NOT_EXISTS_THM; DE_MORGAN_THM] THEN
6586              GEN_TAC THEN
6587              ASM_CASES_TAC `x = v:real^3` THEN ASM_REWRITE_TAC[]
6588          ];
6589        ALL_TAC
6590      ] THEN
6591
6592      DISCH_THEN MATCH_MP_TAC THEN
6593      SUBGOAL_THEN `packing W /\ K SUBSET W /\ ~affine_dependent K /\ circumcenter K = vec 0:real^3 /\ radV K < sqrt (&2)` STRIP_ASSUME_TAC THENL
6594      [
6595        REPEAT CONJ_TAC THENL
6596          [
6597            UNDISCH_TAC `packing (V:real^3->bool)` THEN
6598              EXPAND_TAC "W" THEN
6599              REWRITE_TAC[packing] THEN
6600              REWRITE_TAC[IMAGE; IN_ELIM_THM; IN] THEN
6601              REPEAT STRIP_TAC THEN
6602              FIRST_X_ASSUM (MP_TAC o SPECL [`x:real^3`; `x':real^3`]) THEN
6603              POP_ASSUM MP_TAC THEN
6604              ASM_REWRITE_TAC[VECTOR_ARITH `--p + x = --p + x' <=> x = x':real^3`] THEN
6605              SIMP_TAC[dist; VECTOR_ARITH `(--p + x) - (--p + x') = x - x':real^3`];
6606
6607            EXPAND_TAC "K" THEN EXPAND_TAC "W" THEN
6608              ASM_SIMP_TAC[IMAGE_SUBSET];
6609
6610            EXPAND_TAC "K" THEN
6611              ASM_REWRITE_TAC[AFFINE_DEPENDENT_TRANSLATION_EQ];
6612
6613            EXPAND_TAC "K" THEN
6614              MP_TAC (ISPECL [`S:real^3->bool`; `--p:real^3`] CIRCUMCENTER_TRANSLATION) THEN
6615              ASM_REWRITE_TAC[VECTOR_ARITH `--p + p = vec 0:real^3`];
6616
6617            MP_TAC (ISPECL [`S:real^3->bool`; `--p:real^3`] RADV_TRANSLATION) THEN
6618              ASM_SIMP_TAC[]
6619          ];
6620        ALL_TAC
6621      ] THEN
6622
6623      REPLICATE_TAC 5 (POP_ASSUM MP_TAC) THEN
6624      REPEAT REMOVE_ASSUM THEN REPEAT DISCH_TAC THEN
6625
6626      MP_TAC (ISPEC `K:real^3->bool` AFFINE_INDEPENDENT_CARD_LE) THEN
6627      ASM_REWRITE_TAC[DIMINDEX_3; ARITH_RULE `a <= 3 + 1 <=> a < 5`; Hypermap_and_fan.gen_NUM_CASES 5] THEN
6628      DISCH_THEN STRIP_ASSUME_TAC THENL
6629      [
6630        POP_ASSUM MP_TAC THEN
6631          ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE; CARD_EQ_0; NOT_IN_EMPTY];
6632
6633        MATCH_MP_TAC XYOFCGX_1 THEN ASM_REWRITE_TAC[LE_REFL];
6634        MATCH_MP_TAC XYOFCGX_2 THEN ASM_REWRITE_TAC[];
6635        MATCH_MP_TAC XYOFCGX_3_0 THEN ASM_REWRITE_TAC[];
6636        MATCH_MP_TAC XYOFCGX_4_0 THEN ASM_REWRITE_TAC[]
6637      ]);;
6638
6639
6640
6641 (****************************************************)
6642
6643 (*******************************************)
6644 (* XNHPWAB begins here                     *)
6645 (*******************************************)
6646
6647
6648 (* XNHPWAB1 *)
6649
6650 let BARV_AFFINE_INDEPENDENT = prove(`!V ul k. packing V /\ barV V k ul
6651                                       ==> ~affine_dependent (set_of_list ul)`,
6652    REPEAT GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN
6653      REWRITE_TAC[AFFINE_INDEPENDENT_IFF_CARD] THEN
6654      ASM_REWRITE_TAC[FINITE_SET_OF_LIST] THEN
6655      MP_TAC (SPEC_ALL MHFTTZN1) THEN
6656      ANTS_TAC THENL
6657      [
6658        ASM_REWRITE_TAC[] THEN
6659          MATCH_MP_TAC BARV_IMP_K_LE_3 THEN
6660          MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `ul:(real^3)list`] THEN
6661          ASM_REWRITE_TAC[];
6662        ALL_TAC
6663      ] THEN
6664      DISCH_TAC THEN
6665      MP_TAC (ISPEC `set_of_list ul:real^3->bool` AFF_DIM_LE_CARD) THEN
6666      ASM_REWRITE_TAC[FINITE_SET_OF_LIST] THEN
6667      SUBGOAL_THEN `(CARD (set_of_list ul:real^3->bool)) <= k + 1` MP_TAC THENL
6668      [
6669        UNDISCH_TAC `barV V k ul` THEN
6670          REWRITE_TAC[BARV] THEN
6671          DISCH_THEN (fun th -> REWRITE_TAC[GSYM th]) THEN
6672          REWRITE_TAC[CARD_SET_OF_LIST_LE];
6673        ALL_TAC
6674      ] THEN
6675      REWRITE_TAC[GSYM INT_OF_NUM_LE; GSYM INT_OF_NUM_ADD] THEN
6676      INT_ARITH_TAC);;
6677
6678
6679 (* barV v k ul ==> LENGTH ul = CARD (set_of_list ul) *)
6680 let BARV_IMP_LENGTH_EQ_CARD = prove(`!V ul k. packing V /\ barV V k ul
6681                                       ==> LENGTH ul = k + 1 /\ CARD (set_of_list ul) = k + 1`,
6682    REPEAT GEN_TAC THEN STRIP_TAC THEN
6683      SUBGOAL_THEN `LENGTH (ul:(real^3)list) = k + 1` ASSUME_TAC THENL [ POP_ASSUM MP_TAC THEN SIMP_TAC[BARV]; ALL_TAC ] THEN
6684      ASM_REWRITE_TAC[] THEN
6685      MP_TAC (SPEC_ALL BARV_AFFINE_INDEPENDENT) THEN
6686      ASM_REWRITE_TAC[AFFINE_INDEPENDENT_IFF_CARD; FINITE_SET_OF_LIST] THEN
6687      MP_TAC (SPEC_ALL MHFTTZN1) THEN
6688      ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
6689      REWRITE_TAC[GSYM INT_OF_NUM_EQ; GSYM INT_OF_NUM_ADD] THEN
6690      INT_ARITH_TAC);;
6691
6692
6693
6694 let AFFINE_HULL_PROJECTION_EXISTS = prove(`!S p:real^N. ~(S = {}) ==> ?x n. p = x + n /\ x IN affine hull S /\
6695                                               (!v w. v IN S /\ w IN S ==> (v - w) dot n = &0)`,
6696    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
6697      REPEAT STRIP_TAC THEN
6698      ABBREV_TAC `V = IMAGE (\v:real^N. --x + v) S` THEN
6699      ABBREV_TAC `p0:real^N = --x + p` THEN
6700      SUBGOAL_THEN `?y n:real^N. p0 = y + n /\ y IN affine hull V /\ (!z. z IN V ==> z dot n = &0)` MP_TAC THENL
6701      [
6702        MP_TAC (ISPECL [`V:real^N->bool`; `p0:real^N`] ORTHOGONAL_SUBSPACE_DECOMP_EXISTS) THEN
6703          REWRITE_TAC[orthogonal] THEN
6704          STRIP_TAC THEN
6705          MAP_EVERY EXISTS_TAC [`y:real^N`; `z:real^N`] THEN
6706          ASM_REWRITE_TAC[] THEN
6707          CONJ_TAC THENL
6708          [
6709            MP_TAC (ISPEC `V:real^N->bool` AFFINE_HULL_EQ_SPAN) THEN
6710              ANTS_TAC THENL
6711              [
6712                EXPAND_TAC "V" THEN
6713                  REWRITE_TAC[AFFINE_HULL_TRANSLATION; IN_IMAGE] THEN
6714                  EXISTS_TAC `x:real^N` THEN
6715                  REWRITE_TAC[VECTOR_ARITH `vec 0 = --x + x:real^N`] THEN
6716                  MATCH_MP_TAC IN_TRANS THEN
6717                  EXISTS_TAC `S:real^N->bool` THEN
6718                  ASM_REWRITE_TAC[HULL_SUBSET];
6719                ALL_TAC
6720              ] THEN
6721
6722              ASM_SIMP_TAC[];
6723            ALL_TAC
6724          ] THEN
6725
6726          REPEAT STRIP_TAC THEN
6727          FIRST_X_ASSUM (MP_TAC o SPEC `z':real^N`) THEN
6728          ANTS_TAC THENL
6729          [
6730            MATCH_MP_TAC IN_TRANS THEN
6731              EXISTS_TAC `V:real^N->bool` THEN
6732              ASM_REWRITE_TAC[SPAN_INC];
6733            ALL_TAC
6734          ] THEN
6735          SIMP_TAC[DOT_SYM];
6736        ALL_TAC
6737      ] THEN
6738
6739      STRIP_TAC THEN
6740      MAP_EVERY EXISTS_TAC [`x + y:real^N`; `n:real^N`] THEN
6741      CONJ_TAC THENL
6742      [
6743        UNDISCH_TAC `--x + p = p0:real^N` THEN
6744          ASM_REWRITE_TAC[] THEN
6745          VECTOR_ARITH_TAC;
6746        ALL_TAC
6747      ] THEN
6748
6749      CONJ_TAC THENL
6750      [
6751        UNDISCH_TAC `y:real^N IN affine hull V` THEN
6752          EXPAND_TAC "V" THEN
6753          REWRITE_TAC[AFFINE_HULL_TRANSLATION; IN_IMAGE] THEN
6754          STRIP_TAC THEN
6755          ASM_REWRITE_TAC[VECTOR_ARITH `x + --x + x' = x':real^N`];
6756        ALL_TAC
6757      ] THEN
6758
6759      SUBGOAL_THEN `!v:real^N. v IN S ==> (--x + v) dot n = &0` ASSUME_TAC THENL
6760      [
6761        REPEAT STRIP_TAC THEN
6762          FIRST_X_ASSUM MATCH_MP_TAC THEN
6763          EXPAND_TAC "V" THEN REWRITE_TAC[IN_IMAGE] THEN
6764          EXISTS_TAC `v:real^N` THEN
6765          ASM_REWRITE_TAC[];
6766        ALL_TAC
6767      ] THEN
6768
6769      REPEAT STRIP_TAC THEN
6770      ONCE_REWRITE_TAC[VECTOR_ARITH `v - w = (--x + v) - (--x + w):real^N`] THEN
6771      ONCE_REWRITE_TAC[DOT_LSUB] THEN
6772      ASM_SIMP_TAC[REAL_SUB_RZERO]);;
6773
6774
6775
6776 let AFFINE_HULL_PROJECTION_DIST_EQ = prove(`!S p v w x n:real^N. v IN S /\ w IN S /\ dist (p, v) = dist (p, w) /\
6777                                           p = x + n /\ (!v w. v IN S /\ w IN S ==> (v - w) dot n = &0)
6778                                           ==> dist (x, v) = dist (x, w)`,
6779    REPEAT STRIP_TAC THEN
6780      UNDISCH_TAC `p = x + n:real^N` THEN
6781      REWRITE_TAC[VECTOR_ARITH `p = x + n <=> x = p - n:real^N`] THEN
6782      DISCH_TAC THEN
6783      UNDISCH_TAC `dist (p,v) = dist(p,w:real^N)` THEN
6784      ASM_REWRITE_TAC[DIST_EQ; dist; NORM_POW_2] THEN
6785      ONCE_REWRITE_TAC[VECTOR_ARITH `p - n - v = (p - v) - n:real^N`] THEN
6786      ABBREV_TAC `a = p - v:real^N` THEN
6787      ABBREV_TAC `b = p - w:real^N` THEN
6788      DISCH_TAC THEN
6789      ASM_REWRITE_TAC[DOT_LSUB; DOT_RSUB; DOT_SYM] THEN
6790      REWRITE_TAC[REAL_ARITH `bb - an - (an - nn) = bb - bn - (bn - nn) <=> an - bn = &0`] THEN
6791      ONCE_REWRITE_TAC[GSYM DOT_LSUB] THEN
6792      EXPAND_TAC "a" THEN EXPAND_TAC "b" THEN
6793      REWRITE_TAC[VECTOR_ARITH `p - v - (p - w) = w - v:real^N`] THEN
6794      FIRST_X_ASSUM MATCH_MP_TAC THEN
6795      ASM_REWRITE_TAC[]);;
6796
6797
6798
6799 let ORTHOGONAL_TO_AFFINE_HULL_EQ = prove(`!S n:real^N. (!v w. v IN S /\ w IN S ==> (v - w) dot n = &0) <=>
6800                                              (!v w. v IN affine hull S /\ w IN affine hull S ==> (v - w) dot n = &0)`,
6801    REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
6802      [
6803        ASM_CASES_TAC `S = {}:real^N->bool` THENL
6804        [
6805          UNDISCH_TAC `w:real^N IN affine hull S` THEN
6806            ASM_REWRITE_TAC[AFFINE_HULL_EMPTY; NOT_IN_EMPTY];
6807          ALL_TAC
6808        ] THEN
6809
6810        POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
6811        STRIP_TAC THEN
6812        MP_TAC (ISPEC `(IMAGE (\v:real^N. --x + v) S)` ORTHOGONAL_TO_SPAN_EQ) THEN
6813        DISCH_THEN (MP_TAC o SPEC `n:real^N`) THEN
6814        REWRITE_TAC[orthogonal] THEN
6815        SUBGOAL_THEN `span (IMAGE (\v:real^N. --x + v) S) = affine hull (IMAGE (\v:real^N. --x + v) S)` (fun th -> REWRITE_TAC[th]) THENL
6816        [
6817          MATCH_MP_TAC (GSYM AFFINE_HULL_EQ_SPAN) THEN
6818            REWRITE_TAC[AFFINE_HULL_TRANSLATION; IN_IMAGE] THEN
6819            EXISTS_TAC `x:real^N` THEN
6820            REWRITE_TAC[VECTOR_ARITH `vec 0 = --x + x:real^N`] THEN
6821            MATCH_MP_TAC IN_TRANS THEN
6822            EXISTS_TAC `S:real^N->bool` THEN
6823            ASM_REWRITE_TAC[HULL_SUBSET];
6824          ALL_TAC
6825        ] THEN
6826
6827        ONCE_REWRITE_TAC[TAUT `(A <=> B) <=> ((B ==> A) /\ (A ==> B))`] THEN
6828        DISCH_THEN (CONJUNCTS_THEN2 MP_TAC (fun th -> ALL_TAC)) THEN
6829        REWRITE_TAC[AFFINE_HULL_TRANSLATION; IN_IMAGE] THEN
6830        ANTS_TAC THENL
6831        [
6832          REPEAT STRIP_TAC THEN
6833            ONCE_REWRITE_TAC[DOT_SYM] THEN
6834            ASM_REWRITE_TAC[VECTOR_ARITH `--x + x' = x' - x:real^N`] THEN
6835            FIRST_X_ASSUM MATCH_MP_TAC THEN
6836            ASM_REWRITE_TAC[];
6837          ALL_TAC
6838        ] THEN
6839
6840        DISCH_TAC THEN
6841        SUBGOAL_THEN `!v:real^N. v IN affine hull S ==> (v - x) dot n = &0` ASSUME_TAC THENL
6842        [
6843          REPEAT STRIP_TAC THEN
6844            REWRITE_TAC[DOT_SYM] THEN
6845            FIRST_X_ASSUM MATCH_MP_TAC THEN
6846            EXISTS_TAC `v':real^N` THEN
6847            ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC;
6848          ALL_TAC
6849        ] THEN
6850
6851        ONCE_REWRITE_TAC[VECTOR_ARITH `v - w = (v - x) - (w - x):real^N`] THEN
6852        ONCE_REWRITE_TAC[DOT_LSUB] THEN
6853        ASM_SIMP_TAC[REAL_SUB_RZERO];
6854        ALL_TAC
6855      ] THEN
6856
6857      FIRST_X_ASSUM MATCH_MP_TAC THEN
6858      CONJ_TAC THEN MATCH_MP_TAC IN_TRANS THEN EXISTS_TAC `S:real^N->bool` THEN ASM_REWRITE_TAC[HULL_SUBSET]);;
6859
6860
6861
6862
6863 let AFFINE_HULL_PROJECTION_DIST_LE = prove(`!S p v x n:real^N. v IN S /\
6864                                              p = x + n /\ x IN affine hull S /\ (!v w. v IN S /\ w IN S ==> (v - w) dot n = &0)
6865                                              ==> dist (x, v) <= dist (p, v)`,
6866    REPEAT STRIP_TAC THEN
6867      REWRITE_TAC[dist] THEN
6868      ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN
6869      ASM_REWRITE_TAC[REAL_LE_SQUARE_ABS; NORM_POW_2; VECTOR_ARITH `(x + n) - v = (x - v) + n:real^N`] THEN
6870      ABBREV_TAC `a = x - v:real^N` THEN
6871      REWRITE_TAC[DOT_LADD; DOT_RADD; DOT_SYM] THEN
6872      SUBGOAL_THEN `a dot n = &0 /\ &0 <= n dot n:real^N` MP_TAC THENL
6873      [
6874        REWRITE_TAC[DOT_POS_LE] THEN
6875          EXPAND_TAC "a" THEN
6876          REMOVE_ASSUM THEN POP_ASSUM MP_TAC THEN
6877          ONCE_REWRITE_TAC[ORTHOGONAL_TO_AFFINE_HULL_EQ] THEN
6878          DISCH_THEN MATCH_MP_TAC THEN
6879          ASM_REWRITE_TAC[] THEN
6880          MATCH_MP_TAC IN_TRANS THEN EXISTS_TAC `S:real^N->bool` THEN ASM_REWRITE_TAC[HULL_SUBSET];
6881        ALL_TAC
6882      ] THEN
6883
6884      REAL_ARITH_TAC);;
6885
6886
6887
6888
6889 let AFFINE_HULL_PROJECTION_DIST_LT = prove(`!S p v x n:real^N. v IN S /\ ~(p IN affine hull S) /\
6890                                              p = x + n /\ x IN affine hull S /\ (!v w. v IN S /\ w IN S ==> (v - w) dot n = &0)
6891                                              ==> dist (x, v) < dist (p, v)`,
6892    REPEAT STRIP_TAC THEN
6893      REWRITE_TAC[dist] THEN
6894      ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN
6895      ASM_REWRITE_TAC[REAL_LT_SQUARE_ABS; NORM_POW_2; VECTOR_ARITH `(x + n) - v = (x - v) + n:real^N`] THEN
6896      ABBREV_TAC `a = x - v:real^N` THEN
6897      REWRITE_TAC[DOT_LADD; DOT_RADD; DOT_SYM] THEN
6898      SUBGOAL_THEN `a dot n = &0 /\ &0 < n dot n:real^N` MP_TAC THENL
6899      [
6900        REWRITE_TAC[DOT_POS_LT] THEN
6901          CONJ_TAC THENL
6902          [
6903            EXPAND_TAC "a" THEN
6904              REMOVE_ASSUM THEN POP_ASSUM MP_TAC THEN
6905              ONCE_REWRITE_TAC[ORTHOGONAL_TO_AFFINE_HULL_EQ] THEN
6906              DISCH_THEN MATCH_MP_TAC THEN
6907              ASM_REWRITE_TAC[] THEN
6908              MATCH_MP_TAC IN_TRANS THEN EXISTS_TAC `S:real^N->bool` THEN ASM_REWRITE_TAC[HULL_SUBSET];
6909            DISCH_TAC THEN UNDISCH_TAC `p = x + n:real^N` THEN
6910              ASM_REWRITE_TAC[VECTOR_ADD_RID] THEN DISCH_TAC THEN
6911              UNDISCH_TAC `~(p:real^N IN affine hull S)` THEN
6912              ASM_REWRITE_TAC[]
6913          ];
6914        ALL_TAC
6915      ] THEN
6916
6917      REAL_ARITH_TAC);;
6918
6919
6920
6921
6922
6923 let AFFINE_HULL_CIRCUMCENTER_PROJECTION = prove(`!s t:real^N->bool. ~affine_dependent s /\ t SUBSET s /\ ~(t = {})
6924                                                   ==> ?n. circumcenter s = circumcenter t + n /\
6925                                                       (!v w. v IN t /\ w IN t ==> (v - w) dot n = &0)`,
6926    REPEAT STRIP_TAC THEN
6927      ABBREV_TAC `p0:real^N = circumcenter t` THEN
6928      ABBREV_TAC `p:real^N = circumcenter s` THEN
6929
6930      MP_TAC (SPECL [`t:real^N->bool`; `p:real^N`] AFFINE_HULL_PROJECTION_EXISTS) THEN
6931      ASM_REWRITE_TAC[] THEN
6932      STRIP_TAC THEN
6933      EXISTS_TAC `n:real^N` THEN
6934      ASM_REWRITE_TAC[VECTOR_ARITH `x + n = p0 + n <=> x = p0:real^N`] THEN
6935      EXPAND_TAC "p0" THEN
6936      MP_TAC (SPEC `t:real^N->bool` OAPVION3) THEN
6937      ANTS_TAC THENL
6938      [
6939        MATCH_MP_TAC AFFINE_INDEPENDENT_SUBSET THEN
6940          EXISTS_TAC `s:real^N->bool` THEN
6941          ASM_REWRITE_TAC[];
6942        ALL_TAC
6943      ] THEN
6944
6945      DISCH_THEN MATCH_MP_TAC THEN
6946      ASM_REWRITE_TAC[] THEN
6947      UNDISCH_TAC `~(t = {}:real^N->bool)` THEN
6948      REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
6949      STRIP_TAC THEN
6950      EXISTS_TAC `dist (x, x':real^N)` THEN
6951      REPEAT STRIP_TAC THEN
6952      MATCH_MP_TAC AFFINE_HULL_PROJECTION_DIST_EQ THEN
6953      MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `p:real^N`; `n:real^N`] THEN
6954      ASM_REWRITE_TAC[] THEN
6955      MP_TAC (SPEC `s:real^N->bool` OAPVION2) THEN
6956      ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
6957      FIRST_ASSUM (MP_TAC o SPEC `x':real^N`) THEN
6958      FIRST_X_ASSUM (MP_TAC o SPEC `w:real^N`) THEN
6959      UNDISCH_TAC `t SUBSET s:real^N->bool` THEN
6960      REWRITE_TAC[SUBSET] THEN DISCH_TAC THEN
6961      ASM_SIMP_TAC[]);;
6962
6963
6964 let AFFINE_HULL_CIRCUMCENTER_EQ = prove(`!s t:real^N->bool. ~affine_dependent s /\ t SUBSET s /\ ~(t = {}) /\ circumcenter s IN affine hull t
6965                                           ==> circumcenter s = circumcenter t`,
6966    REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN
6967      MP_TAC (SPEC `t:real^N->bool` OAPVION3) THEN
6968      ANTS_TAC THENL
6969      [
6970        MATCH_MP_TAC AFFINE_INDEPENDENT_SUBSET THEN
6971          EXISTS_TAC `s:real^N->bool` THEN
6972          ASM_REWRITE_TAC[SUBSET];
6973        ALL_TAC
6974      ] THEN
6975      DISCH_THEN MATCH_MP_TAC THEN
6976      ASM_REWRITE_TAC[] THEN
6977      EXISTS_TAC `radV (s:real^N->bool)` THEN
6978      REPEAT STRIP_TAC THEN
6979      MP_TAC (SPEC `s:real^N->bool` OAPVION2) THEN
6980      ASM_REWRITE_TAC[] THEN
6981      DISCH_THEN (MP_TAC o SPEC `w:real^N`) THEN
6982      ASM_SIMP_TAC[]);;
6983
6984
6985
6986 let AFFINE_HULL_RADV = prove(`!s t:real^N->bool. ~affine_dependent s /\ t SUBSET s /\ ~(t = {})
6987                               ==> radV s pow 2 = radV t pow 2 + dist (circumcenter t, circumcenter s) pow 2 /\
6988                                   &0 <= radV s /\ &0 <= radV t`,
6989    REWRITE_TAC[SUBSET] THEN
6990      REPEAT GEN_TAC THEN STRIP_TAC THEN
6991      FIRST_ASSUM MP_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN STRIP_TAC THEN
6992      SUBGOAL_THEN `~affine_dependent (t:real^N->bool)` ASSUME_TAC THENL
6993      [
6994        MATCH_MP_TAC AFFINE_INDEPENDENT_SUBSET THEN
6995          EXISTS_TAC `s:real^N->bool` THEN
6996          ASM_REWRITE_TAC[SUBSET];
6997        ALL_TAC
6998      ] THEN
6999
7000      MP_TAC (SPEC_ALL AFFINE_HULL_CIRCUMCENTER_PROJECTION) THEN
7001      ASM_REWRITE_TAC[SUBSET] THEN
7002      STRIP_TAC THEN
7003      POP_ASSUM (LABEL_TAC "vw") THEN
7004      MP_TAC (SPEC `s:real^N->bool` OAPVION2) THEN
7005      MP_TAC (SPEC `t:real^N->bool` OAPVION2) THEN
7006      ASM_REWRITE_TAC[] THEN
7007      DISCH_THEN (MP_TAC o SPEC `x:real^N`) THEN
7008      ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
7009      DISCH_THEN (MP_TAC o SPEC `x:real^N`) THEN
7010      ASM_SIMP_TAC[] THEN DISCH_TAC THEN
7011      REWRITE_TAC[DIST_POS_LE] THEN
7012      REWRITE_TAC[dist; NORM_POW_2; VECTOR_ARITH `a - (a + n) = --n:real^N`; VECTOR_ARITH `(a + n) - x = (a - x) + n:real^N`] THEN
7013      REWRITE_TAC[DOT_LADD; DOT_RADD; DOT_LNEG; DOT_RNEG; DOT_SYM; REAL_NEG_NEG] THEN
7014      REWRITE_TAC[REAL_ARITH `(a + b) + b + c = a + c <=> b = &0`] THEN
7015      ONCE_REWRITE_TAC[DOT_SYM] THEN
7016      REMOVE_THEN "vw" MP_TAC THEN ONCE_REWRITE_TAC[ORTHOGONAL_TO_AFFINE_HULL_EQ] THEN
7017      DISCH_THEN MATCH_MP_TAC THEN
7018      CONJ_TAC THENL
7019      [
7020        MP_TAC (SPEC `t:real^N->bool` OAPVION1) THEN
7021          ASM_REWRITE_TAC[];
7022        ALL_TAC
7023      ] THEN
7024
7025      MATCH_MP_TAC IN_TRANS THEN EXISTS_TAC `t:real^N->bool` THEN
7026      ASM_REWRITE_TAC[HULL_SUBSET]);;
7027
7028
7029
7030 let RADV_MONO = prove(`!s t:real^N->bool. ~affine_dependent s /\ t SUBSET s /\ ~(t = {})
7031                           ==> radV t <= radV s`,
7032    REPEAT GEN_TAC THEN DISCH_THEN (MP_TAC o MATCH_MP AFFINE_HULL_RADV) THEN
7033      STRIP_TAC THEN
7034      SUBGOAL_THEN `radV (t:real^N->bool) = abs(radV t) /\ radV (s:real^N->bool) = abs(radV s)` (fun th -> ONCE_REWRITE_TAC[th]) THENL
7035      [
7036        ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
7037          ASM_REWRITE_TAC[REAL_ABS_REFL];
7038        ALL_TAC
7039      ] THEN
7040      ASM_REWRITE_TAC[REAL_LE_SQUARE_ABS] THEN
7041      REWRITE_TAC[REAL_ARITH `a <= a + b <=> &0 <= b`] THEN
7042      REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]);;
7043
7044
7045
7046 let HL_PROPERTIES = prove(`!V ul k. packing V /\ barV V k ul ==>
7047                             (!w. w IN set_of_list ul ==> dist (circumcenter (set_of_list ul), w) = hl ul)`,
7048    REPEAT GEN_TAC THEN DISCH_TAC THEN
7049      ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
7050      REWRITE_TAC[HL] THEN
7051      MATCH_MP_TAC OAPVION2 THEN
7052      MATCH_MP_TAC BARV_AFFINE_INDEPENDENT THEN
7053      MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `k:num`] THEN
7054      ASM_REWRITE_TAC[]);;
7055
7056
7057 let BARV_CIRCUMCENTER_EXISTS = prove(`!V ul k. packing V /\ barV V k ul ==>
7058                                        circumcenter (set_of_list ul) IN affine hull (set_of_list ul)`,
7059    REPEAT STRIP_TAC THEN
7060      MATCH_MP_TAC OAPVION1 THEN
7061      CONJ_TAC THENL
7062      [
7063        REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
7064          EXISTS_TAC `HD ul:real^3` THEN
7065          MATCH_MP_TAC HD_IN_SET_OF_LIST THEN
7066          POP_ASSUM MP_TAC THEN REWRITE_TAC[BARV] THEN
7067          ARITH_TAC;
7068        ALL_TAC
7069      ] THEN
7070      MATCH_MP_TAC BARV_AFFINE_INDEPENDENT THEN
7071      MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `k:num`] THEN
7072      ASM_REWRITE_TAC[]);;
7073
7074
7075
7076
7077
7078
7079
7080
7081 let HL_EQ_DIST0 = prove(`!V k ul. packing V /\ barV V k ul ==> hl ul = dist (circumcenter (set_of_list ul), HD ul)`,
7082    REPEAT STRIP_TAC THEN
7083      MP_TAC (SPEC_ALL HL_PROPERTIES) THEN
7084      ASM_REWRITE_TAC[] THEN
7085      DISCH_THEN (MATCH_MP_TAC o GSYM) THEN
7086      MATCH_MP_TAC BARV_IMP_HD_IN_SET_OF_LIST THEN
7087      MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `k:num`] THEN
7088      ASM_REWRITE_TAC[]);;
7089
7090
7091
7092
7093 let BARV_CIRCUMCENTER_PROJECTION = prove(`!V ul k i. packing V /\ ul IN barV V k /\ i <= k
7094                                            ==> let S = set_of_list (truncate_simplex i ul) in
7095                                              (?n. circumcenter (set_of_list ul) = circumcenter S + n /\
7096                                                  (!v w. v IN S /\ w IN S ==> (v - w) dot n = &0))`,
7097    REPEAT STRIP_TAC THEN
7098      UNDISCH_TAC `ul IN barV V k` THEN GEN_REWRITE_TAC LAND_CONV [IN] THEN DISCH_TAC THEN
7099      CONV_TAC let_CONV THEN
7100      ABBREV_TAC `S:real^3->bool = set_of_list (truncate_simplex i ul)` THEN
7101
7102      MATCH_MP_TAC AFFINE_HULL_CIRCUMCENTER_PROJECTION THEN
7103      CONJ_TAC THENL
7104      [
7105        MATCH_MP_TAC BARV_AFFINE_INDEPENDENT THEN
7106          MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `k:num`] THEN
7107          ASM_REWRITE_TAC[];
7108        ALL_TAC
7109      ] THEN
7110
7111      SUBGOAL_THEN `LENGTH (ul:(real^3)list) = k + 1` ASSUME_TAC THENL
7112      [
7113        UNDISCH_TAC `barV V k ul` THEN SIMP_TAC[BARV];
7114        ALL_TAC
7115      ] THEN
7116
7117      CONJ_TAC THENL
7118      [
7119        EXPAND_TAC "S" THEN
7120          MATCH_MP_TAC SET_OF_LIST_TRUNCATE_SIMPLEX_SUBSET THEN
7121          ASM_REWRITE_TAC[ARITH_RULE `i + 1 <= k + 1 <=> i <= k`];
7122        ALL_TAC
7123      ] THEN
7124
7125      EXPAND_TAC "S" THEN
7126      REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
7127      EXISTS_TAC `HD (truncate_simplex i ul):real^3` THEN
7128      MATCH_MP_TAC HD_IN_SET_OF_LIST THEN
7129      MP_TAC (ISPECL [`i:num`; `ul:(real^3)list`] LENGTH_TRUNCATE_SIMPLEX) THEN
7130      ASM_SIMP_TAC[ARITH_RULE `i + 1 <= k + 1 <=> i <= k`; ARITH_RULE `1 <= i + 1`]);;
7131
7132
7133
7134
7135 let HL_DECREASE = prove(`!V ul k i. packing V /\ ul IN barV V k /\ i <= k
7136                         ==> hl (truncate_simplex i ul) <= hl ul`,
7137    REWRITE_TAC[IN] THEN REPEAT STRIP_TAC THEN
7138      MP_TAC (SPEC_ALL HL_PROPERTIES) THEN
7139      ASM_REWRITE_TAC[] THEN
7140      MP_TAC (SPEC_ALL HL_EQ_DIST0) THEN
7141      ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
7142      DISCH_TAC THEN
7143      MP_TAC (SPECL [`V:real^3->bool`; `i:num`; `truncate_simplex i (ul:(real^3)list)`] HL_EQ_DIST0) THEN
7144      SUBGOAL_THEN `barV V i (truncate_simplex i ul)` ASSUME_TAC THENL
7145      [
7146        MATCH_MP_TAC TRUNCATE_SIMPLEX_BARV THEN
7147          EXISTS_TAC `k:num` THEN
7148          ASM_REWRITE_TAC[];
7149        ALL_TAC
7150      ] THEN
7151      ASM_REWRITE_TAC[] THEN
7152      DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
7153
7154      ABBREV_TAC `S:real^3->bool = set_of_list (truncate_simplex i ul)` THEN
7155      ABBREV_TAC `p0:real^3 = circumcenter S` THEN
7156      ABBREV_TAC `p:real^3 = circumcenter (set_of_list ul)` THEN
7157
7158      SUBGOAL_THEN `HD (truncate_simplex i ul):real^3 = HD ul` ASSUME_TAC THENL
7159      [
7160        MATCH_MP_TAC HD_TRUNCATE_SIMPLEX THEN
7161          MATCH_MP_TAC LE_TRANS THEN
7162          EXISTS_TAC `k + 1` THEN
7163          ASM_REWRITE_TAC[ARITH_RULE `i + 1 <= k + 1 <=> i <= k`] THEN
7164          UNDISCH_TAC `barV V k ul` THEN
7165          SIMP_TAC[BARV; LE_REFL];
7166        ALL_TAC
7167      ] THEN
7168      ASM_REWRITE_TAC[] THEN
7169
7170      MATCH_MP_TAC AFFINE_HULL_PROJECTION_DIST_LE THEN
7171      EXISTS_TAC `S:real^3->bool` THEN
7172
7173      MP_TAC (SPEC_ALL BARV_CIRCUMCENTER_PROJECTION) THEN
7174      ANTS_TAC THENL
7175      [
7176        ASM_REWRITE_TAC[IN];
7177        ALL_TAC
7178      ] THEN
7179      CONV_TAC (DEPTH_CONV let_CONV) THEN ASM_REWRITE_TAC[] THEN
7180      STRIP_TAC THEN
7181      EXISTS_TAC `n:real^3` THEN
7182
7183      MP_TAC (SPECL [`V:real^3->bool`; `i:num`; `truncate_simplex i ul:(real^3)list`] BARV_IMP_HD_IN_SET_OF_LIST) THEN
7184      ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
7185      ASM_REWRITE_TAC[] THEN
7186      EXPAND_TAC "p0" THEN
7187      EXPAND_TAC "S" THEN
7188      MATCH_MP_TAC BARV_CIRCUMCENTER_EXISTS THEN
7189      MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `i:num`] THEN
7190      ASM_REWRITE_TAC[]);;
7191
7192
7193
7194 let XNHPWAB1 = prove(`!V ul k. packing V /\ (ul IN barV V k) /\ (hl ul < sqrt(&2)) ==>
7195                        (omega_list V ul = circumcenter (set_of_list ul))`,
7196    REWRITE_TAC[IN] THEN
7197      REPEAT GEN_TAC THEN SPEC_TAC (`ul:(real^3)list`, `ul:(real^3)list`) THEN
7198      SPEC_TAC (`k:num`, `k:num`) THEN
7199      INDUCT_TAC THENL
7200      [
7201        GEN_TAC THEN
7202          REWRITE_TAC[BARV; ARITH] THEN
7203          REPEAT STRIP_TAC THEN
7204          MP_TAC (ISPEC `ul:(real^3)list` LENGTH_1_LEMMA) THEN
7205          ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> ONCE_REWRITE_TAC[th]) THEN
7206          REWRITE_TAC[set_of_list; CIRCUMCENTER_1; OMEGA_LIST; LENGTH; ARITH; OMEGA_LIST_N; HD];
7207        ALL_TAC
7208      ] THEN
7209
7210      REPEAT STRIP_TAC THEN
7211      SUBGOAL_THEN `SUC k <= 3` ASSUME_TAC THENL
7212      [
7213        MATCH_MP_TAC BARV_IMP_K_LE_3 THEN
7214          MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `ul:(real^3)list`] THEN
7215          ASM_REWRITE_TAC[];
7216        ALL_TAC
7217      ] THEN
7218
7219      ABBREV_TAC `vl:(real^3)list = truncate_simplex k ul` THEN
7220      FIRST_X_ASSUM (MP_TAC o SPEC `vl:(real^3)list`) THEN
7221      ASM_SIMP_TAC[ARITH_RULE `SUC k <= 3 ==> k <= 3`] THEN
7222      SUBGOAL_THEN `barV V k vl` ASSUME_TAC THENL
7223      [
7224        EXPAND_TAC "vl" THEN
7225          MATCH_MP_TAC TRUNCATE_SIMPLEX_BARV THEN
7226          EXISTS_TAC `SUC k` THEN
7227          ASM_REWRITE_TAC[] THEN ARITH_TAC;
7228        ALL_TAC
7229      ] THEN
7230      SUBGOAL_THEN `LENGTH (ul:(real^3)list) = k + 2 /\ LENGTH (vl:(real^3)list) = k + 1` ASSUME_TAC THENL
7231      [
7232        UNDISCH_TAC `barV V (SUC k) ul` THEN UNDISCH_TAC `barV V k vl` THEN
7233          SIMP_TAC[BARV] THEN
7234          ARITH_TAC;
7235        ALL_TAC
7236      ] THEN
7237
7238      ANTS_TAC THENL
7239      [
7240        ASM_REWRITE_TAC[] THEN
7241          MATCH_MP_TAC REAL_LET_TRANS THEN
7242          EXISTS_TAC `hl (ul:(real^3)list)` THEN
7243          ASM_REWRITE_TAC[] THEN
7244          EXPAND_TAC "vl" THEN
7245          MATCH_MP_TAC HL_DECREASE THEN
7246          MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `SUC k`] THEN
7247          ASM_REWRITE_TAC[IN] THEN
7248          ARITH_TAC;
7249        ALL_TAC
7250      ] THEN
7251
7252      ABBREV_TAC `p0 = circumcenter (set_of_list vl):real^3` THEN
7253      POP_ASSUM (LABEL_TAC "p0") THEN
7254      DISCH_THEN (LABEL_TAC "po") THEN
7255      SUBGOAL_THEN `p0:real^3 IN affine hull (set_of_list ul)` ASSUME_TAC THENL
7256      [
7257        MATCH_MP_TAC IN_TRANS THEN
7258          EXISTS_TAC `affine hull (set_of_list vl):real^3->bool` THEN
7259          CONJ_TAC THENL
7260          [
7261            REMOVE_THEN "p0" (fun th -> REWRITE_TAC[SYM th]) THEN
7262              MATCH_MP_TAC BARV_CIRCUMCENTER_EXISTS THEN
7263              MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `k:num`] THEN
7264              ASM_REWRITE_TAC[];
7265            ALL_TAC
7266          ] THEN
7267
7268          MATCH_MP_TAC HULL_MONO THEN
7269          EXPAND_TAC "vl" THEN
7270          MATCH_MP_TAC SET_OF_LIST_TRUNCATE_SIMPLEX_SUBSET THEN
7271          ASM_REWRITE_TAC[] THEN
7272          ARITH_TAC;
7273        ALL_TAC
7274      ] THEN
7275
7276      ABBREV_TAC `A:real^3->bool = affine hull (voronoi_list V ul)` THEN
7277      ABBREV_TAC `p:real^3 = closest_point A p0` THEN
7278
7279      MP_TAC (ISPECL [`A:real^3->bool`; `p0:real^3`] CLOSEST_POINT_EXISTS) THEN
7280      ANTS_TAC THENL
7281      [
7282        EXPAND_TAC "A" THEN
7283          REWRITE_TAC[CLOSED_AFFINE_HULL] THEN
7284          REWRITE_TAC[AFFINE_HULL_EQ_EMPTY] THEN
7285          DISCH_TAC THEN
7286          UNDISCH_TAC `barV V (SUC k) ul` THEN
7287          REWRITE_TAC[BARV; VORONOI_NONDG] THEN
7288          STRIP_TAC THEN
7289          FIRST_X_ASSUM (MP_TAC o SPEC `ul:(real^3)list`) THEN
7290          ASM_REWRITE_TAC[INITIAL_SUBLIST_REFL; ARITH_RULE `0 < k + 2`; DE_MORGAN_THM] THEN
7291          DISJ2_TAC THEN DISJ2_TAC THEN
7292          REWRITE_TAC[AFF_DIM_EMPTY] THEN
7293          UNDISCH_TAC `SUC k <= 3` THEN
7294          REWRITE_TAC[ADD1; GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_LE] THEN
7295          INT_ARITH_TAC;
7296        ALL_TAC
7297      ] THEN
7298
7299      ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
7300
7301      SUBGOAL_THEN `p:real^3 IN affine hull set_of_list ul` ASSUME_TAC THENL
7302      [
7303        ASM_CASES_TAC `p:real^3 IN affine hull set_of_list ul` THEN ASM_REWRITE_TAC[] THEN
7304          MP_TAC (ISPECL [`set_of_list ul:real^3->bool`; `p:real^3`] AFFINE_HULL_PROJECTION_EXISTS) THEN
7305          ANTS_TAC THENL
7306          [
7307            ASM_REWRITE_TAC[SET_OF_LIST_EQ_EMPTY; GSYM LENGTH_EQ_NIL] THEN
7308              ARITH_TAC;
7309            ALL_TAC
7310          ] THEN
7311
7312          STRIP_TAC THEN
7313          SUBGOAL_THEN `dist (x, p0) < dist (p, p0:real^3)` ASSUME_TAC THENL
7314          [
7315            MATCH_MP_TAC AFFINE_HULL_PROJECTION_DIST_LT THEN
7316              MAP_EVERY EXISTS_TAC [`affine hull (set_of_list ul:real^3->bool)`; `n:real^3`] THEN
7317              ASM_REWRITE_TAC[HULL_HULL; GSYM ORTHOGONAL_TO_AFFINE_HULL_EQ] THEN
7318              UNDISCH_TAC `p = x + n:real^3` THEN DISCH_THEN (fun th -> ASM_REWRITE_TAC[SYM th]);
7319            ALL_TAC
7320          ] THEN
7321
7322          SUBGOAL_THEN `x:real^3 IN A` ASSUME_TAC THENL
7323          [
7324            UNDISCH_TAC `p:real^3 IN A` THEN
7325              EXPAND_TAC "A" THEN
7326              MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `SUC k`] MHFTTZN2) THEN
7327              ANTS_TAC THENL [ ASM_REWRITE_TAC[];ALL_TAC ] THEN
7328              DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
7329              REWRITE_TAC[bis; IN_ELIM_THM] THEN
7330              REPEAT STRIP_TAC THEN
7331              MATCH_MP_TAC AFFINE_HULL_PROJECTION_DIST_EQ THEN
7332              MAP_EVERY EXISTS_TAC [`set_of_list ul:real^3->bool`; `p:real^3`; `n:real^3`] THEN
7333              ASM_SIMP_TAC[] THEN
7334              MATCH_MP_TAC HD_IN_SET_OF_LIST THEN
7335              ASM_REWRITE_TAC[ARITH_RULE `1 <= k + 2`];
7336            ALL_TAC
7337          ] THEN
7338
7339          UNDISCH_TAC `dist (x, p0) < dist (p,p0:real^3)` THEN
7340          POP_ASSUM MP_TAC THEN REMOVE_ASSUM THEN DISCH_TAC THEN
7341          FIRST_X_ASSUM (MP_TAC o SPEC `x:real^3`) THEN
7342          ASM_REWRITE_TAC[DIST_SYM; REAL_NOT_LT];
7343        ALL_TAC
7344      ] THEN
7345
7346      SUBGOAL_THEN `p = circumcenter (set_of_list ul):real^3` (LABEL_TAC "c") THENL
7347      [
7348        MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `SUC k`] MHFTTZN3) THEN
7349          ASM_REWRITE_TAC[] THEN
7350          DISCH_TAC THEN
7351          SUBGOAL_THEN `p:real^3 IN A INTER affine hull set_of_list ul` MP_TAC THENL
7352          [
7353            ASM_REWRITE_TAC[IN_INTER];
7354            ALL_TAC
7355          ] THEN
7356
7357          ASM_REWRITE_TAC[IN_SING];
7358        ALL_TAC
7359      ] THEN
7360
7361      SUBGOAL_THEN `p:real^3 IN voronoi_list V ul` ASSUME_TAC THENL
7362      [
7363        REWRITE_TAC[VORONOI_LIST; VORONOI_SET; IN_INTERS; IN_ELIM_THM] THEN
7364          REPEAT STRIP_TAC THEN
7365          ASM_REWRITE_TAC[voronoi_closed; IN_ELIM_THM] THEN
7366          SUBGOAL_THEN `!w:real^3. V (w:real^3) <=> w IN V` (fun th -> REWRITE_TAC[th]) THENL [ REWRITE_TAC[IN]; ALL_TAC ] THEN
7367          REPEAT STRIP_TAC THEN
7368          ASM_CASES_TAC `w:real^3 IN set_of_list ul` THENL
7369          [
7370            MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `SUC k`] HL_PROPERTIES) THEN
7371              ASM_REWRITE_TAC[] THEN
7372              ASM_SIMP_TAC[REAL_LE_REFL];
7373            ALL_TAC
7374          ] THEN
7375
7376          MP_TAC (SPECL [`V:real^3->bool`; `set_of_list ul:real^3->bool`; `p:real^3`] XYOFCGX) THEN
7377          ANTS_TAC THENL
7378          [
7379            ASM_REWRITE_TAC[GSYM HL] THEN
7380              CONJ_TAC THENL
7381              [
7382                MATCH_MP_TAC BARV_SUBSET THEN
7383                  EXISTS_TAC `SUC k` THEN
7384                  ASM_REWRITE_TAC[];
7385                ALL_TAC
7386              ] THEN
7387              MATCH_MP_TAC BARV_AFFINE_INDEPENDENT THEN
7388              EXISTS_TAC `V:real^3->bool` THEN EXISTS_TAC `SUC k` THEN
7389              ASM_REWRITE_TAC[];
7390            ALL_TAC
7391          ] THEN
7392
7393          DISCH_THEN (MP_TAC o SPECL [`v:real^3`; `w:real^3`]) THEN
7394          ASM_REWRITE_TAC[IN_DIFF; DIST_SYM; real_gt; REAL_LT_LE] THEN
7395          SIMP_TAC[];
7396        ALL_TAC
7397      ] THEN
7398
7399      ASM_REWRITE_TAC[OMEGA_LIST; OMEGA_LIST_N; ARITH_RULE `(k + 2) - 1 = SUC k`] THEN
7400      SUBGOAL_THEN `omega_list_n V ul k = p0:real^3` (fun th -> REWRITE_TAC[th]) THENL
7401      [
7402        EXPAND_TAC "p0" THEN
7403          EXPAND_TAC "vl" THEN
7404          MATCH_MP_TAC (GSYM OMEGA_LIST_LEMMA) THEN
7405          ASM_REWRITE_TAC[] THEN
7406          ARITH_TAC;
7407        ALL_TAC
7408      ] THEN
7409
7410      SUBGOAL_THEN `truncate_simplex (SUC k) ul = ul:(real^3)list` (fun th -> REWRITE_TAC[th]) THENL
7411      [
7412        MP_TAC (ISPECL [`SUC k`; `ul:(real^3)list`; `ul:(real^3)list`] TRUNCATE_SIMPLEX_INITIAL_SUBLIST) THEN
7413          ASM_REWRITE_TAC[ARITH_RULE `SUC k + 1 = k + 2`; LE_REFL; INITIAL_SUBLIST_REFL];
7414        ALL_TAC
7415      ] THEN
7416
7417      REMOVE_THEN "c" (fun th -> REWRITE_TAC[SYM th]) THEN
7418      MATCH_MP_TAC (GSYM CLOSEST_POINT_UNIQUE) THEN
7419      ASM_REWRITE_TAC[CONVEX_VORONOI_LIST; CLOSED_VORONOI_LIST] THEN
7420      REPEAT STRIP_TAC THEN
7421      FIRST_X_ASSUM MATCH_MP_TAC THEN
7422      EXPAND_TAC "A" THEN
7423      MATCH_MP_TAC IN_TRANS THEN
7424      EXISTS_TAC `voronoi_list V ul:real^3->bool` THEN
7425      ASM_REWRITE_TAC[HULL_SUBSET]);;
7426
7427
7428
7429 (* XNHPWAB2 *)
7430
7431 let AFFINE_HULL_PROJECTION_SEPARATES = prove(`!S p:real^N. FINITE S /\ p IN affine hull S /\ ~(p IN convex hull S) ==>
7432                                          ?u. u IN S /\
7433                                          (!x n. p = x + n /\ x IN affine hull (S DELETE u) /\
7434                                              (!v w. v IN S DELETE u /\ w IN S DELETE u ==> (v - w) dot n = &0)
7435                                              ==> (p - x) dot (u - x) <= &0)`,
7436    REPEAT STRIP_TAC THEN
7437      POP_ASSUM (MP_TAC o REWRITE_RULE [CONVEX_HULL_FINITE]) THEN
7438      POP_ASSUM (MP_TAC o REWRITE_RULE [AFFINE_HULL_FINITE]) THEN
7439      REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM; DE_MORGAN_THM] THEN
7440      DISCH_THEN (X_CHOOSE_THEN `f:real^N->real` STRIP_ASSUME_TAC) THEN
7441      DISCH_THEN (MP_TAC o SPEC `f:real^N->real`) THEN
7442      ASM_REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LE] THEN
7443      DISCH_THEN (X_CHOOSE_THEN `u:real^N` ASSUME_TAC) THEN
7444      EXISTS_TAC `u:real^N` THEN
7445      ASM_REWRITE_TAC[] THEN
7446
7447      REPEAT STRIP_TAC THEN
7448      POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[ORTHOGONAL_TO_AFFINE_HULL_EQ] THEN DISCH_TAC THEN
7449      SUBGOAL_THEN `p - x:real^N = vsum S (\v. f v % (v - x))` (LABEL_TAC "px") THENL
7450      [
7451        REWRITE_TAC[VECTOR_SUB_LDISTRIB] THEN
7452          ASM_SIMP_TAC[VSUM_SUB; VSUM_RMUL; VECTOR_MUL_LID];
7453        ALL_TAC
7454      ] THEN
7455
7456      POP_ASSUM (MP_TAC o AP_TERM `\v:real^N. v dot (p - x)`) THEN
7457      ASM_REWRITE_TAC[VECTOR_ARITH `(x + n) - x = n:real^N`] THEN
7458      ASM_SIMP_TAC[DOT_LSUM] THEN
7459      SUBGOAL_THEN `sum S (\v:real^N. f v % (v - x) dot n) = f u * (u - x) dot n` (fun th -> REWRITE_TAC[th]) THENL
7460      [
7461        SUBGOAL_THEN `S:real^N->bool = (S DELETE u) UNION {u}` (fun th -> ONCE_REWRITE_TAC[th]) THENL
7462          [
7463            REWRITE_TAC[EXTENSION; IN_UNION; IN_SING; IN_DELETE] THEN
7464              GEN_TAC THEN EQ_TAC THEN SIMP_TAC[DISJ_SYM; EXCLUDED_MIDDLE] THEN
7465              STRIP_TAC THEN ASM_REWRITE_TAC[];
7466            ALL_TAC
7467          ] THEN
7468          MP_TAC (ISPECL [`\v:real^N. f v % (v - x) dot n`; `u:real^N`] SUM_SING) THEN
7469          REWRITE_TAC[DOT_LMUL] THEN
7470          DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
7471          MATCH_MP_TAC SUM_UNION_LZERO THEN
7472          REWRITE_TAC[FINITE_SING] THEN
7473          REPEAT STRIP_TAC THEN
7474          REWRITE_TAC[REAL_ENTIRE] THEN
7475          DISJ2_TAC THEN
7476          FIRST_X_ASSUM MATCH_MP_TAC THEN
7477          ASM_REWRITE_TAC[] THEN
7478          MATCH_MP_TAC IN_TRANS THEN
7479          EXISTS_TAC `S DELETE (u:real^N)` THEN
7480          ASM_REWRITE_TAC[HULL_SUBSET];
7481        ALL_TAC
7482      ] THEN
7483
7484      DISCH_THEN (MP_TAC o AP_TERM `\x. inv (f (u:real^N)) * x`) THEN
7485      REWRITE_TAC[REAL_MUL_ASSOC; DOT_SYM] THEN
7486      ASM_SIMP_TAC[REAL_ARITH `a < &0 ==> ~(a = &0)`; REAL_MUL_LINV; REAL_MUL_LID] THEN
7487      DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
7488      REWRITE_TAC[REAL_ARITH `a * b <= &0 <=> &0 <= (--a) * b`] THEN
7489      MATCH_MP_TAC REAL_LE_MUL THEN
7490      REWRITE_TAC[DOT_POS_LE; GSYM REAL_INV_NEG] THEN
7491      MATCH_MP_TAC REAL_LE_INV THEN
7492      ASM_REWRITE_TAC[REAL_NEG_GE0; REAL_LE_LT]);;
7493
7494
7495
7496
7497 let XNHPWAB2 = prove(`!V ul k.  packing V /\ (ul IN barV V k) /\ (hl ul < sqrt(&2)) ==>
7498                        (omega_list V ul IN convex hull (set_of_list ul))`,
7499    REPEAT STRIP_TAC THEN
7500      UNDISCH_TAC `ul IN barV V k` THEN DISCH_THEN (ASSUME_TAC o REWRITE_RULE[IN]) THEN
7501      ABBREV_TAC `p:real^3 = omega_list V ul` THEN
7502      ABBREV_TAC `S:real^3->bool = set_of_list ul` THEN
7503      ASM_CASES_TAC `p:real^3 IN convex hull S` THEN ASM_REWRITE_TAC[] THEN
7504      SUBGOAL_THEN `circumcenter S = p:real^3` (LABEL_TAC "c") THENL
7505      [
7506        EXPAND_TAC "S" THEN EXPAND_TAC "p" THEN
7507          MATCH_MP_TAC (GSYM XNHPWAB1) THEN
7508          EXISTS_TAC `k:num` THEN
7509          ASM_REWRITE_TAC[IN];
7510        ALL_TAC
7511      ] THEN
7512
7513      SUBGOAL_THEN `~affine_dependent (S:real^3->bool)` ASSUME_TAC THENL
7514      [
7515        EXPAND_TAC "S" THEN
7516          MATCH_MP_TAC BARV_AFFINE_INDEPENDENT THEN
7517          MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `k:num`] THEN
7518          ASM_REWRITE_TAC[];
7519        ALL_TAC
7520      ] THEN
7521
7522      MP_TAC (ISPECL [`S:real^3->bool`; `p:real^3`] AFFINE_HULL_PROJECTION_SEPARATES) THEN
7523      ANTS_TAC THENL
7524      [
7525        ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE] THEN
7526          EXPAND_TAC "p" THEN EXPAND_TAC "S" THEN
7527          MATCH_MP_TAC BARV_CIRCUMCENTER_EXISTS THEN
7528          MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `k:num`] THEN
7529          ASM_REWRITE_TAC[];
7530        ALL_TAC
7531      ] THEN
7532
7533      STRIP_TAC THEN
7534      ASM_CASES_TAC `S DELETE u:real^3 = {}` THENL
7535      [
7536        SUBGOAL_THEN `S = {u:real^3}` ASSUME_TAC THENL
7537          [
7538            POP_ASSUM MP_TAC THEN
7539              REWRITE_TAC[EXTENSION; IN_DELETE; NOT_IN_EMPTY; IN_SING; DE_MORGAN_THM] THEN
7540              REPEAT STRIP_TAC THEN
7541              EQ_TAC THEN DISCH_TAC THENL
7542              [
7543                FIRST_X_ASSUM (MP_TAC o SPEC `x:real^3`) THEN
7544                  ASM_REWRITE_TAC[];
7545                ALL_TAC
7546              ] THEN
7547              ASM_REWRITE_TAC[];
7548            ALL_TAC
7549          ] THEN
7550
7551          REMOVE_THEN "c" MP_TAC THEN
7552          ASM_REWRITE_TAC[CIRCUMCENTER_1] THEN DISCH_TAC THEN
7553          UNDISCH_TAC `~(p:real^3 IN convex hull S)` THEN
7554          ASM_REWRITE_TAC[CONVEX_HULL_SING; IN_SING];
7555        ALL_TAC
7556      ] THEN
7557
7558      MP_TAC (ISPECL [`S:real^3->bool`; `S DELETE u:real^3`] AFFINE_HULL_CIRCUMCENTER_PROJECTION) THEN
7559      ASM_REWRITE_TAC[DELETE_SUBSET] THEN
7560      ABBREV_TAC `p0:real^3 = circumcenter (S DELETE u)` THEN
7561      STRIP_TAC THEN
7562      POP_ASSUM (LABEL_TAC "vw") THEN
7563      SUBGOAL_THEN `p0:real^3 IN affine hull (S DELETE u)` ASSUME_TAC THENL
7564      [
7565        EXPAND_TAC "p0" THEN
7566          MP_TAC (ISPEC `S DELETE u:real^3` OAPVION1) THEN
7567          ANTS_TAC THENL
7568          [
7569            ASM_REWRITE_TAC[] THEN
7570              MATCH_MP_TAC AFFINE_INDEPENDENT_SUBSET THEN
7571              EXISTS_TAC `S:real^3->bool` THEN
7572              ASM_REWRITE_TAC[DELETE_SUBSET];
7573            ALL_TAC
7574          ] THEN
7575          SIMP_TAC[];
7576        ALL_TAC
7577      ] THEN
7578
7579      UNDISCH_TAC `~(S DELETE u:real^3 = {})` THEN
7580      PURE_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
7581      DISCH_THEN (X_CHOOSE_THEN `v:real^3` ASSUME_TAC) THEN
7582
7583      SUBGOAL_THEN `dist (p, v) pow 2 = dist (p0, v) pow 2 + dist (p0, p:real^3) pow 2` ASSUME_TAC THENL
7584      [
7585        ASM_REWRITE_TAC[dist; NORM_POW_2; VECTOR_ARITH `p0 - (p0 + n) = --n:real^3`; VECTOR_ARITH `(p0 + n) - v = (p0 - v) + n:real^3`] THEN
7586          REWRITE_TAC[DOT_LADD; DOT_RADD; DOT_LNEG; DOT_RNEG; REAL_NEG_NEG; DOT_SYM] THEN
7587          REWRITE_TAC[REAL_ARITH `(p0v +nv) + nv + nn = p0v + nn <=> nv = &0`] THEN
7588          REMOVE_THEN "vw" MP_TAC THEN
7589          ONCE_REWRITE_TAC[ORTHOGONAL_TO_AFFINE_HULL_EQ] THEN
7590          REWRITE_TAC[DOT_SYM] THEN
7591          DISCH_THEN MATCH_MP_TAC THEN
7592          ASM_REWRITE_TAC[] THEN
7593          MATCH_MP_TAC IN_TRANS THEN
7594          EXISTS_TAC `S DELETE u:real^3` THEN
7595          ASM_REWRITE_TAC[HULL_SUBSET];
7596        ALL_TAC
7597      ] THEN
7598
7599      SUBGOAL_THEN `dist (p,u:real^3) pow 2 = dist (p0,u) pow 2 + dist (p0,p) pow 2 + &2 * (p - p0) dot (p0 - u)` ASSUME_TAC THENL
7600      [
7601        ASM_REWRITE_TAC[dist; NORM_POW_2; VECTOR_ARITH `(p0 + n) - u = (p0 - u) + n:real^3`; VECTOR_ARITH `p0 - (p0 + n) = --n:real^3`] THEN
7602          REWRITE_TAC[DOT_LADD; DOT_RADD; DOT_LNEG; DOT_RNEG; REAL_NEG_NEG; DOT_SYM] THEN
7603          REWRITE_TAC[REAL_ARITH `(a + b) + b + c = a + c + &2 * d <=> b = d`] THEN
7604          REWRITE_TAC[VECTOR_SUB_REFL; DOT_LZERO; REAL_ADD_LID];
7605        ALL_TAC
7606      ] THEN
7607
7608      SUBGOAL_THEN `dist (p0, u) <= dist (p0, v:real^3)` MP_TAC THENL
7609      [
7610        REWRITE_TAC[dist] THEN ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN
7611          REWRITE_TAC[REAL_LE_SQUARE_ABS; GSYM dist] THEN
7612          SUBGOAL_THEN `dist (p0,v:real^3) pow 2 = dist (p,v) pow 2 - dist (p0,p) pow 2` (fun th -> REWRITE_TAC[th]) THENL
7613          [
7614            REMOVE_ASSUM THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC;
7615            ALL_TAC
7616          ] THEN
7617          SUBGOAL_THEN `dist (p0,u:real^3) pow 2 = dist (p,u) pow 2 - dist (p0,p) pow 2 - &2 * ((p - p0) dot (p0 - u))` (fun th -> REWRITE_TAC[th]) THENL
7618          [
7619            POP_ASSUM MP_TAC THEN REAL_ARITH_TAC;
7620            ALL_TAC
7621          ] THEN
7622
7623          SUBGOAL_THEN `dist (p, u)  = dist (p, v:real^3)` (fun th -> REWRITE_TAC[th]) THENL
7624          [
7625            MP_TAC (ISPEC `S:real^3->bool` OAPVION2) THEN
7626              ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
7627              FIRST_ASSUM (MP_TAC o SPEC `u:real^3`) THEN
7628              FIRST_X_ASSUM (MP_TAC o SPEC `v:real^3`) THEN
7629              UNDISCH_TAC `v IN S DELETE u:real^3` THEN
7630              ASM_SIMP_TAC[IN_DELETE];
7631            ALL_TAC
7632          ] THEN
7633
7634          REWRITE_TAC[REAL_ARITH `a - b - &2 * c <= a - b <=> --c <= &0`] THEN
7635          REWRITE_TAC[GSYM DOT_RNEG; VECTOR_NEG_SUB] THEN
7636          FIRST_X_ASSUM MATCH_MP_TAC THEN
7637          EXISTS_TAC `n:real^3` THEN
7638          ASM_REWRITE_TAC[];
7639        ALL_TAC
7640      ] THEN
7641
7642      REWRITE_TAC[REAL_NOT_LE] THEN
7643      MP_TAC (SPECL [`V:real^3->bool`; `S DELETE u:real^3`; `p0:real^3`] XYOFCGX) THEN
7644      ANTS_TAC THENL
7645      [
7646        ASM_REWRITE_TAC[] THEN
7647          CONJ_TAC THENL
7648          [
7649            MATCH_MP_TAC SUBSET_TRANS THEN
7650              EXISTS_TAC `S:real^3->bool` THEN
7651              REWRITE_TAC[DELETE_SUBSET] THEN
7652              EXPAND_TAC "S" THEN
7653              MATCH_MP_TAC BARV_SUBSET THEN
7654              EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[];
7655            ALL_TAC
7656          ] THEN
7657          CONJ_TAC THENL
7658          [
7659            MATCH_MP_TAC AFFINE_INDEPENDENT_SUBSET THEN
7660              EXISTS_TAC `S:real^3->bool` THEN
7661              ASM_REWRITE_TAC[DELETE_SUBSET];
7662            ALL_TAC
7663          ] THEN
7664
7665          MATCH_MP_TAC REAL_LET_TRANS THEN
7666          EXISTS_TAC `radV (S:real^3->bool)` THEN
7667          EXPAND_TAC "S" THEN
7668          ASM_REWRITE_TAC[GSYM HL] THEN
7669          ASM_REWRITE_TAC[HL] THEN
7670          MATCH_MP_TAC RADV_MONO THEN
7671          ASM_REWRITE_TAC[DELETE_SUBSET; GSYM MEMBER_NOT_EMPTY] THEN
7672          EXISTS_TAC `v:real^3` THEN ASM_REWRITE_TAC[];
7673        ALL_TAC
7674      ] THEN
7675
7676      DISCH_THEN (MP_TAC o SPECL [`v:real^3`; `u:real^3`]) THEN
7677      ASM_REWRITE_TAC[DIST_SYM; real_gt] THEN
7678      DISCH_THEN MATCH_MP_TAC THEN
7679      REWRITE_TAC[IN_DIFF; IN_DELETE] THEN
7680      MATCH_MP_TAC IN_TRANS THEN
7681      EXISTS_TAC `S:real^3->bool` THEN
7682      ASM_REWRITE_TAC[] THEN
7683      EXPAND_TAC "S" THEN
7684      MATCH_MP_TAC BARV_SUBSET THEN
7685      EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[]);;
7686
7687
7688
7689 (* XNHPWAB4 *)
7690
7691 let XNHPWAB4 = prove(`!V ul k. packing V /\ (ul IN barV V k) /\ (hl ul < sqrt(&2)) ==>
7692                        (!i j. (i < j) /\ (j <= k) ==> hl(truncate_simplex i ul) < hl(truncate_simplex j ul))`,
7693    REWRITE_TAC[IN] THEN REPEAT STRIP_TAC THEN
7694      ABBREV_TAC `xl:(real^3)list = truncate_simplex j ul` THEN
7695      ABBREV_TAC `yl:(real^3)list = truncate_simplex i ul` THEN
7696      SUBGOAL_THEN `barV V i yl /\ barV V j xl` ASSUME_TAC THENL
7697      [
7698        EXPAND_TAC "xl" THEN EXPAND_TAC "yl" THEN
7699          CONJ_TAC THEN MATCH_MP_TAC TRUNCATE_SIMPLEX_BARV THEN EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[] THEN
7700          MATCH_MP_TAC LE_TRANS THEN
7701          EXISTS_TAC `j:num` THEN
7702          ASM_SIMP_TAC[LT_IMP_LE];
7703        ALL_TAC
7704      ] THEN
7705
7706      SUBGOAL_THEN `LENGTH (xl:(real^3)list) = j + 1 /\ LENGTH (yl:(real^3)list) = i + 1 /\ i + 1 <= j + 1` ASSUME_TAC THENL
7707      [
7708        POP_ASSUM MP_TAC THEN
7709          SIMP_TAC[BARV; ARITH_RULE `i + 1 <= j + 1 <=> i <= j`] THEN
7710          ASM_SIMP_TAC[LT_IMP_LE];
7711        ALL_TAC
7712      ] THEN
7713
7714      SUBGOAL_THEN `hl (xl:(real^3)list) < sqrt (&2) /\ hl (yl:(real^3)list) < sqrt (&2)` ASSUME_TAC THENL
7715      [
7716        CONJ_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `hl (ul:(real^3)list)` THEN ASM_REWRITE_TAC[] THENL
7717          [
7718            EXPAND_TAC "xl";
7719            EXPAND_TAC "yl"
7720          ] THEN
7721          MATCH_MP_TAC HL_DECREASE THEN
7722          MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `k:num`] THEN
7723          ASM_REWRITE_TAC[IN] THEN
7724          MATCH_MP_TAC LE_TRANS THEN
7725          EXISTS_TAC `j:num` THEN
7726          ASM_SIMP_TAC[LT_IMP_LE];
7727        ALL_TAC
7728      ] THEN
7729
7730      SUBGOAL_THEN `truncate_simplex i xl = yl:(real^3)list` ASSUME_TAC THENL
7731      [
7732        EXPAND_TAC "xl" THEN EXPAND_TAC "yl" THEN
7733          MATCH_MP_TAC TRUNCATE_TRUNCATE_SIMPLEX THEN
7734          ASM_SIMP_TAC[LT_IMP_LE] THEN
7735          UNDISCH_TAC `barV V k ul` THEN
7736          SIMP_TAC[BARV] THEN
7737          ASM_REWRITE_TAC[ARITH_RULE `j + 1 <= k + 1 <=> j <= k`];
7738        ALL_TAC
7739      ] THEN
7740
7741      REPEAT (FIRST_X_ASSUM ((fun th -> ALL_TAC) o check (free_in `ul:(real^3)list` o concl))) THEN
7742
7743      SUBGOAL_THEN `set_of_list yl SUBSET ((set_of_list xl):real^3->bool) /\ ~(set_of_list yl = {})` ASSUME_TAC THENL
7744      [
7745        CONJ_TAC THENL
7746          [
7747            EXPAND_TAC "yl" THEN
7748              MATCH_MP_TAC SET_OF_LIST_TRUNCATE_SIMPLEX_SUBSET THEN
7749              ASM_REWRITE_TAC[] THEN ARITH_TAC;
7750            REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
7751              EXISTS_TAC `HD (yl:(real^3)list)` THEN
7752              MATCH_MP_TAC HD_IN_SET_OF_LIST THEN
7753              ASM_REWRITE_TAC[] THEN
7754              ARITH_TAC
7755          ];
7756        ALL_TAC
7757      ] THEN
7758
7759      SUBGOAL_THEN `~affine_dependent (set_of_list xl:real^3->bool)` ASSUME_TAC THENL
7760      [
7761        MATCH_MP_TAC BARV_AFFINE_INDEPENDENT THEN
7762          MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `j:num`] THEN
7763          ASM_REWRITE_TAC[];
7764        ALL_TAC
7765      ] THEN
7766
7767      SUBGOAL_THEN `~affine_dependent (set_of_list yl:real^3->bool)` ASSUME_TAC THENL
7768      [
7769        MATCH_MP_TAC BARV_AFFINE_INDEPENDENT THEN
7770          MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `i:num`] THEN
7771          ASM_REWRITE_TAC[];
7772        ALL_TAC
7773      ] THEN
7774
7775      SUBGOAL_THEN `?v:real^3. v IN set_of_list xl /\ ~(v IN set_of_list yl)` CHOOSE_TAC THENL
7776      [
7777        ASM_CASES_TAC `set_of_list xl = set_of_list yl:real^3->bool` THENL
7778        [
7779          MATCH_MP_TAC (TAUT `F ==> P`) THEN
7780            MP_TAC (SPECL [`V:real^3->bool`; `xl:(real^3)list`; `j:num`] MHFTTZN1) THEN
7781            MP_TAC (SPECL [`V:real^3->bool`; `yl:(real^3)list`; `i:num`] MHFTTZN1) THEN
7782            ASM_SIMP_TAC[] THEN
7783            REWRITE_TAC[INT_OF_NUM_EQ] THEN
7784            UNDISCH_TAC `i < j:num` THEN ARITH_TAC;
7785          ALL_TAC
7786        ] THEN
7787
7788        MP_TAC (ISPECL [`set_of_list yl:real^3->bool`; `set_of_list xl:real^3->bool`] PSUBSET_MEMBER) THEN
7789        ASM_REWRITE_TAC[PSUBSET];
7790        ALL_TAC
7791      ] THEN
7792
7793      REWRITE_TAC[HL] THEN
7794      MP_TAC (ISPECL [`set_of_list xl:real^3->bool`; `set_of_list yl:real^3->bool`] AFFINE_HULL_RADV) THEN
7795      ASM_REWRITE_TAC[] THEN
7796      STRIP_TAC THEN
7797      SUBGOAL_THEN `!s:real^3->bool. &0 <= radV s ==> radV s = abs (radV s)` MP_TAC THENL
7798      [
7799        SIMP_TAC[GSYM REAL_ABS_REFL];
7800        ALL_TAC
7801      ] THEN
7802      DISCH_TAC THEN FIRST_ASSUM (MP_TAC o SPEC `set_of_list yl:real^3->bool`) THEN
7803      FIRST_X_ASSUM (MP_TAC o SPEC `set_of_list xl:real^3->bool`) THEN
7804      ASM_REWRITE_TAC[] THEN
7805      REPLICATE_TAC 2 (DISCH_THEN (fun th -> ONCE_REWRITE_TAC[th])) THEN
7806      ASM_REWRITE_TAC[REAL_LT_SQUARE_ABS] THEN
7807      REWRITE_TAC[REAL_ARITH `a < a + b <=> &0 < b`] THEN
7808      REWRITE_TAC[dist; NORM_POW_2; DOT_POS_LT; VECTOR_SUB_EQ] THEN
7809      DISCH_TAC THEN
7810
7811      MP_TAC (SPECL [`V:real^3->bool`; `set_of_list yl:real^3->bool`; `circumcenter (set_of_list xl):real^3`] XYOFCGX) THEN
7812      ANTS_TAC THENL
7813      [
7814        ASM_REWRITE_TAC[GSYM HL] THEN
7815          MATCH_MP_TAC BARV_SUBSET THEN
7816          EXISTS_TAC `i:num` THEN
7817          ASM_REWRITE_TAC[];
7818        ALL_TAC
7819      ] THEN
7820
7821      DISCH_THEN (MP_TAC o SPECL [`HD yl:real^3`; `v:real^3`]) THEN
7822      ANTS_TAC THENL
7823      [
7824        ASM_REWRITE_TAC[IN_DIFF] THEN
7825          CONJ_TAC THENL
7826          [
7827            MATCH_MP_TAC HD_IN_SET_OF_LIST THEN
7828              ASM_REWRITE_TAC[] THEN ARITH_TAC;
7829            ALL_TAC
7830          ] THEN
7831          MATCH_MP_TAC IN_TRANS THEN
7832          EXISTS_TAC `set_of_list xl:real^3->bool` THEN
7833          ASM_REWRITE_TAC[] THEN
7834          MATCH_MP_TAC BARV_SUBSET THEN
7835          EXISTS_TAC `j:num` THEN ASM_REWRITE_TAC[];
7836        ALL_TAC
7837      ] THEN
7838
7839      REWRITE_TAC[] THEN
7840      MATCH_MP_TAC (REAL_ARITH `a = b ==> ~(a > b:real)`) THEN
7841      MP_TAC (ISPEC `set_of_list xl:real^3->bool` OAPVION2) THEN
7842      ASM_REWRITE_TAC[] THEN
7843      DISCH_TAC THEN
7844      FIRST_ASSUM (MP_TAC o SPEC `v:real^3`) THEN
7845      FIRST_X_ASSUM (MP_TAC o SPEC `HD yl:real^3`) THEN
7846      ASM_REWRITE_TAC[] THEN
7847      ANTS_TAC THENL
7848      [
7849        SUBGOAL_THEN `HD yl = HD xl:real^3` (fun th -> REWRITE_TAC[th]) THENL
7850          [
7851            EXPAND_TAC "yl" THEN
7852              MATCH_MP_TAC HD_TRUNCATE_SIMPLEX THEN
7853              ASM_REWRITE_TAC[] THEN ARITH_TAC;
7854            ALL_TAC
7855          ] THEN
7856          MATCH_MP_TAC HD_IN_SET_OF_LIST THEN
7857          ASM_REWRITE_TAC[] THEN ARITH_TAC;
7858        ALL_TAC
7859      ] THEN
7860
7861      SIMP_TAC[DIST_SYM]);;
7862
7863
7864
7865
7866 (* XNHPWAB3 *)
7867
7868
7869 let OMEGA_LIST_N_IN_CONVEX_HULL = prove(`!V ul k i. packing V /\ barV V k ul /\ i <= k /\ hl ul < sqrt (&2)
7870                                         ==> omega_list_n V ul i IN convex hull set_of_list ul`,
7871    REPEAT STRIP_TAC THEN
7872      ABBREV_TAC `vl:(real^3)list = truncate_simplex i ul` THEN
7873      SUBGOAL_THEN `barV V i vl` ASSUME_TAC THENL
7874      [
7875        EXPAND_TAC "vl" THEN
7876          MATCH_MP_TAC TRUNCATE_SIMPLEX_BARV THEN
7877          EXISTS_TAC `k:num` THEN
7878          ASM_REWRITE_TAC[];
7879        ALL_TAC
7880      ] THEN
7881
7882      SUBGOAL_THEN `LENGTH (vl:(real^3)list) = i + 1 /\ LENGTH (ul:(real^3)list) = k + 1` ASSUME_TAC THENL
7883      [
7884        UNDISCH_TAC `barV V k ul` THEN
7885          POP_ASSUM MP_TAC THEN
7886          SIMP_TAC[BARV];
7887        ALL_TAC
7888      ] THEN
7889
7890      SUBGOAL_THEN `omega_list_n V ul i = omega_list V vl` (fun th -> REWRITE_TAC[th]) THENL
7891      [
7892        ASM_REWRITE_TAC[OMEGA_LIST; ARITH_RULE `(i + 1) - 1 = i`] THEN
7893          EXPAND_TAC "vl" THEN
7894          MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `i:num`; `0`] OMEGA_LIST_N_LEMMA) THEN
7895          REWRITE_TAC[ARITH_RULE `i + 0 = i`] THEN
7896          DISCH_THEN MATCH_MP_TAC THEN
7897          ASM_REWRITE_TAC[ARITH_RULE `i + 0 + 1 <= k + 1 <=> i <= k`];
7898        ALL_TAC
7899      ] THEN
7900
7901      MATCH_MP_TAC IN_TRANS THEN
7902      EXISTS_TAC `convex hull set_of_list vl:real^3->bool` THEN
7903      CONJ_TAC THENL
7904      [
7905        MATCH_MP_TAC XNHPWAB2 THEN
7906          EXISTS_TAC `i:num` THEN
7907          ASM_REWRITE_TAC[IN] THEN
7908          MATCH_MP_TAC REAL_LET_TRANS THEN
7909          EXISTS_TAC `hl (ul:(real^3)list)` THEN
7910          ASM_REWRITE_TAC[] THEN
7911          EXPAND_TAC "vl" THEN
7912          MATCH_MP_TAC HL_DECREASE THEN
7913          MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `k:num`] THEN
7914          ASM_REWRITE_TAC[IN];
7915        ALL_TAC
7916      ] THEN
7917
7918      MATCH_MP_TAC HULL_MONO THEN
7919      EXPAND_TAC "vl" THEN
7920      MATCH_MP_TAC SET_OF_LIST_TRUNCATE_SIMPLEX_SUBSET THEN
7921      ASM_REWRITE_TAC[ARITH_RULE `i + 1 <= k + 1 <=> i <= k`]);;
7922
7923
7924
7925
7926 let XNHPWAB3 = prove(`!V ul k. packing V /\ (ul IN barV V k) /\ (hl ul < sqrt(&2)) ==>
7927                        (aff_dim { omega_list_n V ul j | j IN (0..k)} = &k)`,
7928    REWRITE_TAC[IN_NUMSEG; IN] THEN
7929      REPEAT GEN_TAC THEN
7930      SPEC_TAC (`ul:(real^3)list`, `ul:(real^3)list`) THEN
7931      SPEC_TAC (`k:num`, `k:num`) THEN
7932      INDUCT_TAC THENL
7933      [
7934        REPEAT STRIP_TAC THEN
7935          REWRITE_TAC[IN_NUMSEG; LE_ANTISYM; EQ_SYM_EQ] THEN
7936          SUBGOAL_THEN `{omega_list_n V ul j | j = 0} = {omega_list_n V ul 0}` (fun th -> REWRITE_TAC[th]) THENL
7937          [
7938            REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN
7939              GEN_TAC THEN EQ_TAC THENL
7940              [
7941                STRIP_TAC THEN ASM_REWRITE_TAC[];
7942                ALL_TAC
7943              ] THEN
7944              DISCH_TAC THEN
7945              EXISTS_TAC `0` THEN
7946              ASM_REWRITE_TAC[];
7947            ALL_TAC
7948          ] THEN
7949          REWRITE_TAC[AFF_DIM_SING];
7950        ALL_TAC
7951      ] THEN
7952
7953      REPEAT STRIP_TAC THEN
7954      ABBREV_TAC `vl:(real^3)list = truncate_simplex k ul` THEN
7955      FIRST_X_ASSUM (MP_TAC o SPEC `vl:(real^3)list`) THEN
7956      SUBGOAL_THEN `barV V k vl` ASSUME_TAC THENL
7957      [
7958        EXPAND_TAC "vl" THEN
7959          MATCH_MP_TAC TRUNCATE_SIMPLEX_BARV THEN
7960          EXISTS_TAC `SUC k` THEN
7961          ASM_REWRITE_TAC[ARITH_RULE `k <= SUC k`];
7962        ALL_TAC
7963      ] THEN
7964      SUBGOAL_THEN `hl (vl:(real^3)list) < sqrt (&2)` ASSUME_TAC THENL
7965      [
7966        MATCH_MP_TAC REAL_LET_TRANS THEN
7967          EXISTS_TAC `hl (ul:(real^3)list)` THEN
7968          ASM_REWRITE_TAC[] THEN
7969          EXPAND_TAC "vl" THEN
7970          MATCH_MP_TAC HL_DECREASE THEN
7971          MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `SUC k`] THEN
7972          ASM_REWRITE_TAC[ARITH_RULE `k <= SUC k`; IN];
7973        ALL_TAC
7974      ] THEN
7975
7976      ASM_SIMP_TAC[ARITH_RULE `SUC k <= 3 ==> k <= 3`] THEN
7977      SUBGOAL_THEN `LENGTH (ul:(real^3)list) = k + 2 /\ LENGTH (vl:(real^3)list) = k + 1` ASSUME_TAC THENL
7978      [
7979        REPEAT (FIRST_X_ASSUM (MP_TAC o check (free_in `barV` o concl))) THEN
7980          SIMP_TAC[BARV; ADD1; ARITH_RULE `(k + 1) + 1 = k + 2`];
7981        ALL_TAC
7982      ] THEN
7983
7984      SUBGOAL_THEN `{omega_list_n V ul j | 0 <= j /\ j <= SUC k} = omega_list_n V ul (SUC k) INSERT {omega_list_n V vl j | 0 <= j /\ j <= k}` MP_TAC THENL
7985      [
7986        SUBGOAL_THEN `!j. 0 <= j /\ j <= k ==> omega_list_n V vl j = omega_list_n V ul j` ASSUME_TAC THENL
7987          [
7988            REPEAT STRIP_TAC THEN
7989              EXPAND_TAC "vl" THEN
7990              SUBGOAL_THEN `k = j + (k - j:num)` MP_TAC THENL
7991              [
7992                POP_ASSUM MP_TAC THEN ARITH_TAC;
7993                ALL_TAC
7994              ] THEN
7995              DISCH_THEN (fun th -> ONCE_REWRITE_TAC[th]) THEN
7996              MATCH_MP_TAC (GSYM OMEGA_LIST_N_LEMMA) THEN
7997              ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN
7998              ARITH_TAC;
7999            ALL_TAC
8000          ] THEN
8001
8002          REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT] THEN
8003          GEN_TAC THEN EQ_TAC THENL
8004          [
8005            REPEAT STRIP_TAC THEN
8006              ASM_CASES_TAC `j = SUC k` THEN ASM_REWRITE_TAC[] THEN
8007              DISJ2_TAC THEN
8008              EXISTS_TAC `j:num` THEN
8009              MP_TAC (ARITH_RULE `j <= SUC k /\ ~(j = SUC k) ==> j <= k`) THEN
8010              ASM_REWRITE_TAC[] THEN
8011              DISCH_TAC THEN
8012              ASM_SIMP_TAC[];
8013            ALL_TAC
8014          ] THEN
8015
8016          REPEAT STRIP_TAC THENL
8017          [
8018            EXISTS_TAC `SUC k` THEN
8019              ASM_REWRITE_TAC[LE_0; LE_REFL];
8020            ALL_TAC
8021          ] THEN
8022
8023          EXISTS_TAC `j:num` THEN
8024          ASM_SIMP_TAC[ARITH_RULE `j <= k ==> j <= SUC k`];
8025        ALL_TAC
8026      ] THEN
8027
8028      DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
8029      DISCH_TAC THEN
8030      ASM_REWRITE_TAC[AFF_DIM_INSERT] THEN
8031      SUBGOAL_THEN `~(omega_list_n V ul (SUC k) IN affine hull {omega_list_n V vl j | 0 <= j /\ j <= k})` (fun th -> REWRITE_TAC[th; ADD1; INT_OF_NUM_ADD]) THEN
8032
8033      SUBGOAL_THEN `omega_list_n V ul (SUC k) = circumcenter (set_of_list ul)` (fun th -> REWRITE_TAC[th]) THENL
8034      [
8035        SUBGOAL_THEN `omega_list_n V ul (SUC k) = omega_list V ul` (fun th -> REWRITE_TAC[th]) THENL
8036          [
8037            ASM_REWRITE_TAC[OMEGA_LIST; ARITH_RULE `(k + 2) - 1 = SUC k`];
8038            ALL_TAC
8039          ] THEN
8040          MATCH_MP_TAC XNHPWAB1 THEN
8041          EXISTS_TAC `SUC k` THEN
8042          ASM_REWRITE_TAC[IN];
8043        ALL_TAC
8044      ] THEN
8045
8046      DISCH_TAC THEN
8047      SUBGOAL_THEN `~affine_dependent ((set_of_list ul):real^3->bool)` ASSUME_TAC THENL
8048      [
8049        MATCH_MP_TAC BARV_AFFINE_INDEPENDENT THEN
8050          MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `SUC k`] THEN
8051          ASM_REWRITE_TAC[];
8052        ALL_TAC
8053      ] THEN
8054
8055      SUBGOAL_THEN `set_of_list vl SUBSET ((set_of_list ul):real^3->bool) /\ ~(set_of_list vl = {})` ASSUME_TAC THENL
8056      [
8057        EXPAND_TAC "vl" THEN
8058          CONJ_TAC THENL
8059          [
8060            MATCH_MP_TAC SET_OF_LIST_TRUNCATE_SIMPLEX_SUBSET THEN
8061              ASM_REWRITE_TAC[] THEN ARITH_TAC;
8062            REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
8063              EXISTS_TAC `HD (vl:(real^3)list)` THEN
8064              ASM_REWRITE_TAC[] THEN
8065              MATCH_MP_TAC HD_IN_SET_OF_LIST THEN
8066              ASM_REWRITE_TAC[] THEN
8067              ARITH_TAC
8068          ];
8069        ALL_TAC
8070      ] THEN
8071
8072      SUBGOAL_THEN `circumcenter (set_of_list ul) = circumcenter (set_of_list vl):real^3` ASSUME_TAC THENL
8073      [
8074        MATCH_MP_TAC AFFINE_HULL_CIRCUMCENTER_EQ THEN
8075          ASM_REWRITE_TAC[] THEN
8076          MATCH_MP_TAC IN_TRANS THEN
8077          EXISTS_TAC `affine hull {omega_list_n V vl j | 0 <= j /\ j <= k}` THEN
8078          ASM_REWRITE_TAC[] THEN
8079          GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM HULL_HULL] THEN
8080          MATCH_MP_TAC HULL_MONO THEN
8081          REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
8082          REPEAT STRIP_TAC THEN
8083          MATCH_MP_TAC IN_TRANS THEN
8084          EXISTS_TAC `convex hull set_of_list (vl:(real^3)list)` THEN
8085          ASM_REWRITE_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL] THEN
8086          MATCH_MP_TAC OMEGA_LIST_N_IN_CONVEX_HULL THEN
8087          EXISTS_TAC `k:num` THEN
8088          ASM_REWRITE_TAC[];
8089        ALL_TAC
8090      ] THEN
8091
8092      MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `SUC k`] XNHPWAB4) THEN
8093      ASM_REWRITE_TAC[IN] THEN
8094      DISCH_THEN (MP_TAC o SPECL [`k:num`; `SUC k`]) THEN
8095      ANTS_TAC THENL [ ARITH_TAC; ALL_TAC ] THEN
8096      ASM_REWRITE_TAC[] THEN
8097      MATCH_MP_TAC (REAL_ARITH `a = b ==> ~(a < b:real)`) THEN
8098      SUBGOAL_THEN `truncate_simplex (SUC k) ul = ul:(real^3)list` (fun th -> REWRITE_TAC[th]) THENL
8099      [
8100        MP_TAC (ISPECL [`SUC k`; `ul:(real^3)list`; `ul:(real^3)list`] TRUNCATE_SIMPLEX_INITIAL_SUBLIST) THEN
8101          ASM_REWRITE_TAC[ARITH_RULE `SUC k + 1 <= k + 2`; ARITH_RULE `k + 2 = SUC k + 1`; INITIAL_SUBLIST_REFL] THEN
8102          SIMP_TAC[];
8103        ALL_TAC
8104      ] THEN
8105      MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `SUC k`] HL_PROPERTIES) THEN
8106      MP_TAC (SPECL [`V:real^3->bool`; `vl:(real^3)list`; `k:num`] HL_PROPERTIES) THEN
8107      ASM_REWRITE_TAC[] THEN
8108      DISCH_THEN (MP_TAC o SPEC `HD vl:real^3`) THEN
8109      ANTS_TAC THENL
8110      [
8111        MATCH_MP_TAC HD_IN_SET_OF_LIST THEN
8112          ASM_REWRITE_TAC[] THEN ARITH_TAC;
8113        ALL_TAC
8114      ] THEN
8115      DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
8116      DISCH_THEN (MP_TAC o SPEC `HD vl:real^3`) THEN
8117      ANTS_TAC THENL
8118      [
8119        SUBGOAL_THEN `HD vl = HD ul:real^3` (fun th -> REWRITE_TAC[th]) THENL
8120          [
8121            EXPAND_TAC "vl" THEN
8122              MATCH_MP_TAC HD_TRUNCATE_SIMPLEX THEN
8123              ASM_REWRITE_TAC[] THEN ARITH_TAC;
8124            ALL_TAC
8125          ] THEN
8126          MATCH_MP_TAC HD_IN_SET_OF_LIST THEN
8127          ASM_REWRITE_TAC[] THEN ARITH_TAC;
8128        ALL_TAC
8129      ] THEN
8130
8131      SIMP_TAC[]);;
8132
8133
8134
8135 (*************************************************)
8136
8137 (***********)
8138 (* WAUFCHE *)
8139 (***********)
8140
8141
8142 (* WAUFCHE1 *)
8143
8144
8145 let IN_VORONOI_LIST_IMP_IN_BIS = prove(`!V ul k x. barV V k ul /\ x IN voronoi_list V ul ==>
8146                                           (!u. u IN set_of_list ul ==> x IN bis (HD ul) u)`,
8147    REPEAT STRIP_TAC THEN
8148      MP_TAC (ISPEC `ul:(real^3)list` LENGTH_IMP_CONS) THEN
8149      ANTS_TAC THENL
8150      [
8151        UNDISCH_TAC `barV V k ul` THEN SIMP_TAC[BARV; ARITH_RULE `1 <= k + 1`];
8152        ALL_TAC
8153      ] THEN
8154      STRIP_TAC THEN
8155      MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `h:real^3`; `t:(real^3)list`] VORONOI_LIST_BIS) THEN
8156      ANTS_TAC THENL
8157      [
8158        ASM_REWRITE_TAC[] THEN
8159          MATCH_MP_TAC BARV_SUBSET THEN
8160          EXISTS_TAC `k:num` THEN
8161          POP_ASSUM (fun th -> ASM_REWRITE_TAC[SYM th]);
8162        ALL_TAC
8163      ] THEN
8164
8165      DISCH_TAC THEN
8166      UNDISCH_TAC `x:real^3 IN voronoi_list V ul` THEN
8167      ASM_REWRITE_TAC[IN_INTER; IN_INTERS; IN_ELIM_THM; HD] THEN
8168      STRIP_TAC THEN
8169      UNDISCH_TAC `u:real^3 IN set_of_list ul` THEN
8170      ASM_REWRITE_TAC[IN_SET_OF_LIST; MEM] THEN
8171      DISCH_THEN DISJ_CASES_TAC THENL
8172      [
8173        ASM_REWRITE_TAC[bis; IN_ELIM_THM];
8174        ALL_TAC
8175      ] THEN
8176
8177      FIRST_X_ASSUM (MP_TAC o SPEC `bis h (u:real^3)`) THEN
8178      DISCH_THEN MATCH_MP_TAC THEN
8179      EXISTS_TAC `u:real^3` THEN
8180      ASM_REWRITE_TAC[IN_SET_OF_LIST]);;
8181
8182
8183
8184
8185
8186 let WAUFCHE1 = prove(`!V ul k. packing V /\ ul IN barV V k ==> hl ul <= dist(omega_list V ul, HD ul)`,
8187    REWRITE_TAC[IN] THEN REPEAT STRIP_TAC THEN
8188      ABBREV_TAC `p = omega_list V ul` THEN
8189      MP_TAC (ISPECL [`set_of_list ul:real^3->bool`; `p:real^3`] AFFINE_HULL_PROJECTION_EXISTS) THEN
8190      SUBGOAL_THEN `LENGTH (ul:(real^3)list) = k + 1` ASSUME_TAC THENL
8191      [
8192        UNDISCH_TAC `barV V k ul` THEN SIMP_TAC[BARV];
8193        ALL_TAC
8194      ] THEN
8195      SUBGOAL_THEN `HD (ul:(real^3)list) IN set_of_list ul` ASSUME_TAC THENL
8196      [
8197        MATCH_MP_TAC HD_IN_SET_OF_LIST THEN ASM_REWRITE_TAC[] THEN ARITH_TAC;
8198        ALL_TAC
8199      ] THEN
8200      ASM_REWRITE_TAC[SET_OF_LIST_EQ_EMPTY; GSYM LENGTH_EQ_NIL; ARITH_RULE `~(k + 1 = 0)`] THEN
8201      STRIP_TAC THEN
8202      MATCH_MP_TAC REAL_LE_TRANS THEN
8203      EXISTS_TAC `dist (x:real^3, HD ul)` THEN
8204      CONJ_TAC THENL
8205      [
8206        MP_TAC (SPEC_ALL HL_EQ_DIST0) THEN
8207          ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
8208          REWRITE_TAC[REAL_LE_LT] THEN
8209          DISJ2_TAC THEN
8210          AP_TERM_TAC THEN REWRITE_TAC[PAIR_EQ] THEN
8211          MP_TAC (ISPEC `set_of_list ul:real^3->bool` OAPVION3) THEN
8212          ANTS_TAC THENL
8213          [
8214            MATCH_MP_TAC BARV_AFFINE_INDEPENDENT THEN
8215              MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `k:num`] THEN
8216              ASM_REWRITE_TAC[];
8217            ALL_TAC
8218          ] THEN
8219
8220          DISCH_THEN (MATCH_MP_TAC o GSYM) THEN
8221          ASM_REWRITE_TAC[] THEN
8222          EXISTS_TAC `dist (x:real^3, HD ul)` THEN
8223          REPEAT STRIP_TAC THEN
8224          MATCH_MP_TAC AFFINE_HULL_PROJECTION_DIST_EQ THEN
8225          MAP_EVERY EXISTS_TAC [`set_of_list ul:real^3->bool`; `p:real^3`; `n:real^3`] THEN
8226          ASM_REWRITE_TAC[] THEN
8227          MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `k:num`; `p:real^3`] IN_VORONOI_LIST_IMP_IN_BIS) THEN
8228          ANTS_TAC THENL
8229          [
8230            EXPAND_TAC "p" THEN
8231              CONJ_TAC THENL [ ASM_REWRITE_TAC[]; ALL_TAC ] THEN
8232              MATCH_MP_TAC OMEGA_LIST_IN_VORONOI_LIST THEN
8233              EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[];
8234            ALL_TAC
8235          ] THEN
8236          DISCH_THEN (MP_TAC o SPEC `w:real^3`) THEN
8237          ASM_REWRITE_TAC[bis; IN_ELIM_THM];
8238        ALL_TAC
8239      ] THEN
8240
8241      MATCH_MP_TAC AFFINE_HULL_PROJECTION_DIST_LE THEN
8242      MAP_EVERY EXISTS_TAC [`set_of_list ul:real^3->bool`; `n:real^3`] THEN
8243      ASM_REWRITE_TAC[]);;
8244
8245
8246
8247 (* WAUFCHE2 *)
8248
8249 let WAUFCHE2 = prove(`!V ul k. packing V /\ ul IN barV V k /\ hl ul < sqrt(&2) ==>
8250                        (hl ul = dist(omega_list V ul, HD ul))`,
8251    REWRITE_TAC[IN] THEN REPEAT STRIP_TAC THEN
8252      MP_TAC (SPECL [`V:real^3->bool`; `k:num`; `ul:(real^3)list`] HL_EQ_DIST0) THEN
8253      ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
8254      AP_TERM_TAC THEN
8255      REWRITE_TAC[PAIR_EQ] THEN
8256      MATCH_MP_TAC (GSYM XNHPWAB1) THEN
8257      EXISTS_TAC `k:num` THEN
8258      ASM_REWRITE_TAC[IN] THEN
8259      MATCH_MP_TAC BARV_IMP_K_LE_3 THEN
8260      MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `ul:(real^3)list`] THEN
8261      ASM_REWRITE_TAC[]);;
8262
8263
8264
8265 (*************************************************)
8266
8267 (********************)
8268 (* Delaunay simplex *)
8269 (********************)
8270
8271
8272
8273 (* YIFVQDV *)
8274
8275
8276 let CIRCUMCENTER_IN_VORONOI_SET = prove(`!V (S:real^3->bool). packing V /\ S SUBSET V /\ ~affine_dependent S /\ radV S < sqrt (&2)
8277                                            ==> circumcenter S IN voronoi_set V S`,
8278    REPEAT STRIP_TAC THEN
8279      ABBREV_TAC `p:real^3 = circumcenter S` THEN
8280      MP_TAC (ISPEC `S:real^3->bool` OAPVION2) THEN
8281      MP_TAC (ISPECL [`V:real^3->bool`; `S:real^3->bool`; `p:real^3`] XYOFCGX) THEN
8282      ASM_REWRITE_TAC[] THEN
8283      REPEAT DISCH_TAC THEN
8284      REWRITE_TAC[VORONOI_SET; IN_INTERS; IN_ELIM_THM; voronoi_closed] THEN
8285      REPEAT STRIP_TAC THEN
8286      ASM_REWRITE_TAC[IN_ELIM_THM] THEN
8287      REPEAT STRIP_TAC THEN
8288      POP_ASSUM (ASSUME_TAC o ONCE_REWRITE_RULE[GSYM IN]) THEN
8289      ASM_CASES_TAC `w:real^3 IN S` THENL
8290      [
8291        FIRST_ASSUM (MP_TAC o SPEC `w:real^3`) THEN
8292          FIRST_X_ASSUM (MP_TAC o SPEC `v:real^3`) THEN
8293          ASM_REWRITE_TAC[] THEN
8294          SIMP_TAC[REAL_LE_REFL];
8295        ALL_TAC
8296      ] THEN
8297
8298      FIRST_X_ASSUM (MP_TAC o SPECL [`v:real^3`; `w:real^3`]) THEN
8299      ASM_REWRITE_TAC[IN_DIFF; DIST_SYM] THEN
8300      REAL_ARITH_TAC);;
8301
8302
8303
8304
8305 let NEIGHBORHOOD_lemma = prove(`!V S p. packing V /\ S SUBSET V /\ (!u v. u IN S /\ v IN V DIFF S ==> dist (v, p) > dist (u, p))
8306                                  ==> ?r. &0 < r /\ (!x u v. x IN ball(p, r) /\ u IN S /\ v IN V DIFF S ==> dist (v, x) > dist (u, x))`,
8307    REWRITE_TAC[real_gt] THEN REPEAT STRIP_TAC THEN
8308      ASM_CASES_TAC `V DIFF S = {}:real^3->bool` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THENL
8309      [
8310        EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01];
8311        ALL_TAC
8312      ] THEN
8313
8314      SUBGOAL_THEN `?R. S SUBSET ball(p:real^3, R)` CHOOSE_TAC THENL
8315      [
8316        POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN STRIP_TAC THEN
8317          EXISTS_TAC `dist (x:real^3, p)` THEN
8318          REWRITE_TAC[ball; SUBSET; IN_ELIM_THM] THEN
8319          REPEAT STRIP_TAC THEN
8320          FIRST_X_ASSUM (MP_TAC o SPECL [`x':real^3`; `x:real^3`]) THEN
8321          ASM_REWRITE_TAC[DIST_SYM];
8322        ALL_TAC
8323      ] THEN
8324
8325      SUBGOAL_THEN `?d. &0 < d /\ (!u v. u IN S /\ v IN (V DIFF S) INTER ball (p:real^3, R + &2) ==> dist (v, p) >= dist (u, p) + d)` STRIP_ASSUME_TAC THENL
8326      [
8327        ABBREV_TAC `K = IMAGE (\(u,v). dist (v,p:real^3) - dist (u,p)) {u,v | u IN S /\ v IN (V DIFF S) INTER ball (p:real^3, R + &2)}` THEN
8328          SUBGOAL_THEN `FINITE (K:real->bool)` ASSUME_TAC THENL
8329          [
8330            EXPAND_TAC "K" THEN
8331              MATCH_MP_TAC FINITE_IMAGE THEN
8332              MATCH_MP_TAC FINITE_PRODUCT THEN
8333              CONJ_TAC THEN MATCH_MP_TAC FINITE_SUBSET THENL
8334              [
8335                EXISTS_TAC `V INTER ball (p:real^3, R)` THEN
8336                  ASM_SIMP_TAC[KIUMVTC; SUBSET_INTER];
8337                EXISTS_TAC `V INTER (ball (p:real^3, R + &2))` THEN
8338                  ASM_SIMP_TAC[KIUMVTC; SUBSET_INTER; INTER_SUBSET] THEN
8339                  SIMP_TAC[SUBSET; IN_INTER; IN_DIFF]
8340              ];
8341            ALL_TAC
8342          ] THEN
8343
8344          ASM_CASES_TAC `K = {}:real->bool` THENL
8345          [
8346            POP_ASSUM MP_TAC THEN EXPAND_TAC "K" THEN
8347              REWRITE_TAC[IMAGE_EQ_EMPTY; EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM; NOT_EXISTS_THM] THEN
8348              DISCH_TAC THEN
8349              EXISTS_TAC `&1` THEN
8350              REWRITE_TAC[REAL_LT_01] THEN
8351              REPEAT STRIP_TAC THEN
8352              FIRST_X_ASSUM (MP_TAC o SPECL [`u:real^3,v:real^3`; `u:real^3`; `v:real^3`]) THEN
8353              ASM_REWRITE_TAC[];
8354            ALL_TAC
8355          ] THEN
8356
8357          EXISTS_TAC `inf (K:real->bool)` THEN
8358          MP_TAC (SPEC `K:real->bool` INF_FINITE) THEN
8359          ASM_REWRITE_TAC[] THEN
8360          STRIP_TAC THEN
8361          ABBREV_TAC `d = inf K` THEN
8362          CONJ_TAC THENL
8363          [
8364            UNDISCH_TAC `d:real IN K` THEN
8365              EXPAND_TAC "K" THEN
8366              REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN
8367              REPEAT STRIP_TAC THEN
8368              ASM_REWRITE_TAC[] THEN
8369              FIRST_X_ASSUM (MP_TAC o SPECL [`u:real^3`; `v:real^3`]) THEN
8370              ANTS_TAC THENL
8371              [
8372                ASM_REWRITE_TAC[] THEN
8373                  REMOVE_ASSUM THEN POP_ASSUM MP_TAC THEN
8374                  SIMP_TAC[IN_INTER];
8375                ALL_TAC
8376              ] THEN
8377              REAL_ARITH_TAC;
8378            ALL_TAC
8379          ] THEN
8380
8381          REPEAT STRIP_TAC THEN
8382          FIRST_X_ASSUM (MP_TAC o SPEC `dist (v:real^3,p) - dist (u,p)`) THEN
8383          ANTS_TAC THENL
8384          [
8385            EXPAND_TAC "K" THEN
8386              REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN
8387              EXISTS_TAC `u:real^3,v:real^3` THEN
8388              REWRITE_TAC[] THEN
8389              MAP_EVERY EXISTS_TAC [`u:real^3`; `v:real^3`] THEN
8390              ASM_REWRITE_TAC[];
8391            ALL_TAC
8392          ] THEN
8393          REAL_ARITH_TAC;
8394        ALL_TAC
8395      ] THEN
8396
8397      ABBREV_TAC `r = min (&1) (d / &2)` THEN
8398      SUBGOAL_THEN `&0 < r /\ r <= &1 /\ r <= d / &2` ASSUME_TAC THENL
8399      [
8400        EXPAND_TAC "r" THEN
8401          REWRITE_TAC[REAL_MIN_MIN; REAL_LT_MIN] THEN
8402          UNDISCH_TAC `&0 < d` THEN REAL_ARITH_TAC;
8403        ALL_TAC
8404      ] THEN
8405
8406      EXISTS_TAC `r:real` THEN
8407      ASM_REWRITE_TAC[ball; IN_ELIM_THM] THEN
8408      REPEAT STRIP_TAC THEN
8409
8410      ONCE_REWRITE_TAC[REAL_ARITH `a < b <=> &0 < b - a`] THEN
8411      MATCH_MP_TAC REAL_LTE_TRANS THEN
8412      EXISTS_TAC `(dist (v, p) - dist (u, p)) - &2 * dist (p:real^3, x)` THEN
8413      CONJ_TAC THENL
8414      [
8415        MATCH_MP_TAC REAL_LET_TRANS THEN
8416          EXISTS_TAC `dist (v, p) - dist (u, p:real^3) - &2 * r` THEN
8417          CONJ_TAC THENL
8418          [
8419            ASM_CASES_TAC `v IN ball (p:real^3,R + &2)` THENL
8420              [
8421                FIRST_X_ASSUM (MP_TAC o SPECL [`u:real^3`; `v:real^3`]) THEN
8422                  ASM_REWRITE_TAC[IN_INTER] THEN
8423                  FIRST_X_ASSUM (MP_TAC o check (is_conj o concl)) THEN
8424                  REAL_ARITH_TAC;
8425                ALL_TAC
8426              ] THEN
8427
8428              POP_ASSUM MP_TAC THEN
8429              SUBGOAL_THEN `u IN ball(p:real^3,R)` MP_TAC THENL
8430              [
8431                MATCH_MP_TAC IN_TRANS THEN
8432                  EXISTS_TAC `S:real^3->bool` THEN
8433                  ASM_REWRITE_TAC[];
8434                ALL_TAC
8435              ] THEN
8436              REWRITE_TAC[ball; IN_ELIM_THM; REAL_NOT_LT; DIST_SYM] THEN
8437              FIRST_X_ASSUM (MP_TAC o check (is_conj o concl)) THEN
8438              REAL_ARITH_TAC;
8439            ALL_TAC
8440          ] THEN
8441
8442          UNDISCH_TAC `dist (p:real^3,x) < r` THEN
8443          REAL_ARITH_TAC;
8444        ALL_TAC
8445      ] THEN
8446
8447      MP_TAC (ISPECL [`u:real^3`; `p:real^3`; `x:real^3`] DIST_TRIANGLE) THEN
8448      MP_TAC (ISPECL [`p:real^3`; `x:real^3`; `v:real^3`] DIST_TRIANGLE) THEN
8449      REWRITE_TAC[DIST_SYM] THEN
8450      REAL_ARITH_TAC);;
8451
8452
8453
8454 let SUBSPACES_INTER_BALL_EQ_IMP_EQ = prove(`!s t r. subspace s /\ subspace t /\
8455                                      &0 < r /\ s INTER ball (vec 0:real^N, r) = t INTER ball (vec 0, r)
8456                                      ==> s = t`,
8457    REWRITE_TAC[subspace] THEN REPEAT STRIP_TAC THEN
8458      SUBGOAL_THEN `!v:real^N. ?d. d % v IN ball (vec 0,r) /\ v = (inv d) % (d % v)` ASSUME_TAC THENL
8459      [
8460        GEN_TAC THEN
8461          EXISTS_TAC `(r / &2) * inv(norm (v:real^N))` THEN
8462          ASM_CASES_TAC `v = vec 0:real^N` THENL
8463          [
8464            ASM_REWRITE_TAC[VECTOR_MUL_RZERO; CENTRE_IN_BALL];
8465            ALL_TAC
8466          ] THEN
8467
8468          POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM NORM_EQ_0] THEN DISCH_TAC THEN
8469          CONJ_TAC THENL
8470          [
8471            REWRITE_TAC[ball; IN_ELIM_THM; dist; VECTOR_SUB_LZERO; NORM_NEG; NORM_MUL] THEN
8472              REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NORM; GSYM REAL_MUL_ASSOC] THEN
8473              ASM_SIMP_TAC[REAL_MUL_LINV] THEN
8474              UNDISCH_TAC `&0 < r` THEN REAL_ARITH_TAC;
8475            ALL_TAC
8476          ] THEN
8477          REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_INV_MUL; REAL_INV_INV] THEN
8478          REWRITE_TAC[REAL_ARITH `(ia * b) * a * ib = (ia * a) * (ib * b)`] THEN
8479          ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `&0 < r ==> ~(r / &2 = &0)`] THEN
8480          REWRITE_TAC[REAL_MUL_LID; VECTOR_MUL_LID];
8481        ALL_TAC
8482      ] THEN
8483
8484      REWRITE_TAC[EXTENSION] THEN GEN_TAC THEN
8485      EQ_TAC THEN DISCH_TAC THENL
8486      [
8487        FIRST_X_ASSUM (MP_TAC o SPEC `x:real^N`) THEN
8488          STRIP_TAC THEN
8489          ABBREV_TAC `v:real^N = d % x` THEN
8490          FIRST_X_ASSUM (MP_TAC o SPECL [`inv d`; `v:real^N`]) THEN
8491          ASM_REWRITE_TAC[] THEN
8492          DISCH_THEN MATCH_MP_TAC THEN
8493          SUBGOAL_THEN `v IN s INTER ball (vec 0:real^N,r)` MP_TAC THENL
8494          [
8495            ASM_REWRITE_TAC[IN_INTER] THEN
8496              EXPAND_TAC "v" THEN
8497              FIRST_X_ASSUM MATCH_MP_TAC THEN
8498              ASM_REWRITE_TAC[];
8499            ALL_TAC
8500          ] THEN
8501          ASM_REWRITE_TAC[] THEN
8502          SIMP_TAC[IN_INTER];
8503        ALL_TAC
8504      ] THEN
8505
8506      FIRST_X_ASSUM (MP_TAC o SPEC `x:real^N`) THEN
8507      STRIP_TAC THEN
8508      ABBREV_TAC `v:real^N = d % x` THEN
8509      ASM_REWRITE_TAC[] THEN
8510      FIRST_X_ASSUM MATCH_MP_TAC THEN
8511      SUBGOAL_THEN `v IN t INTER ball (vec 0:real^N,r)` MP_TAC THENL
8512      [
8513        ASM_REWRITE_TAC[IN_INTER] THEN
8514          EXPAND_TAC "v" THEN
8515          FIRST_X_ASSUM MATCH_MP_TAC THEN
8516          ASM_REWRITE_TAC[];
8517        ALL_TAC
8518      ] THEN
8519
8520      REPLICATE_TAC 4 REMOVE_ASSUM THEN
8521      POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
8522      SIMP_TAC[IN_INTER]);;
8523
8524
8525
8526
8527 let AFFINES_INTER_BALL_EQ_IMP_EQ = prove(`!s t (x:real^N) r. affine s /\ affine t /\
8528                                          &0 < r /\ s INTER ball (x, r) = t INTER ball (x, r) /\ x IN s
8529                                           ==> s = t`,
8530    REPEAT STRIP_TAC THEN
8531      SUBGOAL_THEN `IMAGE (\v:real^N. --x + v) s = IMAGE (\v:real^N. --x + v) t` MP_TAC THENL
8532      [
8533        MATCH_MP_TAC SUBSPACES_INTER_BALL_EQ_IMP_EQ THEN
8534          EXISTS_TAC `r:real` THEN
8535          ASM_REWRITE_TAC[] THEN
8536          REPEAT CONJ_TAC THENL
8537          [
8538            MATCH_MP_TAC AFFINE_IMP_SUBSPACE THEN
8539              ASM_REWRITE_TAC[AFFINE_TRANSLATION_EQ; IN_IMAGE] THEN
8540              EXISTS_TAC `x:real^N` THEN
8541              ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC;
8542            MATCH_MP_TAC AFFINE_IMP_SUBSPACE THEN
8543              ASM_REWRITE_TAC[AFFINE_TRANSLATION_EQ; IN_IMAGE] THEN
8544              EXISTS_TAC `x:real^N` THEN
8545              REWRITE_TAC[VECTOR_ARITH `vec 0 = --x + x:real^N`] THEN
8546              MATCH_MP_TAC IN_TRANS THEN
8547              EXISTS_TAC `s INTER ball (x:real^N, r)` THEN
8548              ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; INTER_SUBSET];
8549            ALL_TAC
8550          ] THEN
8551
8552          SUBGOAL_THEN `!s. IMAGE (\v:real^N. --x + v) s INTER ball (vec 0,r) = IMAGE (\v. --x + v) (s INTER ball(x, r))` (fun th -> REWRITE_TAC[th]) THENL
8553          [
8554            GEN_TAC THEN
8555              SUBGOAL_THEN `ball (vec 0,r) = IMAGE (\v:real^N. --x + v) (ball (x, r))` (fun th -> REWRITE_TAC[th]) THENL
8556              [
8557                REWRITE_TAC[GSYM BALL_TRANSLATION; VECTOR_ARITH `--x + x = vec 0:real^N`];
8558                ALL_TAC
8559              ] THEN
8560
8561              MATCH_MP_TAC (GSYM IMAGE_INTER_INJ) THEN
8562              VECTOR_ARITH_TAC;
8563            ALL_TAC
8564          ] THEN
8565          ASM_REWRITE_TAC[];
8566        ALL_TAC
8567      ] THEN
8568
8569      MP_TAC (ISPEC `\v:real^N. --x + v` INJECTIVE_IMAGE) THEN
8570      REWRITE_TAC[VECTOR_ARITH `--x + x' = --x + y ==> x' = y:real^N`] THEN
8571      DISCH_THEN (MP_TAC o ISPECL [`s:real^N->bool`; `t:real^N->bool`]) THEN
8572      SIMP_TAC[]);;
8573
8574
8575
8576 let VORONOI_LIST_EQ_INTERS_BIS = prove(`!V (ul:(real^3)list). set_of_list ul SUBSET V /\ 1 <= LENGTH ul
8577                                         ==> voronoi_list V ul = voronoi_closed V (HD ul) INTER (INTERS {bis (HD ul) u | u | u IN set_of_list ul})`,
8578    REPEAT STRIP_TAC THEN
8579      MP_TAC (ISPEC `ul:(real^3)list` LENGTH_IMP_CONS) THEN
8580      ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
8581      ASM_REWRITE_TAC[HD] THEN
8582      SUBGOAL_THEN `INTERS {bis h u | u | u:real^3 IN set_of_list (CONS h t)} = INTERS {bis h u | u | u IN set_of_list t}` (fun th -> REWRITE_TAC[th]) THENL
8583      [
8584        REWRITE_TAC[set_of_list; IN_INSERT] THEN
8585          REWRITE_TAC[EXTENSION; IN_INTERS; IN_ELIM_THM] THEN
8586          GEN_TAC THEN EQ_TAC THENL
8587          [
8588            REPEAT STRIP_TAC THEN
8589              ASM_REWRITE_TAC[] THEN
8590              FIRST_X_ASSUM (MP_TAC o SPEC `bis h (u:real^3)`) THEN
8591              ANTS_TAC THENL
8592              [
8593                EXISTS_TAC `u:real^3` THEN
8594                  ASM_REWRITE_TAC[];
8595                ALL_TAC
8596              ] THEN
8597              SIMP_TAC[];
8598            REPEAT STRIP_TAC THENL
8599              [
8600                ASM_REWRITE_TAC[bis; IN_ELIM_THM];
8601                ALL_TAC
8602              ] THEN
8603              ASM_REWRITE_TAC[] THEN
8604              FIRST_X_ASSUM (MP_TAC o SPEC `bis h (u:real^3)`) THEN
8605              ANTS_TAC THENL
8606              [
8607                EXISTS_TAC `u:real^3` THEN
8608                  ASM_REWRITE_TAC[];
8609                ALL_TAC
8610              ] THEN
8611              SIMP_TAC[]
8612          ];
8613        ALL_TAC
8614      ] THEN
8615      MATCH_MP_TAC VORONOI_LIST_BIS THEN
8616      POP_ASSUM (fun th -> ASM_REWRITE_TAC[SYM th]));;
8617
8618
8619
8620
8621
8622
8623 let AFFINE_HULL_VORONOI_LIST_SUBSET_INTERS_BIS = prove(`!V (ul:(real^3)list). set_of_list ul SUBSET V
8624                                                    ==> affine hull (voronoi_list V ul) SUBSET INTERS {bis (HD ul) u | u | u IN set_of_list ul}`,
8625    REPEAT STRIP_TAC THEN
8626      ASM_CASES_TAC `ul:(real^3)list = []` THENL
8627      [
8628        ASM_REWRITE_TAC[VORONOI_LIST; set_of_list; VORONOI_SET; NOT_IN_EMPTY] THEN
8629          SUBGOAL_THEN `{voronoi_closed V (v:real^3) | v | F} = {} /\ {bis (HD []) (u:real^3) | F} = {}` (fun th -> REWRITE_TAC[th]) THENL
8630          [
8631            REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY];
8632            ALL_TAC
8633          ] THEN
8634          REWRITE_TAC[INTERS_0; AFFINE_HULL_UNIV; SUBSET_REFL];
8635        ALL_TAC
8636      ] THEN
8637      SUBGOAL_THEN `1 <= LENGTH (ul:(real^3)list)` ASSUME_TAC THENL
8638      [
8639        ASM_REWRITE_TAC[ARITH_RULE `1 <= a <=> ~(a = 0)`; LENGTH_EQ_NIL];
8640        ALL_TAC
8641      ] THEN
8642      MATCH_MP_TAC SUBSET_TRANS THEN
8643      EXISTS_TAC `affine hull (INTERS {bis (HD ul) u | u | u:real^3 IN set_of_list ul})` THEN
8644      CONJ_TAC THENL
8645      [
8646        MATCH_MP_TAC HULL_MONO THEN
8647          ASM_SIMP_TAC[VORONOI_LIST_EQ_INTERS_BIS] THEN
8648          REWRITE_TAC[INTER_SUBSET];
8649        ALL_TAC
8650      ] THEN
8651      REWRITE_TAC[AFFINE_HULL_INTERS_BIS; SUBSET_REFL]);;
8652
8653
8654
8655
8656 let YIFVQDV_lemma_aff_dim = prove(`!V vl. packing V /\ set_of_list vl SUBSET V /\ ~affine_dependent (set_of_list vl) /\ hl vl < sqrt (&2)
8657                                     ==> aff_dim (voronoi_list V vl) = aff_dim (INTERS {bis (HD vl) v | v | v IN set_of_list vl})`,
8658    REPEAT STRIP_TAC THEN
8659      GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM AFF_DIM_AFFINE_HULL] THEN
8660      AP_TERM_TAC THEN
8661      MATCH_MP_TAC AFFINES_INTER_BALL_EQ_IMP_EQ THEN
8662      ABBREV_TAC `p:real^3 = circumcenter (set_of_list vl)` THEN
8663      ABBREV_TAC `S:real^3->bool = set_of_list vl` THEN
8664
8665      SUBGOAL_THEN `?r. &0 < r /\ (!x u v. x IN ball (p:real^3, r) /\ u IN S /\ v IN V DIFF S ==> dist (v, x) > dist (u, x))` STRIP_ASSUME_TAC THENL
8666      [
8667        MATCH_MP_TAC NEIGHBORHOOD_lemma THEN
8668          ASM_REWRITE_TAC[] THEN
8669          MATCH_MP_TAC XYOFCGX THEN
8670          ASM_REWRITE_TAC[] THEN
8671          EXPAND_TAC "S" THEN ASM_REWRITE_TAC[GSYM HL];
8672        ALL_TAC
8673      ] THEN
8674
8675      MAP_EVERY EXISTS_TAC [`p:real^3`; `r:real`] THEN
8676      ASM_REWRITE_TAC[AFFINE_AFFINE_HULL] THEN
8677      CONJ_TAC THENL
8678      [
8679        REWRITE_TAC[GSYM AFFINE_HULL_EQ] THEN
8680          REWRITE_TAC[AFFINE_HULL_INTERS_BIS];
8681        ALL_TAC
8682      ] THEN
8683
8684      CONJ_TAC THENL
8685      [
8686        MATCH_MP_TAC SUBSET_ANTISYM THEN
8687          CONJ_TAC THENL
8688          [
8689            REWRITE_TAC[SUBSET_INTER; INTER_SUBSET] THEN
8690              MATCH_MP_TAC SUBSET_TRANS THEN
8691              EXISTS_TAC `affine hull voronoi_list V vl` THEN
8692              REWRITE_TAC[INTER_SUBSET] THEN
8693              EXPAND_TAC "S" THEN
8694              MATCH_MP_TAC AFFINE_HULL_VORONOI_LIST_SUBSET_INTERS_BIS THEN
8695              ASM_REWRITE_TAC[];
8696            ALL_TAC
8697          ] THEN
8698
8699          MATCH_MP_TAC SUBSET_TRANS THEN
8700          EXISTS_TAC `voronoi_list V vl INTER ball (p,r)` THEN
8701          CONJ_TAC THENL
8702          [
8703            ASM_CASES_TAC `S = {}:real^3->bool` THENL
8704            [
8705              POP_ASSUM MP_TAC THEN EXPAND_TAC "S" THEN REWRITE_TAC[SET_OF_LIST_EQ_EMPTY] THEN
8706                DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
8707                REWRITE_TAC[VORONOI_LIST; VORONOI_SET; set_of_list; NOT_IN_EMPTY] THEN
8708                SUBGOAL_THEN `{bis (HD []) (v:real^3) | F} = {} /\ {voronoi_closed V (v:real^3) | v | F} = {}` (fun th -> REWRITE_TAC[th]) THENL
8709                [
8710                  REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM];
8711                  ALL_TAC
8712                ] THEN
8713                REWRITE_TAC[INTERS_0; INTER_UNIV; SUBSET_REFL];
8714              ALL_TAC
8715            ] THEN
8716
8717            SUBGOAL_THEN `1 <= LENGTH (vl:(real^3)list)` ASSUME_TAC THENL
8718            [
8719              POP_ASSUM MP_TAC THEN EXPAND_TAC "S" THEN
8720                REWRITE_TAC[SET_OF_LIST_EQ_EMPTY; ARITH_RULE `1 <= a <=> ~(a = 0)`; LENGTH_EQ_NIL];
8721              ALL_TAC
8722            ] THEN
8723
8724            MP_TAC (ISPECL [`V:real^3->bool`; `vl:(real^3)list`] VORONOI_LIST_EQ_INTERS_BIS) THEN
8725            ASM_REWRITE_TAC[] THEN
8726
8727            DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
8728            SIMP_TAC[SUBSET; IN_INTER] THEN
8729            REWRITE_TAC[IN_INTERS; voronoi_closed; IN_ELIM_THM] THEN
8730            REPEAT STRIP_TAC THEN
8731            POP_ASSUM (ASSUME_TAC o ONCE_REWRITE_RULE[GSYM IN]) THEN
8732
8733            ASM_CASES_TAC `w:real^3 IN S` THENL
8734            [
8735              FIRST_X_ASSUM (MP_TAC o SPEC `bis (HD vl) (w:real^3)`) THEN
8736                ANTS_TAC THENL
8737                [
8738                  EXISTS_TAC `w:real^3` THEN
8739                    ASM_REWRITE_TAC[];
8740                  ALL_TAC
8741                ] THEN
8742                SIMP_TAC[bis; IN_ELIM_THM; REAL_LE_REFL];
8743              ALL_TAC
8744            ] THEN
8745
8746            FIRST_X_ASSUM (MP_TAC o SPECL [`x:real^3`; `HD vl:real^3`; `w:real^3`]) THEN
8747            ANTS_TAC THENL
8748            [
8749              ASM_REWRITE_TAC[IN_DIFF] THEN
8750                EXPAND_TAC "S" THEN
8751                MATCH_MP_TAC HD_IN_SET_OF_LIST THEN
8752                ASM_REWRITE_TAC[];
8753              ALL_TAC
8754            ] THEN
8755            REWRITE_TAC[DIST_SYM; real_gt; REAL_LT_IMP_LE];
8756            ALL_TAC
8757          ] THEN
8758
8759          REWRITE_TAC[SUBSET_INTER; INTER_SUBSET] THEN
8760          MATCH_MP_TAC SUBSET_TRANS THEN
8761          EXISTS_TAC `voronoi_list V vl:real^3->bool` THEN
8762          REWRITE_TAC[INTER_SUBSET; HULL_SUBSET];
8763        ALL_TAC
8764      ] THEN
8765
8766      MATCH_MP_TAC IN_TRANS THEN
8767      EXISTS_TAC `voronoi_list V vl` THEN
8768      ASM_REWRITE_TAC[HULL_SUBSET; VORONOI_LIST] THEN
8769      EXPAND_TAC "p" THEN
8770      MATCH_MP_TAC CIRCUMCENTER_IN_VORONOI_SET THEN
8771      ASM_REWRITE_TAC[] THEN
8772      EXPAND_TAC "S" THEN ASM_REWRITE_TAC[GSYM HL]);;
8773
8774
8775
8776
8777 let YIFVQDV_1 = prove(`!V ul k p. packing V /\ ul IN barV V k /\
8778                         hl ul < sqrt (&2) /\ p permutes (0..k) ==>
8779                         left_action_list p ul IN barV V k`,
8780    REWRITE_TAC[IN] THEN REPEAT STRIP_TAC THEN
8781      ABBREV_TAC `vl = left_action_list p (ul:(real^3)list)` THEN
8782      REWRITE_TAC[BARV] THEN
8783
8784      SUBGOAL_THEN `LENGTH (vl:(real^3)list) = k + 1 /\ LENGTH (ul:(real^3)list) = k + 1` ASSUME_TAC THENL
8785      [
8786        EXPAND_TAC "vl" THEN REWRITE_TAC[LENGTH_LEFT_ACTION_LIST] THEN
8787          UNDISCH_TAC `barV V k ul` THEN SIMP_TAC[BARV];
8788        ALL_TAC
8789      ] THEN
8790      SUBGOAL_THEN `set_of_list vl = set_of_list ul:real^3->bool` ASSUME_TAC THENL
8791      [
8792        EXPAND_TAC "vl" THEN
8793          MP_TAC (ISPECL [`ul:(real^3)list`; `p:num->num`] SET_OF_LIST_LEFT_ACTION_LIST) THEN
8794          ASM_REWRITE_TAC[ARITH_RULE `(k + 1) - 1 = k`];
8795        ALL_TAC
8796      ] THEN
8797
8798      ASM_REWRITE_TAC[] THEN
8799      REPEAT STRIP_TAC THEN
8800      SUBGOAL_THEN `?j. vl':(real^3)list = truncate_simplex j vl /\ j + 1 <= k + 1 /\ LENGTH vl' = j + 1` CHOOSE_TAC THENL
8801      [
8802        EXISTS_TAC `LENGTH (vl':(real^3)list) - 1` THEN
8803          ABBREV_TAC `n = LENGTH (vl':(real^3)list)` THEN
8804          MP_TAC (ISPECL [`vl:(real^3)list`; `vl':(real^3)list`] INITIAL_SUBLIST_IMP_TRUNCATE_SIMPLEX) THEN
8805          ASM_REWRITE_TAC[ARITH_RULE `1 <= n <=> 0 < n`] THEN
8806          ASM_SIMP_TAC[ARITH_RULE `0 < n ==> n - 1 + 1 = n`];
8807        ALL_TAC
8808      ] THEN
8809
8810      REWRITE_TAC[VORONOI_NONDG] THEN
8811      ASM_REWRITE_TAC[] THEN
8812      REPEAT CONJ_TAC THENL
8813      [
8814        MATCH_MP_TAC LET_TRANS THEN
8815          EXISTS_TAC `k + 1` THEN
8816          ASM_REWRITE_TAC[] THEN
8817          UNDISCH_TAC `barV V k ul` THEN
8818          REWRITE_TAC[BARV; VORONOI_NONDG] THEN
8819          STRIP_TAC THEN
8820          FIRST_X_ASSUM (MP_TAC o SPEC `ul:(real^3)list`) THEN
8821          ASM_SIMP_TAC[INITIAL_SUBLIST_REFL; ARITH_RULE `0 < k + 1`];
8822        MATCH_MP_TAC SUBSET_TRANS THEN
8823          EXISTS_TAC `set_of_list (vl:(real^3)list)` THEN
8824          CONJ_TAC THENL
8825          [
8826            MATCH_MP_TAC SET_OF_LIST_TRUNCATE_SIMPLEX_SUBSET THEN
8827              ASM_REWRITE_TAC[];
8828            ALL_TAC
8829          ] THEN
8830          ASM_REWRITE_TAC[] THEN
8831          MATCH_MP_TAC BARV_SUBSET THEN
8832          EXISTS_TAC `k:num` THEN
8833          ASM_REWRITE_TAC[];
8834        ALL_TAC
8835      ] THEN
8836
8837      ABBREV_TAC `a = \j. if j = 0 then &4 else aff_dim (INTERS {bis (HD vl) (v:real^3) | v | v IN set_of_list (truncate_simplex (j - 1) vl)})` THEN
8838      SUBGOAL_THEN `!i. i <= k ==> aff_dim (voronoi_list (V:real^3->bool) (truncate_simplex i vl)) = a (i + 1)` ASSUME_TAC THENL
8839      [
8840        REPEAT STRIP_TAC THEN
8841          EXPAND_TAC "a" THEN
8842          REWRITE_TAC[ARITH_RULE `~(i + 1 = 0) /\ (i + 1) - 1 = i`] THEN
8843          SUBGOAL_THEN `HD vl = HD (truncate_simplex i vl):real^3` (fun th -> REWRITE_TAC[th]) THENL
8844          [
8845            MATCH_MP_TAC (GSYM HD_TRUNCATE_SIMPLEX) THEN
8846              ASM_REWRITE_TAC[ARITH_RULE `i + 1 <= k + 1 <=> i <= k`];
8847            ALL_TAC
8848          ] THEN
8849
8850          MATCH_MP_TAC YIFVQDV_lemma_aff_dim THEN
8851          ASM_REWRITE_TAC[] THEN
8852          SUBGOAL_THEN `set_of_list (truncate_simplex i vl) SUBSET set_of_list vl:real^3->bool` ASSUME_TAC THENL
8853          [
8854            MATCH_MP_TAC SET_OF_LIST_TRUNCATE_SIMPLEX_SUBSET THEN
8855              ASM_REWRITE_TAC[ARITH_RULE `i + 1 <= k + 1 <=> i <= k`];
8856            ALL_TAC
8857          ] THEN
8858
8859          REPEAT CONJ_TAC THENL
8860          [
8861            MATCH_MP_TAC SUBSET_TRANS THEN
8862              EXISTS_TAC `set_of_list vl:real^3->bool` THEN
8863              ASM_REWRITE_TAC[] THEN
8864              MATCH_MP_TAC BARV_SUBSET THEN
8865              EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[];
8866            MATCH_MP_TAC AFFINE_INDEPENDENT_SUBSET THEN
8867              EXISTS_TAC `set_of_list vl:real^3->bool` THEN
8868              ASM_REWRITE_TAC[] THEN
8869              MATCH_MP_TAC BARV_AFFINE_INDEPENDENT THEN
8870              MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `k:num`] THEN
8871              ASM_REWRITE_TAC[];
8872            ALL_TAC
8873          ] THEN
8874
8875          MATCH_MP_TAC REAL_LET_TRANS THEN
8876          EXISTS_TAC `hl (vl:(real^3)list)` THEN
8877          CONJ_TAC THENL
8878          [
8879            REWRITE_TAC[HL] THEN
8880              MATCH_MP_TAC RADV_MONO THEN
8881              ASM_REWRITE_TAC[] THEN
8882              CONJ_TAC THENL
8883              [
8884                MATCH_MP_TAC BARV_AFFINE_INDEPENDENT THEN
8885                  MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `k:num`] THEN ASM_REWRITE_TAC[];
8886                ALL_TAC
8887              ] THEN
8888
8889              REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
8890              EXISTS_TAC `HD (truncate_simplex i vl):real^3` THEN
8891              MATCH_MP_TAC HD_IN_SET_OF_LIST THEN
8892              MP_TAC (ISPECL [`i:num`; `vl:(real^3)list`] LENGTH_TRUNCATE_SIMPLEX) THEN
8893              ASM_REWRITE_TAC[ARITH_RULE `i + 1 <= k + 1 <=> i <= k`] THEN
8894              SIMP_TAC[ARITH_RULE `1 <= i + 1`];
8895            ALL_TAC
8896          ] THEN
8897          ASM_REWRITE_TAC[HL] THEN
8898          ASM_REWRITE_TAC[GSYM HL];
8899        ALL_TAC
8900      ] THEN
8901
8902      SUBGOAL_THEN `a 0 = int_of_num 4 /\ a 1 = &3` ASSUME_TAC THENL
8903      [
8904        EXPAND_TAC "a" THEN
8905          REWRITE_TAC[ARITH_RULE `~(1 = 0) /\ 1 - 1 = 0`] THEN
8906          ASM_SIMP_TAC[TRUNCATE_0_EQ_HEAD; ARITH_RULE `1 <= k + 1`] THEN
8907          REWRITE_TAC[set_of_list; IN_SING] THEN
8908          SUBGOAL_THEN `INTERS {bis (HD vl) v | v | v = HD vl:real^3} = bis (HD vl) (HD vl)` (fun th -> REWRITE_TAC[th]) THENL
8909          [
8910            REWRITE_TAC[EXTENSION; IN_INTERS; IN_ELIM_THM; IN_SING] THEN
8911              GEN_TAC THEN REWRITE_TAC[GSYM EXTENSION] THEN
8912              EQ_TAC THEN REPEAT STRIP_TAC THENL
8913              [
8914                POP_ASSUM (MP_TAC o SPEC `bis (HD vl) (HD vl):real^3->bool`) THEN
8915                  ANTS_TAC THENL [ EXISTS_TAC `HD vl:real^3` THEN REWRITE_TAC[]; ALL_TAC ] THEN
8916                  REWRITE_TAC[];
8917                ASM_REWRITE_TAC[]
8918              ];
8919            ALL_TAC
8920          ] THEN
8921          REWRITE_TAC[bis] THEN
8922          SUBGOAL_THEN `{x:real^3 | T} = UNIV` (fun th -> REWRITE_TAC[th]) THENL [ REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV]; ALL_TAC ] THEN
8923          REWRITE_TAC[AFF_DIM_UNIV; DIMINDEX_3];
8924        ALL_TAC
8925      ] THEN
8926
8927      SUBGOAL_THEN `!j. j <= k ==> int_of_num 3 - &j <= a j - &1 /\ a j - &1 <= a (j + 1) /\ (a (j + 1) = &3 - &j <=> (!i. i <= j ==> a (i + 1) = &3 - &i))` ASSUME_TAC THENL
8928      [
8929        INDUCT_TAC THENL
8930          [
8931            DISCH_TAC THEN
8932              ASM_SIMP_TAC[ARITH; ARITH_RULE `i <= 0 <=> i = 0`] THEN
8933              INT_ARITH_TAC;
8934            ALL_TAC
8935          ] THEN
8936
8937          REWRITE_TAC[ADD1] THEN DISCH_TAC THEN
8938          FIRST_X_ASSUM (MP_TAC o check (is_imp o concl)) THEN
8939          ASM_SIMP_TAC[ARITH_RULE `j' + 1 <= k ==> j' <= k`] THEN
8940
8941          STRIP_TAC THEN
8942          CONJ_TAC THENL
8943          [
8944            REMOVE_ASSUM THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
8945              REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN
8946              INT_ARITH_TAC;
8947            ALL_TAC
8948          ] THEN
8949
8950          SUBGOAL_THEN `a (j' + 1) - int_of_num 1 <= a ((j' + 1) + 1)` ASSUME_TAC THENL
8951          [
8952            EXPAND_TAC "a" THEN
8953              REWRITE_TAC[ARITH_RULE `~(j' + 1 = 0) /\ ~((j' + 1) + 1 = 0) /\ (j' + 1) - 1 = j' /\ ((j' + 1) + 1) - 1 = j' + 1`] THEN
8954              ABBREV_TAC `s:real^3->bool = INTERS {bis (HD vl) v | v | v IN set_of_list (truncate_simplex j' vl)}` THEN
8955              ABBREV_TAC `t:real^3->bool = INTERS {bis (HD vl) v | v | v IN set_of_list (truncate_simplex (j' + 1) vl)}` THEN
8956              SUBGOAL_THEN `~(t = {}:real^3->bool)` ASSUME_TAC THENL
8957              [
8958                EXPAND_TAC "t" THEN
8959                  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
8960                  ABBREV_TAC `S:real^3->bool = set_of_list (truncate_simplex (j' + 1) vl)` THEN
8961                  ABBREV_TAC `c:real^3 = circumcenter S` THEN
8962                  EXISTS_TAC `c:real^3` THEN
8963                  REWRITE_TAC[IN_INTERS; IN_ELIM_THM] THEN
8964                  REPEAT STRIP_TAC THEN
8965                  ASM_REWRITE_TAC[bis; IN_ELIM_THM] THEN
8966                  MP_TAC (ISPEC `S:real^3->bool` OAPVION2) THEN
8967                  ANTS_TAC THENL
8968                  [
8969                    MATCH_MP_TAC AFFINE_INDEPENDENT_SUBSET THEN
8970                      EXISTS_TAC `set_of_list vl:real^3->bool` THEN
8971                      CONJ_TAC THENL
8972                      [
8973                        ASM_REWRITE_TAC[] THEN
8974                          MATCH_MP_TAC BARV_AFFINE_INDEPENDENT THEN
8975                          MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `k:num`] THEN
8976                          ASM_REWRITE_TAC[];
8977                        ALL_TAC
8978                      ] THEN
8979                      EXPAND_TAC "S" THEN
8980                      MATCH_MP_TAC SET_OF_LIST_TRUNCATE_SIMPLEX_SUBSET THEN
8981                      MATCH_MP_TAC LE_TRANS THEN
8982                      EXISTS_TAC `k + 1` THEN
8983                      ASM_REWRITE_TAC[LE_REFL; ARITH_RULE `a + 1 <= b + 1 <=> a <= b`];
8984                    ALL_TAC
8985                  ] THEN
8986
8987                  DISCH_TAC THEN
8988                  FIRST_ASSUM (MP_TAC o SPEC `v:real^3`) THEN
8989                  FIRST_X_ASSUM (MP_TAC o SPEC `HD vl:real^3`) THEN
8990                  ANTS_TAC THENL
8991                  [
8992                    EXPAND_TAC "S" THEN
8993                      SUBGOAL_THEN `HD vl:real^3 = HD (truncate_simplex (j' + 1) vl)` (fun th -> REWRITE_TAC[th]) THENL
8994                      [
8995                        MATCH_MP_TAC (GSYM HD_TRUNCATE_SIMPLEX) THEN
8996                          ASM_SIMP_TAC[ARITH_RULE `j' + 1 <= k ==> (j' + 1) + 1 <= k + 1`];
8997                        ALL_TAC
8998                      ] THEN
8999                      MATCH_MP_TAC HD_IN_SET_OF_LIST THEN
9000                      MP_TAC (ISPECL [`j' + 1`; `vl:(real^3)list`] LENGTH_TRUNCATE_SIMPLEX) THEN
9001                      ASM_SIMP_TAC[ARITH_RULE `j' + 1 <= k ==> (j' + 1) + 1 <= k + 1`; ARITH_RULE `1 <= a + 1`];
9002                    ALL_TAC
9003                  ] THEN
9004                  ASM_SIMP_TAC[];
9005                ALL_TAC
9006              ] THEN
9007
9008              SUBGOAL_THEN `?w:real^3. t = s INTER bis (HD vl) w` CHOOSE_TAC THENL
9009              [
9010                ABBREV_TAC `w:real^3 = LAST (truncate_simplex (j' + 1) vl)` THEN
9011                  EXISTS_TAC `w:real^3` THEN
9012                  EXPAND_TAC "t" THEN EXPAND_TAC "s" THEN
9013                  MP_TAC (ISPECL [`vl:(real^3)list`; `j':num`] TRUNCATE_SIMPLEX_ADD1) THEN
9014                  ANTS_TAC THENL
9015                  [
9016                    ASM_REWRITE_TAC[] THEN
9017                      UNDISCH_TAC `j' + 1 <= k` THEN
9018                      ARITH_TAC;
9019                    ALL_TAC
9020                  ] THEN
9021                  ABBREV_TAC `yl = truncate_simplex (j' + 1) vl:(real^3)list` THEN
9022                  DISCH_THEN (fun th -> ONCE_REWRITE_TAC[th]) THEN
9023                  ASM_REWRITE_TAC[SET_OF_LIST_APPEND; set_of_list; IN_UNION; IN_SING] THEN
9024                  EXPAND_TAC "s" THEN
9025                  SET_TAC[];
9026                ALL_TAC
9027              ] THEN
9028              POP_ASSUM (ASSUME_TAC o REWRITE_RULE[BIS_EQ_HYPERPLANE]) THEN
9029              ABBREV_TAC `aa = &2 % (w - HD vl:real^3)` THEN
9030              ABBREV_TAC `bb = w dot (w:real^3) - HD vl dot (HD vl:real^3)` THEN
9031
9032              MP_TAC (ISPECL [`aa:real^3`; `bb:real`; `s:real^3->bool`] AFF_DIM_AFFINE_INTER_HYPERPLANE) THEN
9033              ANTS_TAC THENL
9034              [
9035                EXPAND_TAC "s" THEN
9036                  REWRITE_TAC[GSYM AFFINE_HULL_EQ] THEN
9037                  MATCH_MP_TAC HULL_INTERS_EQ_INTERS THEN
9038                  REWRITE_TAC[IN_ELIM_THM] THEN
9039                  REPEAT STRIP_TAC THEN
9040                  ASM_REWRITE_TAC[BIS_EQ_HYPERPLANE; AFFINE_HYPERPLANE];
9041                ALL_TAC
9042              ] THEN
9043
9044              REMOVE_ASSUM THEN REMOVE_ASSUM THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN
9045              ASM_REWRITE_TAC[] THEN
9046              DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
9047              COND_CASES_TAC THEN INT_ARITH_TAC;
9048            ALL_TAC
9049          ] THEN
9050
9051          ASM_REWRITE_TAC[] THEN
9052
9053          EQ_TAC THENL
9054          [
9055            REPEAT STRIP_TAC THEN
9056              SUBGOAL_THEN `a (j' + 1) = int_of_num 3 - &j'` MP_TAC THENL
9057              [
9058                REMOVE_ASSUM THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
9059                  REMOVE_ASSUM THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
9060                  REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN
9061                  INT_ARITH_TAC;
9062                ALL_TAC
9063              ] THEN
9064
9065              ASM_REWRITE_TAC[] THEN
9066              DISCH_TAC THEN
9067              ASM_CASES_TAC `i = j' + 1` THEN ASM_REWRITE_TAC[] THEN
9068              FIRST_X_ASSUM MATCH_MP_TAC THEN
9069              POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN
9070              ARITH_TAC;
9071            ALL_TAC
9072          ] THEN
9073
9074          DISCH_THEN (MP_TAC o SPEC `j' + 1`) THEN
9075          REWRITE_TAC[LE_REFL];
9076        ALL_TAC
9077      ] THEN
9078
9079      SUBGOAL_THEN `a (k + 1) = int_of_num 3 - &k` MP_TAC THENL
9080      [
9081        REMOVE_ASSUM THEN FIRST_X_ASSUM (MP_TAC o SPEC `k:num`) THEN
9082          REWRITE_TAC[LE_REFL] THEN
9083          DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
9084          SUBGOAL_THEN `truncate_simplex k vl = vl:(real^3)list` (fun th -> REWRITE_TAC[th]) THENL
9085          [
9086            MP_TAC (ISPECL [`k:num`; `vl:(real^3)list`; `vl:(real^3)list`] TRUNCATE_SIMPLEX_INITIAL_SUBLIST) THEN
9087              ASM_REWRITE_TAC[LE_REFL; INITIAL_SUBLIST_REFL];
9088            ALL_TAC
9089          ] THEN
9090          ASM_REWRITE_TAC[VORONOI_LIST] THEN
9091          REWRITE_TAC[GSYM VORONOI_LIST] THEN
9092          UNDISCH_TAC `barV V k ul` THEN
9093          REWRITE_TAC[BARV; VORONOI_NONDG] THEN
9094          STRIP_TAC THEN
9095          FIRST_X_ASSUM (MP_TAC o SPEC `ul:(real^3)list`) THEN
9096          ASM_REWRITE_TAC[INITIAL_SUBLIST_REFL; ARITH_RULE `0 < k + 1`; GSYM INT_OF_NUM_ADD] THEN
9097          INT_ARITH_TAC;
9098        ALL_TAC
9099      ] THEN
9100
9101      FIRST_X_ASSUM (MP_TAC o SPEC `k:num`) THEN
9102      REWRITE_TAC[LE_REFL] THEN
9103      DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
9104      DISCH_THEN (MP_TAC o SPEC `j:num`) THEN
9105      ASM_REWRITE_TAC[ARITH_RULE `j <= k <=> j + 1 <= k + 1`] THEN
9106      DISCH_TAC THEN
9107      FIRST_X_ASSUM (MP_TAC o SPEC `j:num`) THEN
9108      ASM_REWRITE_TAC[ARITH_RULE `j <= k <=> j + 1 <= k + 1`] THEN
9109      DISCH_THEN (fun th -> REWRITE_TAC[th; GSYM INT_OF_NUM_ADD]) THEN
9110      INT_ARITH_TAC);;
9111
9112
9113
9114
9115
9116 (* YIFVQDV *)
9117
9118 let YIFVQDV = prove(`!V ul k p. packing V /\ ul IN barV V k /\
9119                       hl ul < sqrt(&2) /\ p permutes (0..k) ==>
9120                       (left_action_list p ul IN barV V k) /\ (omega_list V (left_action_list p ul) = omega_list V ul)`,
9121    REWRITE_TAC[IN] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
9122      MP_TAC (SPEC_ALL YIFVQDV_1) THEN
9123      ASM_REWRITE_TAC[IN] THEN
9124      DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
9125      ABBREV_TAC `vl:(real^3)list = left_action_list p ul` THEN
9126
9127      MP_TAC (SPEC_ALL XNHPWAB1) THEN
9128      ASM_REWRITE_TAC[IN] THEN
9129      DISCH_TAC THEN
9130
9131      MP_TAC (SPECL [`V:real^3->bool`; `vl:(real^3)list`; `k:num`] XNHPWAB1) THEN
9132      ASM_REWRITE_TAC[HL; IN] THEN
9133      SUBGOAL_THEN `set_of_list vl = set_of_list ul:real^3->bool` (fun th -> REWRITE_TAC[th]) THENL
9134      [
9135        EXPAND_TAC "vl" THEN
9136          MATCH_MP_TAC SET_OF_LIST_LEFT_ACTION_LIST THEN
9137          UNDISCH_TAC `barV V k ul` THEN
9138          ASM_SIMP_TAC[BARV; ARITH_RULE `(k + 1) - 1 = k`];
9139        ALL_TAC
9140      ] THEN
9141      ASM_REWRITE_TAC[GSYM HL]);;
9142
9143
9144
9145
9146 (***************************************************)
9147
9148 (***********)
9149 (* KSOQKWL *)
9150 (***********)
9151
9152 let HL_TRUNCATE_SIMPLEX_OMEGA_N = prove(`!V k ul j. packing V /\ barV V k ul /\ j <= k /\ hl ul < sqrt (&2)
9153                                         ==> hl (truncate_simplex j ul) = dist (omega_list_n V ul j, HD ul)`,
9154    REPEAT STRIP_TAC THEN
9155      ABBREV_TAC `vl:(real^3)list = truncate_simplex j ul` THEN
9156      SUBGOAL_THEN `barV V j vl` ASSUME_TAC THENL
9157      [
9158        EXPAND_TAC "vl" THEN MATCH_MP_TAC TRUNCATE_SIMPLEX_BARV THEN
9159          EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[];
9160        ALL_TAC
9161      ] THEN
9162      MP_TAC (SPECL [`V:real^3->bool`; `j:num`; `vl:(real^3)list`] HL_EQ_DIST0) THEN
9163      ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
9164      AP_TERM_TAC THEN
9165      REWRITE_TAC[PAIR_EQ] THEN
9166      CONJ_TAC THENL
9167      [
9168        MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `j:num`] OMEGA_LIST_LEMMA) THEN
9169          ANTS_TAC THENL
9170          [
9171            UNDISCH_TAC `barV V k ul` THEN UNDISCH_TAC `j <= k:num` THEN
9172              SIMP_TAC[BARV] THEN ARITH_TAC;
9173            ALL_TAC
9174          ] THEN
9175          DISCH_THEN (fun th -> ASM_REWRITE_TAC[SYM th]) THEN
9176          MATCH_MP_TAC (GSYM XNHPWAB1) THEN
9177          EXISTS_TAC `j:num` THEN
9178          ASM_REWRITE_TAC[IN] THEN
9179          MATCH_MP_TAC REAL_LET_TRANS THEN
9180          EXISTS_TAC `hl (ul:(real^3)list)` THEN
9181          ASM_REWRITE_TAC[] THEN
9182          EXPAND_TAC "vl" THEN
9183          MATCH_MP_TAC HL_DECREASE THEN
9184          MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `k:num`] THEN
9185          ASM_REWRITE_TAC[IN];
9186        ALL_TAC
9187      ] THEN
9188
9189      EXPAND_TAC "vl" THEN
9190      MATCH_MP_TAC HD_TRUNCATE_SIMPLEX THEN
9191      UNDISCH_TAC `barV V k ul` THEN UNDISCH_TAC `j <= k:num` THEN
9192      SIMP_TAC[BARV] THEN ARITH_TAC);;
9193
9194
9195
9196
9197 let KSOQKWL_lemma0 = prove(`!V ul vl k. packing V /\ barV V k ul /\ barV V k vl /\
9198                              ~(HD ul = HD vl)
9199                              ==> ~({omega_list_n V ul i | i <= k} = {omega_list_n V vl i | i <= k})`,
9200    REPEAT GEN_TAC THEN STRIP_TAC THEN
9201      REWRITE_TAC[EXTENSION; NOT_FORALL_THM; IN_ELIM_THM] THEN
9202      EXISTS_TAC `HD ul:real^3` THEN
9203      MATCH_MP_TAC (TAUT `~(A ==> B) ==> ~(A <=> B)`) THEN
9204      REWRITE_TAC[NOT_IMP] THEN
9205      CONJ_TAC THENL [ EXISTS_TAC `0` THEN REWRITE_TAC[OMEGA_LIST_N; LE_0]; ALL_TAC ] THEN
9206      REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(A /\ B) <=> A ==> ~B`] THEN
9207      REPEAT STRIP_TAC THEN
9208      POP_ASSUM (ASSUME_TAC o SYM) THEN
9209
9210      SUBGOAL_THEN `LENGTH (vl:(real^3)list) = k + 1 /\ LENGTH (ul:(real^3)list) = k + 1` ASSUME_TAC THENL
9211      [
9212        UNDISCH_TAC `barV V k vl` THEN UNDISCH_TAC `barV V k ul` THEN SIMP_TAC[BARV];
9213        ALL_TAC
9214      ] THEN
9215
9216      SUBGOAL_THEN `i + 1 <= k + 1` ASSUME_TAC THENL [ UNDISCH_TAC `i <= k:num` THEN ARITH_TAC; ALL_TAC ] THEN
9217
9218      SUBGOAL_THEN `omega_list_n V vl i IN voronoi_closed V (HD vl)` MP_TAC THENL
9219      [
9220        MATCH_MP_TAC IN_TRANS THEN
9221          EXISTS_TAC `voronoi_list V (truncate_simplex i vl)` THEN
9222          CONJ_TAC THENL
9223          [
9224            MATCH_MP_TAC OMEGA_LIST_N_IN_VORONOI_LIST THEN
9225              EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[];
9226            ALL_TAC
9227          ] THEN
9228          SUBGOAL_THEN `HD vl = HD (truncate_simplex i vl):real^3` (fun th -> REWRITE_TAC[th]) THENL
9229          [
9230            MATCH_MP_TAC (GSYM HD_TRUNCATE_SIMPLEX) THEN
9231              ASM_REWRITE_TAC[];
9232            ALL_TAC
9233          ] THEN
9234          MATCH_MP_TAC VORONOI_LIST_SUBSET_VORONOI_CLOSED THEN
9235          MP_TAC (ISPECL [`i:num`; `vl:(real^3)list`] LENGTH_TRUNCATE_SIMPLEX) THEN
9236          ASM_REWRITE_TAC[] THEN ARITH_TAC;
9237        ALL_TAC
9238      ] THEN
9239
9240      ASM_REWRITE_TAC[voronoi_closed; IN_ELIM_THM; NOT_FORALL_THM] THEN
9241      EXISTS_TAC `HD ul:real^3` THEN
9242      REWRITE_TAC[NOT_IMP] THEN
9243      CONJ_TAC THENL
9244      [
9245        ONCE_REWRITE_TAC[GSYM IN] THEN
9246          MATCH_MP_TAC IN_TRANS THEN
9247          EXISTS_TAC `set_of_list ul:real^3->bool` THEN
9248          CONJ_TAC THENL
9249          [
9250            MATCH_MP_TAC HD_IN_SET_OF_LIST THEN
9251              ASM_REWRITE_TAC[] THEN ARITH_TAC;
9252            ALL_TAC
9253          ] THEN
9254          MATCH_MP_TAC BARV_SUBSET THEN
9255          EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[];
9256        ALL_TAC
9257      ] THEN
9258
9259      ASM_REWRITE_TAC[DIST_REFL; DIST_LE_0]);;
9260
9261
9262
9263
9264 let KSOQKWL_lemma1 = prove(`!V ul vl k j. packing V /\ barV V k ul /\ barV V k vl /\
9265                              hl ul < sqrt (&2) /\ hl vl < sqrt (&2) /\
9266                              0 < j /\ j <= k /\
9267                              truncate_simplex (j - 1) ul = truncate_simplex (j - 1) vl /\
9268                              hl (truncate_simplex j ul) <= hl (truncate_simplex j vl) /\
9269                              ~(omega_list_n V ul j = omega_list_n V vl j)
9270                              ==> ~({omega_list_n V ul i | i <= k} = {omega_list_n V vl i | i <= k})`,
9271    REPEAT GEN_TAC THEN STRIP_TAC THEN
9272      REWRITE_TAC[EXTENSION; NOT_FORALL_THM; IN_ELIM_THM] THEN
9273      EXISTS_TAC `omega_list_n V ul j` THEN
9274      MATCH_MP_TAC (TAUT `~(A ==> B) ==> ~(A <=> B)`) THEN
9275      REWRITE_TAC[NOT_IMP; NOT_EXISTS_THM] THEN
9276      CONJ_TAC THENL
9277      [
9278        EXISTS_TAC `j:num` THEN ASM_REWRITE_TAC[];
9279        ALL_TAC
9280      ] THEN
9281
9282      SUBGOAL_THEN `LENGTH (ul:(real^3)list) = k + 1 /\ LENGTH (vl:(real^3)list) = k + 1` ASSUME_TAC THENL
9283      [
9284        UNDISCH_TAC `barV V k ul` THEN UNDISCH_TAC `barV V k vl` THEN SIMP_TAC[BARV];
9285        ALL_TAC
9286      ] THEN
9287      SUBGOAL_THEN `j + 1 <= k + 1` ASSUME_TAC THENL [ ASM_REWRITE_TAC[ARITH_RULE `j + 1 <= k + 1 <=> j <= k`]; ALL_TAC ] THEN
9288      MP_TAC (ARITH_RULE `0 < j /\ j <= k ==> j - 1 + 1 = j /\ j <= k + 1`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
9289
9290      REWRITE_TAC[TAUT `~(A /\ B) <=> (A ==> ~B)`] THEN
9291      REPEAT STRIP_TAC THEN
9292      MP_TAC (SPECL [`V:real^3->bool`; `k:num`; `ul:(real^3)list`; `j:num`] HL_TRUNCATE_SIMPLEX_OMEGA_N) THEN
9293      MP_TAC (SPECL [`V:real^3->bool`; `k:num`; `vl:(real^3)list`; `i:num`] HL_TRUNCATE_SIMPLEX_OMEGA_N) THEN
9294      ASM_REWRITE_TAC[] THEN
9295      SUBGOAL_THEN `HD vl = HD ul:real^3` ASSUME_TAC THENL
9296      [
9297        SUBGOAL_THEN `HD vl = HD (truncate_simplex (j - 1) ul):real^3` (fun th -> REWRITE_TAC[th]) THENL
9298          [
9299            ASM_REWRITE_TAC[] THEN
9300              MATCH_MP_TAC (GSYM HD_TRUNCATE_SIMPLEX) THEN
9301              ASM_REWRITE_TAC[];
9302            ALL_TAC
9303          ] THEN
9304
9305          MATCH_MP_TAC HD_TRUNCATE_SIMPLEX THEN
9306          ASM_REWRITE_TAC[];
9307        ALL_TAC
9308      ] THEN
9309
9310      ASM_REWRITE_TAC[] THEN
9311      DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
9312
9313      ASM_CASES_TAC `i < j:num` THENL
9314      [
9315        SUBGOAL_THEN `truncate_simplex i vl:(real^3)list = truncate_simplex i ul` (fun th -> REWRITE_TAC[th]) THENL
9316          [
9317            MP_TAC (ISPECL [`ul:(real^3)list`; `i:num`; `j - 1`] TRUNCATE_TRUNCATE_SIMPLEX) THEN
9318              ANTS_TAC THENL [ ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC ] THEN
9319              DISCH_THEN (fun th -> ASM_REWRITE_TAC[SYM th]) THEN
9320              MATCH_MP_TAC (GSYM TRUNCATE_TRUNCATE_SIMPLEX) THEN
9321              ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN ARITH_TAC;
9322            ALL_TAC
9323          ] THEN
9324
9325          MATCH_MP_TAC (REAL_ARITH `a < b ==> ~(b = a:real)`) THEN
9326          MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `k:num`] XNHPWAB4) THEN
9327          ASM_REWRITE_TAC[IN] THEN
9328          DISCH_THEN MATCH_MP_TAC THEN
9329          ASM_REWRITE_TAC[];
9330        ALL_TAC
9331      ] THEN
9332
9333      POP_ASSUM MP_TAC THEN REWRITE_TAC[NOT_LT; LE_LT] THEN
9334      DISCH_THEN DISJ_CASES_TAC THENL
9335      [
9336        MATCH_MP_TAC (REAL_ARITH `a < b ==> ~(a = b:real)`) THEN
9337          MATCH_MP_TAC REAL_LET_TRANS THEN
9338          EXISTS_TAC `hl (truncate_simplex j vl:(real^3)list)` THEN
9339          ASM_REWRITE_TAC[] THEN
9340          MP_TAC (SPECL [`V:real^3->bool`; `vl:(real^3)list`; `k:num`] XNHPWAB4) THEN
9341          ASM_REWRITE_TAC[IN] THEN
9342          DISCH_THEN MATCH_MP_TAC THEN
9343          ASM_REWRITE_TAC[];
9344        ALL_TAC
9345      ] THEN
9346
9347      UNDISCH_TAC `omega_list_n V ul j = omega_list_n V vl i` THEN
9348      POP_ASSUM (fun th -> ASM_REWRITE_TAC[SYM th]));;
9349
9350
9351
9352
9353
9354 let AFFINE_INDEPENDENT_OMEGA_LIST_N = prove(`!V ul k. packing V /\ barV V k ul /\ hl ul < sqrt (&2)
9355                                               ==> ~affine_dependent {omega_list_n V ul i | i <= k}`,
9356    REPEAT GEN_TAC THEN STRIP_TAC THEN
9357      REWRITE_TAC[AFFINE_INDEPENDENT_IFF_CARD] THEN
9358      ABBREV_TAC `A = {omega_list_n V ul i | i <= k}` THEN
9359      SUBGOAL_THEN `FINITE (A:real^3->bool) /\ CARD A <= k + 1` ASSUME_TAC THENL
9360      [
9361        EXPAND_TAC "A" THEN
9362          SUBGOAL_THEN `!i. i <= k <=> i IN 0..k` (fun th -> REWRITE_TAC[th]) THENL
9363          [
9364            REWRITE_TAC[IN_NUMSEG; LE_0];
9365            ALL_TAC
9366          ] THEN
9367          ONCE_REWRITE_TAC[GSYM IMAGE_LEMMA] THEN
9368          CONJ_TAC THENL
9369          [
9370            MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[FINITE_NUMSEG];
9371            ALL_TAC
9372          ] THEN
9373          MP_TAC (ISPECL [`\i. omega_list_n V ul i`; `0..k`] CARD_IMAGE_LE) THEN
9374          REWRITE_TAC[FINITE_NUMSEG; CARD_NUMSEG; ARITH_RULE `(k + 1) - 0 = k + 1`];
9375        ALL_TAC
9376      ] THEN
9377      ASM_REWRITE_TAC[] THEN
9378
9379      MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `k:num`] XNHPWAB3) THEN
9380      ASM_REWRITE_TAC[IN_NUMSEG; IN; LE_0] THEN
9381      DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
9382      MP_TAC (ISPEC `A:real^3->bool` AFF_DIM_LE_CARD) THEN
9383      ASM_REWRITE_TAC[] THEN
9384      REMOVE_ASSUM THEN POP_ASSUM MP_TAC THEN
9385      REWRITE_TAC[GSYM INT_OF_NUM_LE; GSYM INT_OF_NUM_ADD] THEN
9386      INT_ARITH_TAC);;
9387
9388
9389
9390
9391 let ROGERS_EQ = prove(`!V ul vl k. packing V /\ barV V k ul /\ barV V k vl /\
9392                         hl ul < sqrt (&2) /\ hl vl < sqrt (&2)
9393                         ==> (rogers V ul = rogers V vl <=>
9394                             {omega_list_n V ul i | i <= k} = {omega_list_n V vl i | i <= k})`,
9395    REPEAT STRIP_TAC THEN
9396      REWRITE_TAC[ROGERS; IMAGE_LEMMA; IN_ELIM_THM] THEN
9397      SUBGOAL_THEN `LENGTH (ul:(real^3)list) = k + 1 /\ LENGTH (vl:(real^3)list) = k + 1` ASSUME_TAC THENL
9398      [
9399        UNDISCH_TAC `barV V k ul` THEN UNDISCH_TAC `barV V k vl` THEN SIMP_TAC[BARV];
9400        ALL_TAC
9401      ] THEN
9402
9403      ASM_REWRITE_TAC[ARITH_RULE `x < k + 1 <=> x <= k`] THEN
9404      MATCH_MP_TAC CONVEX_HULL_EQ_EQ_SET_EQ THEN
9405      ASM_SIMP_TAC[AFFINE_INDEPENDENT_OMEGA_LIST_N]);;
9406
9407
9408
9409 let NUM_FINITE_IMP_MAX_EXISTS = prove(`!K:num->bool. FINITE K /\ ~(K = {}) ==> ?m. m IN K /\ (!j. j IN K ==> j <= m)`,
9410    REWRITE_TAC[GSYM IMP_IMP] THEN
9411      MATCH_MP_TAC FINITE_INDUCT THEN REWRITE_TAC[NOT_INSERT_EMPTY] THEN
9412      REPEAT STRIP_TAC THEN POP_ASSUM MP_TAC THEN
9413      ASM_CASES_TAC `s:num->bool = {}` THEN ASM_REWRITE_TAC[] THENL
9414      [
9415        ASM_REWRITE_TAC[IN_SING] THEN
9416          EXISTS_TAC `x:num` THEN
9417          SIMP_TAC[LE_REFL];
9418        ALL_TAC
9419      ] THEN
9420
9421      STRIP_TAC THEN
9422      ASM_CASES_TAC `m <= x:num` THENL
9423      [
9424        EXISTS_TAC `x:num` THEN
9425          REWRITE_TAC[IN_INSERT] THEN
9426          GEN_TAC THEN
9427          ASM_CASES_TAC `j = x:num` THEN ASM_REWRITE_TAC[LE_REFL] THEN
9428          DISCH_TAC THEN
9429          FIRST_X_ASSUM (MP_TAC o SPEC `j:num`) THEN
9430          ASM_REWRITE_TAC[] THEN UNDISCH_TAC `m <= x:num` THEN
9431          ARITH_TAC;
9432        ALL_TAC
9433      ] THEN
9434
9435      EXISTS_TAC `m:num` THEN
9436      ASM_REWRITE_TAC[IN_INSERT] THEN
9437      GEN_TAC THEN
9438      ASM_CASES_TAC `j = x:num` THENL
9439      [
9440        ASM_REWRITE_TAC[] THEN
9441          UNDISCH_TAC `~(m <= x:num)` THEN ARITH_TAC;
9442        ALL_TAC
9443      ] THEN
9444      ASM_SIMP_TAC[]);;
9445
9446
9447
9448
9449
9450 let NOT_ID_IMP_LISTS_NOT_EQ = prove(`!ul:(A)list p k. LENGTH ul = k + 1 /\ CARD (set_of_list ul) = k + 1 /\
9451                                       p permutes (0..k) /\ ~(p = I)
9452                                         ==> ~(ul = left_action_list p ul)`,
9453    REPEAT STRIP_TAC THEN
9454      SUBGOAL_THEN `?j:num. j < k + 1 /\ ~(p j = j)` CHOOSE_TAC THENL
9455      [
9456        UNDISCH_TAC `~(p = I:num->num)` THEN
9457          REWRITE_TAC[FUN_EQ_THM; I_THM; NOT_FORALL_THM] THEN
9458          STRIP_TAC THEN
9459          EXISTS_TAC `x:num` THEN
9460          ASM_REWRITE_TAC[] THEN
9461          DISJ_CASES_TAC (ARITH_RULE `x < k + 1 \/ k < x:num`) THEN ASM_REWRITE_TAC[] THEN
9462          UNDISCH_TAC `p permutes 0..k` THEN
9463          REWRITE_TAC[permutes] THEN
9464          DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC o SPEC `x:num`) (fun th -> ALL_TAC)) THEN
9465          ASM_REWRITE_TAC[IN_NUMSEG; LE_0] THEN ARITH_TAC;
9466        ALL_TAC
9467      ] THEN
9468
9469      UNDISCH_TAC `ul:(A)list = left_action_list p ul` THEN
9470      DISCH_THEN (MP_TAC o AP_TERM `\l:(A)list. EL ((p:num->num) j) l`) THEN
9471
9472      MP_TAC (SPECL [`ul:(A)list`; `p:num->num`; `j:num`] EL_LEFT_ACTION_LIST) THEN
9473      ASM_REWRITE_TAC[ARITH_RULE `(k + 1) - 1 = k`] THEN
9474      DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
9475
9476      MP_TAC (SPEC `ul:(A)list` CARD_SET_OF_LIST_EQ_LENGTH_IMP_ALL_DISTINCT) THEN
9477      ASM_REWRITE_TAC[] THEN
9478      DISCH_THEN MATCH_MP_TAC THEN
9479      ASM_REWRITE_TAC[] THEN
9480      MP_TAC (ISPECL [`p:num->num`; `0..k`] Hypermap_and_fan.PERMUTES_IMP_INSIDE) THEN
9481      ASM_REWRITE_TAC[IN_NUMSEG] THEN
9482      DISCH_THEN (MP_TAC o SPEC `j:num`) THEN
9483      ASM_REWRITE_TAC[LE_0; ARITH_RULE `a <= b <=> a < b + 1`]);;
9484
9485
9486
9487
9488
9489
9490 let NOT_ID_IMP_EXISTS_MAX_EQ_TRUNCATE_SIMPLEX = prove(`!ul:(A)list p k. LENGTH ul = k + 1 /\ CARD (set_of_list ul) = k + 1
9491                                                           /\ p permutes (0..k) /\ ~(p = I)
9492                                                         ==> ~(HD ul = HD (left_action_list p ul)) \/
9493                                                         ?j. j < k /\ truncate_simplex j ul = truncate_simplex j (left_action_list p ul)
9494                                                             /\ ~(EL (j + 1) ul = EL (j + 1) (left_action_list p ul))`,
9495    REPEAT STRIP_TAC THEN
9496      ABBREV_TAC `vl:(A)list = left_action_list p ul` THEN
9497      SUBGOAL_THEN `LENGTH (vl:(A)list) = k + 1` ASSUME_TAC THENL
9498      [
9499        EXPAND_TAC "vl" THEN
9500          ASM_REWRITE_TAC[LENGTH_LEFT_ACTION_LIST];
9501        ALL_TAC
9502      ] THEN
9503
9504      ASM_CASES_TAC `HD ul = HD vl:A` THEN ASM_REWRITE_TAC[] THEN
9505      ABBREV_TAC `K = {j | j <= k /\ truncate_simplex j (ul:(A)list) = truncate_simplex j vl}` THEN
9506      SUBGOAL_THEN `?i:num. i IN K /\ (!j. j IN K ==> j <= i)` STRIP_ASSUME_TAC THENL
9507      [
9508        MATCH_MP_TAC NUM_FINITE_IMP_MAX_EXISTS THEN
9509          EXPAND_TAC "K" THEN CONJ_TAC THENL
9510          [
9511            MATCH_MP_TAC FINITE_SUBSET THEN
9512              EXISTS_TAC `{j | j <= k:num}` THEN
9513              CONJ_TAC THENL
9514              [
9515                SUBGOAL_THEN `!j. j <= k <=> j IN 0..k` (fun th -> REWRITE_TAC[th]) THENL [ REWRITE_TAC[IN_NUMSEG; LE_0]; ALL_TAC ] THEN
9516                  REWRITE_TAC[GSYM IMAGE_LEMMA] THEN
9517                  MATCH_MP_TAC FINITE_IMAGE THEN
9518                  REWRITE_TAC[FINITE_NUMSEG];
9519                ALL_TAC
9520              ] THEN
9521              SIMP_TAC[SUBSET; IN_ELIM_THM];
9522            ALL_TAC
9523          ] THEN
9524
9525          REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
9526          EXISTS_TAC `0` THEN
9527          REWRITE_TAC[IN_ELIM_THM; LE_0] THEN
9528          MP_TAC (SPEC `ul:(A)list` TRUNCATE_0_EQ_HEAD) THEN
9529          MP_TAC (SPEC `vl:(A)list` TRUNCATE_0_EQ_HEAD) THEN
9530          ASM_SIMP_TAC[ARITH_RULE `1 <= k + 1`];
9531        ALL_TAC
9532      ] THEN
9533
9534      EXISTS_TAC `i:num` THEN
9535      SUBGOAL_THEN `i < k:num` ASSUME_TAC THENL
9536      [
9537        REWRITE_TAC[LT_LE] THEN
9538          CONJ_TAC THENL
9539          [
9540            UNDISCH_TAC `i:num IN K` THEN EXPAND_TAC "K" THEN
9541              SIMP_TAC[IN_ELIM_THM];
9542            ALL_TAC
9543          ] THEN
9544
9545          DISCH_TAC THEN
9546          UNDISCH_TAC `i:num IN K` THEN
9547          EXPAND_TAC "K" THEN
9548          ASM_REWRITE_TAC[IN_ELIM_THM; LE_REFL] THEN
9549          MP_TAC (SPECL [`k:num`; `ul:(A)list`; `ul:(A)list`] TRUNCATE_SIMPLEX_INITIAL_SUBLIST) THEN
9550          MP_TAC (SPECL [`k:num`; `vl:(A)list`; `vl:(A)list`] TRUNCATE_SIMPLEX_INITIAL_SUBLIST) THEN
9551          ASM_REWRITE_TAC[LE_REFL; INITIAL_SUBLIST_REFL] THEN
9552          REPLICATE_TAC 2 (DISCH_THEN (fun th -> ONCE_REWRITE_TAC[th])) THEN
9553
9554          EXPAND_TAC "vl" THEN
9555          MATCH_MP_TAC NOT_ID_IMP_LISTS_NOT_EQ THEN
9556          EXISTS_TAC `k:num` THEN
9557          ASM_REWRITE_TAC[];
9558        ALL_TAC
9559      ] THEN
9560
9561      SUBGOAL_THEN `truncate_simplex i ul = truncate_simplex i vl:(A)list` ASSUME_TAC THENL
9562      [
9563        UNDISCH_TAC `i:num IN K` THEN EXPAND_TAC "K" THEN
9564          SIMP_TAC[IN_ELIM_THM];
9565        ALL_TAC
9566      ] THEN
9567
9568      ASM_REWRITE_TAC[] THEN
9569      DISCH_TAC THEN
9570
9571      SUBGOAL_THEN `i + 1 IN K` ASSUME_TAC THENL
9572      [
9573        EXPAND_TAC "K" THEN REWRITE_TAC[IN_ELIM_THM] THEN
9574          ASM_SIMP_TAC[ARITH_RULE `i < k ==> i + 1 <= k`] THEN
9575          MP_TAC (ARITH_RULE `i < k ==> i + 2 <= k + 1`) THEN
9576          ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
9577          ASM_SIMP_TAC[TRUNCATE_SIMPLEX_ADD1_ALT];
9578        ALL_TAC
9579      ] THEN
9580
9581      FIRST_X_ASSUM (MP_TAC o SPEC `i + 1`) THEN
9582      ASM_REWRITE_TAC[ARITH_RULE `~(i + 1 <= i)`]);;
9583
9584
9585
9586 (* KSOQKWL *)
9587
9588 let KSOQKWL = prove(`!V ul p k. packing V /\ ul IN barV V k /\ hl ul < sqrt(&2) /\
9589                       p permutes (0..k) /\ (rogers V ul = rogers V (left_action_list p ul)) ==> (p = I)`,
9590    REWRITE_TAC[IN] THEN REPEAT STRIP_TAC THEN
9591      POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
9592      ABBREV_TAC `vl:(real^3)list = left_action_list p ul` THEN
9593      SUBGOAL_THEN `barV V k vl` ASSUME_TAC THENL
9594      [
9595        EXPAND_TAC "vl" THEN
9596          MP_TAC (SPEC_ALL YIFVQDV) THEN
9597          ASM_SIMP_TAC[IN];
9598        ALL_TAC
9599      ] THEN
9600
9601      MP_TAC (SPEC_ALL BARV_IMP_LENGTH_EQ_CARD) THEN
9602      ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
9603
9604      SUBGOAL_THEN `hl (vl:(real^3)list) < sqrt (&2)` ASSUME_TAC THENL
9605      [
9606        SUBGOAL_THEN `hl (vl:(real^3)list) = hl (ul:(real^3)list)` (fun th -> ASM_REWRITE_TAC[th]) THEN
9607          REWRITE_TAC[HL] THEN
9608          AP_TERM_TAC THEN
9609          EXPAND_TAC "vl" THEN
9610          MATCH_MP_TAC SET_OF_LIST_LEFT_ACTION_LIST THEN
9611          UNDISCH_TAC `barV V k ul` THEN SIMP_TAC[BARV] THEN
9612          ASM_REWRITE_TAC[ARITH_RULE `(k + 1) - 1 = k`];
9613        ALL_TAC
9614      ] THEN
9615
9616      SUBGOAL_THEN `LENGTH (vl:(real^3)list) = k + 1` ASSUME_TAC THENL
9617      [
9618        UNDISCH_TAC `barV V k vl` THEN SIMP_TAC[BARV];
9619        ALL_TAC
9620      ] THEN
9621
9622      ASM_SIMP_TAC[ROGERS_EQ] THEN
9623
9624      MP_TAC (ISPECL [`ul:(real^3)list`; `p:num->num`; `k:num`] NOT_ID_IMP_EXISTS_MAX_EQ_TRUNCATE_SIMPLEX) THEN
9625      ASM_REWRITE_TAC[] THEN
9626
9627      ASM_CASES_TAC `~(HD ul = HD vl:real^3)` THENL
9628      [
9629        ASM_REWRITE_TAC[] THEN
9630          MATCH_MP_TAC KSOQKWL_lemma0 THEN
9631          ASM_REWRITE_TAC[];
9632        ALL_TAC
9633      ] THEN
9634
9635      POP_ASSUM MP_TAC THEN REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
9636      STRIP_TAC THEN
9637
9638      SUBGOAL_THEN `~(omega_list_n V ul (j + 1) = omega_list_n V vl (j + 1))` ASSUME_TAC THENL
9639      [
9640        DISCH_TAC THEN
9641          MP_TAC (SPECL [`V:real^3->bool`; `k:num`; `ul:(real^3)list`; `j + 1`] HL_TRUNCATE_SIMPLEX_OMEGA_N) THEN
9642          MP_TAC (SPECL [`V:real^3->bool`; `k:num`; `vl:(real^3)list`; `j + 1`] HL_TRUNCATE_SIMPLEX_OMEGA_N) THEN
9643          MP_TAC (ARITH_RULE `j < k ==> j + 1 <= k`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
9644          ASM_REWRITE_TAC[] THEN
9645          DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
9646
9647          ABBREV_TAC `S = set_of_list (truncate_simplex (j + 1) ul:(real^3)list)` THEN
9648          ABBREV_TAC `c:real^3 = circumcenter S` THEN
9649
9650          MP_TAC (SPECL [`V:real^3->bool`; `S:real^3->bool`; `c:real^3`] XYOFCGX) THEN
9651          SUBGOAL_THEN `barV V (j + 1) (truncate_simplex (j + 1) ul)` ASSUME_TAC THENL
9652          [
9653            MATCH_MP_TAC TRUNCATE_SIMPLEX_BARV THEN
9654              EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[];
9655            ALL_TAC
9656          ] THEN
9657
9658          SUBGOAL_THEN `~affine_dependent (S:real^3->bool)` ASSUME_TAC THENL
9659          [
9660            EXPAND_TAC "S" THEN
9661              MATCH_MP_TAC BARV_AFFINE_INDEPENDENT THEN
9662              MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `j + 1`] THEN
9663              ASM_REWRITE_TAC[];
9664            ALL_TAC
9665          ] THEN
9666
9667          SUBGOAL_THEN `S SUBSET V:real^3->bool` ASSUME_TAC THENL
9668          [
9669            EXPAND_TAC "S" THEN
9670              MATCH_MP_TAC BARV_SUBSET THEN
9671              EXISTS_TAC `j + 1` THEN ASM_REWRITE_TAC[];
9672            ALL_TAC
9673          ] THEN
9674
9675          ANTS_TAC THENL
9676          [
9677            ASM_REWRITE_TAC[] THEN
9678              EXPAND_TAC "S" THEN
9679              REWRITE_TAC[GSYM HL] THEN
9680              MATCH_MP_TAC REAL_LET_TRANS THEN
9681              EXISTS_TAC `hl (ul:(real^3)list)` THEN
9682              ASM_REWRITE_TAC[] THEN
9683              MATCH_MP_TAC HL_DECREASE THEN
9684              MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `k:num`] THEN
9685              ASM_REWRITE_TAC[IN];
9686            ALL_TAC
9687          ] THEN
9688
9689          ABBREV_TAC `x = EL (j + 1) ul:real^3` THEN
9690          ABBREV_TAC `y = EL (j + 1) vl:real^3` THEN
9691
9692          DISCH_THEN (MP_TAC o SPECL [`x:real^3`; `y:real^3`]) THEN
9693          ABBREV_TAC `xl:(real^3)list = truncate_simplex (j + 1) ul` THEN
9694          ABBREV_TAC `yl:(real^3)list = truncate_simplex (j + 1) vl` THEN
9695
9696          SUBGOAL_THEN `barV V (j + 1) yl` ASSUME_TAC THENL
9697          [
9698            EXPAND_TAC "yl" THEN
9699              MATCH_MP_TAC TRUNCATE_SIMPLEX_BARV THEN
9700              EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[];
9701            ALL_TAC
9702          ] THEN
9703
9704          MP_TAC (SPECL [`V:real^3->bool`; `xl:(real^3)list`; `j + 1`] BARV_IMP_LENGTH_EQ_CARD) THEN
9705          MP_TAC (SPECL [`V:real^3->bool`; `yl:(real^3)list`; `j + 1`] BARV_IMP_LENGTH_EQ_CARD) THEN
9706          ASM_REWRITE_TAC[] THEN DISCH_TAC THEN DISCH_TAC THEN
9707
9708          MP_TAC (ARITH_RULE `j + 1 <= k ==> (j + 1) + 1 <= k + 1`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
9709
9710          SUBGOAL_THEN `!n. n < (j + 1) + 1 ==> (EL n xl):real^3 = if (n = j + 1) then x else EL n (truncate_simplex j vl)` ASSUME_TAC THENL
9711          [
9712            REPEAT STRIP_TAC THEN
9713              MP_TAC (ISPECL [`ul:(real^3)list`; `j + 1`] EL_TRUNCATE_SIMPLEX) THEN
9714              MP_TAC (ISPECL [`ul:(real^3)list`; `j:num`] EL_TRUNCATE_SIMPLEX) THEN
9715              ASM_REWRITE_TAC[] THEN
9716              COND_CASES_TAC THENL
9717              [
9718                DISCH_TAC THEN
9719                  DISCH_THEN (MP_TAC o SPEC `j + 1`) THEN
9720                  ASM_REWRITE_TAC[LE_REFL];
9721                ALL_TAC
9722              ] THEN
9723
9724              DISCH_TAC THEN DISCH_TAC THEN
9725              POP_ASSUM (MP_TAC o SPEC `n:num`) THEN
9726              POP_ASSUM (MP_TAC o SPEC `n:num`) THEN
9727              ASM_SIMP_TAC[ARITH_RULE `j + 1 <= k ==> j + 1 <= k + 1`; ARITH_RULE `n < (j + 1) + 1 /\ ~(n = j + 1) ==> n <= j /\ n <= j + 1`];
9728            ALL_TAC
9729          ] THEN
9730
9731          SUBGOAL_THEN `!n. n < (j + 1) + 1 ==> (EL n yl):real^3 = if (n = j + 1) then y else EL n (truncate_simplex j vl)` ASSUME_TAC THENL
9732          [
9733            REPEAT STRIP_TAC THEN
9734              MP_TAC (ISPECL [`vl:(real^3)list`; `j + 1`] EL_TRUNCATE_SIMPLEX) THEN
9735              MP_TAC (ISPECL [`vl:(real^3)list`; `j:num`] EL_TRUNCATE_SIMPLEX) THEN
9736              ASM_REWRITE_TAC[] THEN
9737              COND_CASES_TAC THENL
9738              [
9739                DISCH_TAC THEN
9740                  DISCH_THEN (MP_TAC o SPEC `j + 1`) THEN
9741                  ASM_REWRITE_TAC[LE_REFL];
9742                ALL_TAC
9743              ] THEN
9744
9745              DISCH_TAC THEN DISCH_TAC THEN
9746              POP_ASSUM (MP_TAC o SPEC `n:num`) THEN
9747              POP_ASSUM (MP_TAC o SPEC `n:num`) THEN
9748              ASM_SIMP_TAC[ARITH_RULE `j + 1 <= k ==> j + 1 <= k + 1`; ARITH_RULE `n < (j + 1) + 1 /\ ~(n = j + 1) ==> n <= j /\ n <= j + 1`];
9749            ALL_TAC
9750          ] THEN
9751
9752
9753          SUBGOAL_THEN `x:real^3 IN S` ASSUME_TAC THENL
9754          [
9755            EXPAND_TAC "S" THEN
9756              REWRITE_TAC[IN_SET_OF_LIST] THEN
9757              REMOVE_ASSUM THEN POP_ASSUM (MP_TAC o SPEC `j + 1`) THEN
9758              REWRITE_TAC[ARITH_RULE `j + 1 < (j + 1) + 1`] THEN
9759              DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
9760              MATCH_MP_TAC MEM_EL THEN
9761              ASM_REWRITE_TAC[ARITH_RULE `j + 1 < (j + 1) + 1`];
9762            ALL_TAC
9763          ] THEN
9764
9765          SUBGOAL_THEN `y:real^3 IN (set_of_list yl) DIFF S` ASSUME_TAC THENL
9766          [
9767            EXPAND_TAC "S" THEN
9768              REWRITE_TAC[IN_DIFF; IN_SET_OF_LIST; MEM_EXISTS_EL] THEN
9769              CONJ_TAC THENL
9770              [
9771                EXISTS_TAC `j + 1` THEN
9772                  ASM_SIMP_TAC[ARITH_RULE `j + 1 < (j + 1) + 1`];
9773                ALL_TAC
9774              ] THEN
9775
9776              REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(A /\ B) <=> (A ==> ~B)`] THEN GEN_TAC THEN
9777              ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
9778              FIRST_ASSUM (MP_TAC o SPEC `j + 1:num`) THEN
9779              FIRST_X_ASSUM (MP_TAC o SPEC `i:num`) THEN
9780              FIRST_X_ASSUM (MP_TAC o SPEC `i:num`) THEN
9781              ASM_REWRITE_TAC[] THEN
9782
9783              COND_CASES_TAC THENL
9784              [
9785                ASM_SIMP_TAC[];
9786                ALL_TAC
9787              ] THEN
9788
9789              REWRITE_TAC[ARITH_RULE `j + 1 < (j + 1) + 1`] THEN
9790              DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
9791              DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
9792              DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
9793
9794              MP_TAC (ISPECL [`yl:(real^3)list`] CARD_SET_OF_LIST_EQ_LENGTH_IMP_ALL_DISTINCT) THEN
9795              ASM_REWRITE_TAC[] THEN
9796              DISCH_THEN MATCH_MP_TAC THEN
9797              POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC;
9798            ALL_TAC
9799          ] THEN
9800
9801          ANTS_TAC THENL
9802          [
9803            ASM_REWRITE_TAC[] THEN
9804              MATCH_MP_TAC IN_TRANS THEN
9805              EXISTS_TAC `(set_of_list yl:real^3->bool) DIFF S` THEN
9806              ASM_REWRITE_TAC[] THEN
9807              SUBGOAL_THEN `set_of_list yl:real^3->bool SUBSET V` MP_TAC THENL
9808              [
9809                MATCH_MP_TAC BARV_SUBSET THEN
9810                  EXISTS_TAC `j + 1` THEN ASM_REWRITE_TAC[];
9811                ALL_TAC
9812              ] THEN
9813              SIMP_TAC[SUBSET; IN_DIFF];
9814            ALL_TAC
9815          ] THEN
9816
9817          SUBGOAL_THEN `omega_list_n V ul (j + 1) = c:real^3` ASSUME_TAC THENL
9818          [
9819            MP_TAC (SPECL [`V:real^3->bool`; `xl:(real^3)list`; `j + 1`] XNHPWAB1) THEN
9820              ANTS_TAC THENL
9821              [
9822                ASM_REWRITE_TAC[IN] THEN
9823                  MATCH_MP_TAC REAL_LET_TRANS THEN
9824                  EXISTS_TAC `hl (ul:(real^3)list)` THEN
9825                  ASM_REWRITE_TAC[] THEN
9826                  EXPAND_TAC "xl" THEN
9827                  MATCH_MP_TAC HL_DECREASE THEN
9828                  MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `k:num`] THEN
9829                  ASM_REWRITE_TAC[IN];
9830                ALL_TAC
9831              ] THEN
9832
9833              EXPAND_TAC "c" THEN EXPAND_TAC "S" THEN
9834              DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
9835              EXPAND_TAC "xl" THEN
9836              MATCH_MP_TAC (GSYM OMEGA_LIST_LEMMA) THEN
9837              ASM_REWRITE_TAC[];
9838            ALL_TAC
9839          ] THEN
9840
9841          SUBGOAL_THEN `hl (xl:(real^3)list) = dist (x:real^3,c)` (fun th -> REWRITE_TAC[SYM th]) THENL
9842          [
9843            ASM_REWRITE_TAC[HL] THEN
9844              MP_TAC (ISPEC `S:real^3->bool` OAPVION2) THEN
9845              ASM_REWRITE_TAC[] THEN
9846              DISCH_THEN (MP_TAC o SPEC `x:real^3`) THEN
9847              ASM_REWRITE_TAC[DIST_SYM];
9848            ALL_TAC
9849          ] THEN
9850
9851          SUBGOAL_THEN `hl (yl:(real^3)list) = dist (y:real^3,c)` (fun th -> REWRITE_TAC[SYM th]) THENL
9852          [
9853            ASM_REWRITE_TAC[HL] THEN
9854            MP_TAC (SPECL [`V:real^3->bool`; `yl:(real^3)list`; `j + 1`] XNHPWAB1) THEN
9855              ANTS_TAC THENL
9856              [
9857                ASM_REWRITE_TAC[IN] THEN
9858                  MATCH_MP_TAC REAL_LET_TRANS THEN
9859                  EXISTS_TAC `hl (vl:(real^3)list)` THEN
9860                  ASM_REWRITE_TAC[] THEN
9861                  EXPAND_TAC "yl" THEN
9862                  MATCH_MP_TAC HL_DECREASE THEN
9863                  MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `k:num`] THEN
9864                  ASM_REWRITE_TAC[IN];
9865                ALL_TAC
9866              ] THEN
9867
9868              DISCH_THEN (ASSUME_TAC o SYM) THEN
9869              MP_TAC (ISPEC `set_of_list yl:real^3->bool` OAPVION2) THEN
9870              ANTS_TAC THENL
9871              [
9872                MATCH_MP_TAC BARV_AFFINE_INDEPENDENT THEN
9873                  MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `j + 1`] THEN
9874                  ASM_REWRITE_TAC[];
9875                ALL_TAC
9876              ] THEN
9877
9878              DISCH_THEN (MP_TAC o SPEC `y:real^3`) THEN
9879              ANTS_TAC THENL
9880              [
9881                UNDISCH_TAC `y:real^3 IN set_of_list yl DIFF S` THEN SIMP_TAC[IN_DIFF];
9882                ALL_TAC
9883              ] THEN
9884
9885              DISCH_THEN (fun th -> ASM_REWRITE_TAC[th]) THEN
9886              SUBGOAL_THEN `omega_list V yl = omega_list_n V ul (j + 1)` (fun th -> REWRITE_TAC[th]) THENL
9887              [
9888                ASM_REWRITE_TAC[] THEN
9889                  EXPAND_TAC "yl" THEN
9890                  MATCH_MP_TAC OMEGA_LIST_LEMMA THEN
9891                  ASM_REWRITE_TAC[];
9892                ALL_TAC
9893              ] THEN
9894
9895              REMOVE_ASSUM THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN
9896              REWRITE_TAC[DIST_SYM];
9897            ALL_TAC
9898          ] THEN
9899
9900          REAL_ARITH_TAC;
9901        ALL_TAC
9902      ] THEN
9903
9904
9905      ASM_CASES_TAC `hl (truncate_simplex (j + 1) ul:(real^3)list) <= hl (truncate_simplex (j + 1) vl:(real^3)list)` THENL
9906      [
9907        MATCH_MP_TAC KSOQKWL_lemma1 THEN
9908          EXISTS_TAC `j + 1` THEN
9909          ASM_REWRITE_TAC[ARITH_RULE `0 < j + 1`; ARITH_RULE `j + 1 <= k <=> j < k`; ARITH_RULE `(j + 1) - 1 = j`];
9910        ALL_TAC
9911      ] THEN
9912
9913      POP_ASSUM MP_TAC THEN REWRITE_TAC[REAL_NOT_LE; REAL_LT_LE] THEN DISCH_TAC THEN
9914      MATCH_MP_TAC (GSYM KSOQKWL_lemma1) THEN
9915      EXISTS_TAC `j + 1` THEN
9916      ASM_REWRITE_TAC[ARITH_RULE `0 < j + 1`; ARITH_RULE `j + 1 <= k <=> j < k`; ARITH_RULE `(j + 1) - 1 = j`]);;
9917
9918
9919
9920
9921
9922 (*****************************************************)
9923
9924 (***********)
9925 (* IVFICRK *)
9926 (***********)
9927
9928
9929 let IVFICRK = prove(`!k. ?g. (BIJ g { (i,sigma ) | i IN 0..(k+1) /\ sigma permutes (0..k) } { p | p permutes (0..(k+1)) })
9930                            /\ (!(ul:(A)list) i sigma j. (LENGTH ul = k+2) /\ j <= k /\ i IN 0..(k+1) /\ sigma permutes (0..k) ==>
9931                                  (EL j ( left_action_list (g(i,sigma)) ul) = EL j (left_action_list sigma (DROP ul i) )))`,
9932    GEN_TAC THEN
9933      ABBREV_TAC `f = (\i j. if j = k + 1 then i else (if (i <= j /\ j < k + 1) then j + 1 else j))` THEN
9934      ABBREV_TAC `fi = (\i j. if j = i then k + 1 else (if (i < j /\ j <= k + 1) then j - 1 else j))` THEN
9935      SUBGOAL_THEN `!i. i <= k + 1 ==> (f:num->num->num) i o fi i = I:num->num /\ fi i o f i = I` ASSUME_TAC THENL
9936      [
9937        REWRITE_TAC[IN_NUMSEG; FUN_EQ_THM; I_THM; o_THM] THEN
9938          REPEAT STRIP_TAC THENL
9939          [
9940            EXPAND_TAC "fi" THEN
9941              COND_CASES_TAC THENL
9942              [
9943                EXPAND_TAC "f" THEN
9944                  ASM_REWRITE_TAC[];
9945                ALL_TAC
9946              ] THEN
9947              COND_CASES_TAC THENL
9948              [
9949                EXPAND_TAC "f" THEN
9950                  ASM_SIMP_TAC[ARITH_RULE `x <= k + 1 ==> ~(x - 1 = k + 1)`] THEN
9951                  MP_TAC (ARITH_RULE `i < x /\ x <= k + 1 ==> i <= x - 1 /\ x - 1 < k + 1`) THEN
9952                  ASM_SIMP_TAC[] THEN
9953                  POP_ASSUM MP_TAC THEN ARITH_TAC;
9954                ALL_TAC
9955              ] THEN
9956              EXPAND_TAC "f" THEN
9957              POP_ASSUM MP_TAC THEN
9958              REWRITE_TAC[DE_MORGAN_THM; NOT_LT; NOT_LE] THEN
9959              DISCH_THEN DISJ_CASES_TAC THENL
9960              [
9961                MP_TAC (ARITH_RULE `x <= i /\ ~(x = i) /\ i <= k + 1 ==> ~(x = k + 1)`) THEN
9962                  ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
9963                  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
9964                  MP_TAC (ARITH_RULE `x <= i /\ i <= x ==> x = i:num`) THEN
9965                  ASM_REWRITE_TAC[];
9966                ALL_TAC
9967              ] THEN
9968              ASM_SIMP_TAC[ARITH_RULE `k + 1 < x ==> ~(x = k + 1) /\ ~(x < k + 1)`];
9969            ALL_TAC
9970          ] THEN
9971
9972          EXPAND_TAC "f" THEN
9973          COND_CASES_TAC THENL
9974          [
9975            EXPAND_TAC "fi" THEN
9976              ASM_REWRITE_TAC[];
9977            ALL_TAC
9978          ] THEN
9979
9980          COND_CASES_TAC THENL
9981          [
9982            EXPAND_TAC "fi" THEN
9983              ASM_SIMP_TAC[ARITH_RULE `i <= x ==> ~(x + 1 = i)`] THEN
9984              MP_TAC (ARITH_RULE `i <= x /\ x < k + 1 ==> i < x + 1 /\ x + 1 <= k + 1`) THEN
9985              ASM_SIMP_TAC[ARITH_RULE `(x + 1) - 1 = x`];
9986            ALL_TAC
9987          ] THEN
9988
9989          EXPAND_TAC "fi" THEN
9990          POP_ASSUM MP_TAC THEN REWRITE_TAC[DE_MORGAN_THM; NOT_LE; NOT_LT] THEN
9991          DISCH_THEN DISJ_CASES_TAC THENL
9992          [
9993            ASM_SIMP_TAC[ARITH_RULE `x < i ==> ~(x = i:num) /\ ~(i < x)`];
9994            ALL_TAC
9995          ] THEN
9996
9997          MP_TAC (ARITH_RULE `k + 1 <= x /\ ~(x = k + 1) ==> ~(x <= k + 1)`) THEN
9998          ASM_SIMP_TAC[] THEN
9999          COND_CASES_TAC THEN ASM_REWRITE_TAC[];
10000        ALL_TAC
10001      ] THEN
10002
10003      SUBGOAL_THEN `!i j. i <= k + 1 ==> (f:num->num->num) i (fi i j) = j /\ fi i (f i j) = j` ASSUME_TAC THENL
10004      [
10005        GEN_TAC THEN GEN_TAC THEN DISCH_TAC THEN
10006          FIRST_X_ASSUM (MP_TAC o SPEC `i:num`) THEN
10007          ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
10008          DISCH_THEN (CONJUNCTS_THEN (ASSUME_TAC o SPEC `j:num`)) THEN
10009          ASM_REWRITE_TAC[];
10010        ALL_TAC
10011      ] THEN
10012
10013      SUBGOAL_THEN `!i. i <= k + 1 ==> f i permutes (0..k+1) /\ fi i permutes (0..k+1)` ASSUME_TAC THENL
10014      [
10015        GEN_TAC THEN DISCH_TAC THEN
10016          SUBGOAL_THEN `(f:num->num->num) i permutes (0..k+1)` ASSUME_TAC THENL
10017          [
10018            REWRITE_TAC[permutes; IN_NUMSEG; DE_MORGAN_THM; NOT_LE; ARITH_RULE `~(x < 0)`] THEN
10019              REPEAT STRIP_TAC THENL
10020              [
10021                EXPAND_TAC "f" THEN
10022                  ASM_SIMP_TAC[ARITH_RULE `k + 1 < x ==> ~(x = k + 1) /\ ~(x < k + 1)`];
10023                ALL_TAC
10024              ] THEN
10025
10026              REWRITE_TAC[EXISTS_UNIQUE] THEN
10027              EXISTS_TAC `(fi:num->num->num) i y` THEN
10028              CONJ_TAC THENL
10029              [
10030                ASM_SIMP_TAC[];
10031                ALL_TAC
10032              ] THEN
10033
10034              GEN_TAC THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
10035              ASM_SIMP_TAC[];
10036            ALL_TAC
10037          ] THEN
10038
10039          ASM_REWRITE_TAC[] THEN
10040          MATCH_MP_TAC Hypermap_and_fan.INVERSE_PERMUTES THEN
10041          EXISTS_TAC `(f:num->num->num) i` THEN
10042          ASM_SIMP_TAC[];
10043        ALL_TAC
10044      ] THEN
10045
10046
10047      ABBREV_TAC `g = \(i:num,sigma:num->num). sigma o (fi:num->num->num) i` THEN
10048      EXISTS_TAC `g:(num#(num->num))->num->num` THEN
10049
10050
10051      SUBGOAL_THEN `!i sigma. i <= k + 1 /\ sigma permutes 0..k ==> g (i,sigma) permutes (0..k+1)` ASSUME_TAC THENL
10052      [
10053        REPEAT STRIP_TAC THEN
10054          EXPAND_TAC "g" THEN
10055          REWRITE_TAC[] THEN
10056          MATCH_MP_TAC PERMUTES_COMPOSE THEN
10057          ASM_SIMP_TAC[] THEN
10058          MATCH_MP_TAC PERMUTES_SUBSET THEN
10059          EXISTS_TAC `0..k` THEN
10060          ASM_REWRITE_TAC[SUBSET_NUMSEG] THEN
10061          ARITH_TAC;
10062        ALL_TAC
10063      ] THEN
10064
10065      SUBGOAL_THEN `!i sigma. i <= k + 1 /\ sigma permutes 0..k ==> inverse (g (i,sigma)) (k + 1) = i` ASSUME_TAC THENL
10066      [
10067        REPEAT STRIP_TAC THEN
10068          SUBGOAL_THEN `g (i:num, sigma:num->num) i = k + 1` MP_TAC THENL
10069          [
10070            EXPAND_TAC "g" THEN REWRITE_TAC[o_THM] THEN
10071              EXPAND_TAC "fi" THEN REWRITE_TAC[] THEN
10072              POP_ASSUM MP_TAC THEN
10073              REWRITE_TAC[permutes; IN_NUMSEG; DE_MORGAN_THM; NOT_LE; ARITH_RULE `~(x < 0)`] THEN
10074              DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC o SPEC `k + 1`) (fun th -> ALL_TAC)) THEN
10075              SIMP_TAC[ARITH_RULE `k < k + 1`];
10076            ALL_TAC
10077          ] THEN
10078
10079          DISCH_THEN (MP_TAC o AP_TERM `\x:num. (inverse (g (i:num, sigma:num->num)) x):num`) THEN BETA_TAC THEN
10080          DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
10081
10082          MP_TAC (ISPECL [`(g (i:num, sigma:num->num)):num->num`; `0..k+1`] PERMUTES_INVERSES) THEN
10083          ASM_SIMP_TAC[];
10084        ALL_TAC
10085      ] THEN
10086
10087      CONJ_TAC THENL
10088      [
10089        REWRITE_TAC[BIJ; INJ; SURJ; IN_ELIM_THM; IN_NUMSEG; ARITH_RULE `0 <= i`] THEN
10090          REPEAT STRIP_TAC THENL
10091          [
10092            ASM_SIMP_TAC[];
10093
10094            ASM_REWRITE_TAC[PAIR_EQ] THEN
10095              FIRST_ASSUM (MP_TAC o SPECL [`i:num`; `sigma:num->num`]) THEN
10096              FIRST_X_ASSUM (MP_TAC o SPECL [`i':num`; `sigma':num->num`]) THEN
10097              ASM_REWRITE_TAC[] THEN
10098              POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
10099              ASM_REWRITE_TAC[] THEN
10100              DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN DISCH_TAC THEN
10101              ASM_REWRITE_TAC[] THEN
10102              POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
10103              EXPAND_TAC "g" THEN REWRITE_TAC[] THEN
10104              DISCH_THEN (MP_TAC o AP_TERM `(\x:num->num. x o (f:num->num->num) i)`) THEN
10105              ASM_SIMP_TAC[GSYM o_ASSOC; I_O_ID];
10106
10107            ASM_SIMP_TAC[];
10108
10109            ABBREV_TAC `r = inverse (x:num->num) (k + 1)` THEN
10110              EXISTS_TAC `r:num, (x:num->num) o (f:num->num->num) r` THEN
10111
10112                SUBGOAL_THEN `r <= k + 1` ASSUME_TAC THENL
10113                [
10114                  MP_TAC (ISPECL [`x:num->num`; `0..k+1`] PERMUTES_INVERSE) THEN
10115                    ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
10116                    MP_TAC (ISPECL [`inverse (x:num->num)`; `0..k+1`] Hypermap_and_fan.PERMUTES_IMP_INSIDE) THEN
10117                    ASM_REWRITE_TAC[] THEN
10118                    DISCH_THEN (MP_TAC o SPEC `k + 1`) THEN
10119                    ASM_REWRITE_TAC[IN_NUMSEG; LE_0; LE_REFL];
10120                  ALL_TAC
10121                ] THEN
10122
10123                CONJ_TAC THENL
10124                [
10125                  EXISTS_TAC `r:num` THEN
10126                    EXISTS_TAC `(x:num->num) o (f:num->num->num) r` THEN
10127                    ASM_REWRITE_TAC[] THEN
10128                    SUBGOAL_THEN `(x:num->num) o (f:num->num->num) r permutes 0..k+1` MP_TAC THENL
10129                    [
10130                      MATCH_MP_TAC PERMUTES_COMPOSE THEN
10131                        ASM_SIMP_TAC[];
10132                      ALL_TAC
10133                    ] THEN
10134
10135                    SIMP_TAC[permutes; IN_NUMSEG; DE_MORGAN_THM; NOT_LE; ARITH_RULE `~(x < 0)`] THEN
10136                    DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC (fun th -> ALL_TAC)) THEN
10137                    X_GEN_TAC `j:num` THEN
10138                    ONCE_REWRITE_TAC[ARITH_RULE `k < j <=> j = k + 1 \/ k + 1 < j`] THEN
10139                    DISCH_THEN DISJ_CASES_TAC THENL
10140                    [
10141                      ASM_REWRITE_TAC[] THEN
10142                        EXPAND_TAC "r" THEN
10143                        REWRITE_TAC[o_THM] THEN
10144                        EXPAND_TAC "f" THEN
10145                        REWRITE_TAC[] THEN
10146                        MP_TAC (ISPECL [`x:num->num`; `0..k+1`] PERMUTES_INVERSES) THEN
10147                        ASM_SIMP_TAC[];
10148                      ALL_TAC
10149                    ] THEN
10150
10151                    ASM_SIMP_TAC[];
10152                  ALL_TAC
10153                ] THEN
10154
10155                EXPAND_TAC "g" THEN REWRITE_TAC[GSYM o_ASSOC] THEN
10156                ASM_SIMP_TAC[I_O_ID]
10157          ];
10158        ALL_TAC
10159      ] THEN
10160
10161      REPEAT STRIP_TAC THEN
10162      SUBGOAL_THEN `j < k + 2 /\ j < k + 1` ASSUME_TAC THENL
10163      [
10164        UNDISCH_TAC `j <= k:num` THEN ARITH_TAC;
10165        ALL_TAC
10166      ] THEN
10167
10168      SUBGOAL_THEN `i < k + 2` ASSUME_TAC THENL
10169      [
10170        UNDISCH_TAC `i IN 0..k+1` THEN REWRITE_TAC[IN_NUMSEG] THEN
10171          ARITH_TAC;
10172        ALL_TAC
10173      ] THEN
10174
10175      SUBGOAL_THEN `LENGTH (DROP (ul:(A)list) i) = k + 1` ASSUME_TAC THENL
10176      [
10177        MP_TAC (SPECL [`i:num`; `ul:(A)list`] LENGTH_DROP) THEN
10178          ASM_REWRITE_TAC[] THEN
10179          ARITH_TAC;
10180        ALL_TAC
10181      ] THEN
10182
10183      ASM_SIMP_TAC[left_action_list; EL_TABLE] THEN
10184      ABBREV_TAC `r = inverse (sigma:num->num) j` THEN
10185      MP_TAC (SPECL [`i:num`; `r:num`; `ul:(A)list`] EL_DROP) THEN
10186
10187      SUBGOAL_THEN `r <= k:num` ASSUME_TAC THENL
10188      [
10189        MP_TAC (ISPECL [`sigma:num->num`; `0..k`] PERMUTES_INVERSE) THEN
10190          ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
10191          MP_TAC (ISPECL [`inverse (sigma:num->num)`; `0..k`] Hypermap_and_fan.PERMUTES_IMP_INSIDE) THEN
10192          ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o SPEC `j:num`) THEN
10193          ASM_REWRITE_TAC[IN_NUMSEG; LE_0];
10194        ALL_TAC
10195      ] THEN
10196
10197      ASM_REWRITE_TAC[ARITH_RULE `r < (k + 2) - 1 <=> r <= k`] THEN
10198      DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
10199      EXPAND_TAC "g" THEN REWRITE_TAC[] THEN
10200
10201      SUBGOAL_THEN `inverse ((sigma:num->num) o (fi:num->num->num) i) = (f:num->num->num) i o inverse sigma` (fun th -> REWRITE_TAC[th]) THENL
10202      [
10203        MATCH_MP_TAC INVERSE_UNIQUE_o THEN
10204          SUBGOAL_THEN `!a:num->num b:num->num c:num->num d:num->num. (a o b) o c o d = a o (b o c) o d` (fun th -> REWRITE_TAC[th]) THENL
10205          [
10206            REWRITE_TAC[o_ASSOC];
10207            ALL_TAC
10208          ] THEN
10209
10210          UNDISCH_TAC `!i. i <= k + 1 ==> (f:num->num->num) i o fi i = I /\ fi i o f i = I` THEN
10211          DISCH_THEN (MP_TAC o SPEC `i:num`) THEN
10212          ASM_REWRITE_TAC[ARITH_RULE `i <= k + 1 <=> i < k + 2`] THEN
10213          DISCH_TAC THEN
10214          MP_TAC (ISPECL [`sigma:num->num`; `0..k`] PERMUTES_INVERSES_o) THEN
10215          ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
10216          ASM_REWRITE_TAC[I_O_ID];
10217        ALL_TAC
10218      ] THEN
10219
10220      ASM_REWRITE_TAC[o_THM] THEN
10221      EXPAND_TAC "f" THEN
10222      ASM_SIMP_TAC[ARITH_RULE `r <= k ==> ~(r = k + 1) /\ r < k + 1`] THEN
10223      ONCE_REWRITE_TAC[GSYM NOT_LE] THEN
10224      COND_CASES_TAC THEN ASM_REWRITE_TAC[]);;
10225
10226
10227
10228 (* COPY *)
10229
10230 let IVFICRK_real3 = prove(`!k. ?g. (BIJ g { (i,sigma ) | i IN 0..(k+1) /\ sigma permutes (0..k) } { p | p permutes (0..(k+1)) })
10231                            /\ (!(ul:(real^3)list) i sigma j. (LENGTH ul = k+2) /\ j <= k /\ i IN 0..(k+1) /\ sigma permutes (0..k) ==>
10232                                  (EL j ( left_action_list (g(i,sigma)) ul) = EL j (left_action_list sigma (DROP ul i) )))`,
10233    GEN_TAC THEN
10234      ABBREV_TAC `f = (\i j. if j = k + 1 then i else (if (i <= j /\ j < k + 1) then j + 1 else j))` THEN
10235      ABBREV_TAC `fi = (\i j. if j = i then k + 1 else (if (i < j /\ j <= k + 1) then j - 1 else j))` THEN
10236      SUBGOAL_THEN `!i. i <= k + 1 ==> (f:num->num->num) i o fi i = I:num->num /\ fi i o f i = I` ASSUME_TAC THENL
10237      [
10238        REWRITE_TAC[IN_NUMSEG; FUN_EQ_THM; I_THM; o_THM] THEN
10239          REPEAT STRIP_TAC THENL
10240          [
10241            EXPAND_TAC "fi" THEN
10242              COND_CASES_TAC THENL
10243              [
10244                EXPAND_TAC "f" THEN
10245                  ASM_REWRITE_TAC[];
10246                ALL_TAC
10247              ] THEN
10248              COND_CASES_TAC THENL
10249              [
10250                EXPAND_TAC "f" THEN
10251                  ASM_SIMP_TAC[ARITH_RULE `x <= k + 1 ==> ~(x - 1 = k + 1)`] THEN
10252                  MP_TAC (ARITH_RULE `i < x /\ x <= k + 1 ==> i <= x - 1 /\ x - 1 < k + 1`) THEN
10253                  ASM_SIMP_TAC[] THEN
10254                  POP_ASSUM MP_TAC THEN ARITH_TAC;
10255                ALL_TAC
10256              ] THEN
10257              EXPAND_TAC "f" THEN
10258              POP_ASSUM MP_TAC THEN
10259              REWRITE_TAC[DE_MORGAN_THM; NOT_LT; NOT_LE] THEN
10260              DISCH_THEN DISJ_CASES_TAC THENL
10261              [
10262                MP_TAC (ARITH_RULE `x <= i /\ ~(x = i) /\ i <= k + 1 ==> ~(x = k + 1)`) THEN
10263                  ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
10264                  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
10265                  MP_TAC (ARITH_RULE `x <= i /\ i <= x ==> x = i:num`) THEN
10266                  ASM_REWRITE_TAC[];
10267                ALL_TAC
10268              ] THEN
10269              ASM_SIMP_TAC[ARITH_RULE `k + 1 < x ==> ~(x = k + 1) /\ ~(x < k + 1)`];
10270            ALL_TAC
10271          ] THEN
10272
10273          EXPAND_TAC "f" THEN
10274          COND_CASES_TAC THENL
10275          [
10276            EXPAND_TAC "fi" THEN
10277              ASM_REWRITE_TAC[];
10278            ALL_TAC
10279          ] THEN
10280
10281          COND_CASES_TAC THENL
10282          [
10283            EXPAND_TAC "fi" THEN
10284              ASM_SIMP_TAC[ARITH_RULE `i <= x ==> ~(x + 1 = i)`] THEN
10285              MP_TAC (ARITH_RULE `i <= x /\ x < k + 1 ==> i < x + 1 /\ x + 1 <= k + 1`) THEN
10286              ASM_SIMP_TAC[ARITH_RULE `(x + 1) - 1 = x`];
10287            ALL_TAC
10288          ] THEN
10289
10290          EXPAND_TAC "fi" THEN
10291          POP_ASSUM MP_TAC THEN REWRITE_TAC[DE_MORGAN_THM; NOT_LE; NOT_LT] THEN
10292          DISCH_THEN DISJ_CASES_TAC THENL
10293          [
10294            ASM_SIMP_TAC[ARITH_RULE `x < i ==> ~(x = i:num) /\ ~(i < x)`];
10295            ALL_TAC
10296          ] THEN
10297
10298          MP_TAC (ARITH_RULE `k + 1 <= x /\ ~(x = k + 1) ==> ~(x <= k + 1)`) THEN
10299          ASM_SIMP_TAC[] THEN
10300          COND_CASES_TAC THEN ASM_REWRITE_TAC[];
10301        ALL_TAC
10302      ] THEN
10303
10304      SUBGOAL_THEN `!i j. i <= k + 1 ==> (f:num->num->num) i (fi i j) = j /\ fi i (f i j) = j` ASSUME_TAC THENL
10305      [
10306        GEN_TAC THEN GEN_TAC THEN DISCH_TAC THEN
10307          FIRST_X_ASSUM (MP_TAC o SPEC `i:num`) THEN
10308          ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
10309          DISCH_THEN (CONJUNCTS_THEN (ASSUME_TAC o SPEC `j:num`)) THEN
10310          ASM_REWRITE_TAC[];
10311        ALL_TAC
10312      ] THEN
10313
10314      SUBGOAL_THEN `!i. i <= k + 1 ==> f i permutes (0..k+1) /\ fi i permutes (0..k+1)` ASSUME_TAC THENL
10315      [
10316        GEN_TAC THEN DISCH_TAC THEN
10317          SUBGOAL_THEN `(f:num->num->num) i permutes (0..k+1)` ASSUME_TAC THENL
10318          [
10319            REWRITE_TAC[permutes; IN_NUMSEG; DE_MORGAN_THM; NOT_LE; ARITH_RULE `~(x < 0)`] THEN
10320              REPEAT STRIP_TAC THENL
10321              [
10322                EXPAND_TAC "f" THEN
10323                  ASM_SIMP_TAC[ARITH_RULE `k + 1 < x ==> ~(x = k + 1) /\ ~(x < k + 1)`];
10324                ALL_TAC
10325              ] THEN
10326
10327              REWRITE_TAC[EXISTS_UNIQUE] THEN
10328              EXISTS_TAC `(fi:num->num->num) i y` THEN
10329              CONJ_TAC THENL
10330              [
10331                ASM_SIMP_TAC[];
10332                ALL_TAC
10333              ] THEN
10334
10335              GEN_TAC THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
10336              ASM_SIMP_TAC[];
10337            ALL_TAC
10338          ] THEN
10339
10340          ASM_REWRITE_TAC[] THEN
10341          MATCH_MP_TAC Hypermap_and_fan.INVERSE_PERMUTES THEN
10342          EXISTS_TAC `(f:num->num->num) i` THEN
10343          ASM_SIMP_TAC[];
10344        ALL_TAC
10345      ] THEN
10346
10347
10348      ABBREV_TAC `g = \(i:num,sigma:num->num). sigma o (fi:num->num->num) i` THEN
10349      EXISTS_TAC `g:(num#(num->num))->num->num` THEN
10350
10351
10352      SUBGOAL_THEN `!i sigma. i <= k + 1 /\ sigma permutes 0..k ==> g (i,sigma) permutes (0..k+1)` ASSUME_TAC THENL
10353      [
10354        REPEAT STRIP_TAC THEN
10355          EXPAND_TAC "g" THEN
10356          REWRITE_TAC[] THEN
10357          MATCH_MP_TAC PERMUTES_COMPOSE THEN
10358          ASM_SIMP_TAC[] THEN
10359          MATCH_MP_TAC PERMUTES_SUBSET THEN
10360          EXISTS_TAC `0..k` THEN
10361          ASM_REWRITE_TAC[SUBSET_NUMSEG] THEN
10362          ARITH_TAC;
10363        ALL_TAC
10364      ] THEN
10365
10366      SUBGOAL_THEN `!i sigma. i <= k + 1 /\ sigma permutes 0..k ==> inverse (g (i,sigma)) (k + 1) = i` ASSUME_TAC THENL
10367      [
10368        REPEAT STRIP_TAC THEN
10369          SUBGOAL_THEN `g (i:num, sigma:num->num) i = k + 1` MP_TAC THENL
10370          [
10371            EXPAND_TAC "g" THEN REWRITE_TAC[o_THM] THEN
10372              EXPAND_TAC "fi" THEN REWRITE_TAC[] THEN
10373              POP_ASSUM MP_TAC THEN
10374              REWRITE_TAC[permutes; IN_NUMSEG; DE_MORGAN_THM; NOT_LE; ARITH_RULE `~(x < 0)`] THEN
10375              DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC o SPEC `k + 1`) (fun th -> ALL_TAC)) THEN
10376              SIMP_TAC[ARITH_RULE `k < k + 1`];
10377            ALL_TAC
10378          ] THEN
10379
10380          DISCH_THEN (MP_TAC o AP_TERM `\x:num. (inverse (g (i:num, sigma:num->num)) x):num`) THEN BETA_TAC THEN
10381          DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
10382
10383          MP_TAC (ISPECL [`(g (i:num, sigma:num->num)):num->num`; `0..k+1`] PERMUTES_INVERSES) THEN
10384          ASM_SIMP_TAC[];
10385        ALL_TAC
10386      ] THEN
10387
10388      CONJ_TAC THENL
10389      [
10390        REWRITE_TAC[BIJ; INJ; SURJ; IN_ELIM_THM; IN_NUMSEG; ARITH_RULE `0 <= i`] THEN
10391          REPEAT STRIP_TAC THENL
10392          [
10393            ASM_SIMP_TAC[];
10394
10395            ASM_REWRITE_TAC[PAIR_EQ] THEN
10396              FIRST_ASSUM (MP_TAC o SPECL [`i:num`; `sigma:num->num`]) THEN
10397              FIRST_X_ASSUM (MP_TAC o SPECL [`i':num`; `sigma':num->num`]) THEN
10398              ASM_REWRITE_TAC[] THEN
10399              POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
10400              ASM_REWRITE_TAC[] THEN
10401              DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN DISCH_TAC THEN
10402              ASM_REWRITE_TAC[] THEN
10403              POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
10404              EXPAND_TAC "g" THEN REWRITE_TAC[] THEN
10405              DISCH_THEN (MP_TAC o AP_TERM `(\x:num->num. x o (f:num->num->num) i)`) THEN
10406              ASM_SIMP_TAC[GSYM o_ASSOC; I_O_ID];
10407
10408            ASM_SIMP_TAC[];
10409
10410            ABBREV_TAC `r = inverse (x:num->num) (k + 1)` THEN
10411              EXISTS_TAC `r:num, (x:num->num) o (f:num->num->num) r` THEN
10412
10413                SUBGOAL_THEN `r <= k + 1` ASSUME_TAC THENL
10414                [
10415                  MP_TAC (ISPECL [`x:num->num`; `0..k+1`] PERMUTES_INVERSE) THEN
10416                    ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
10417                    MP_TAC (ISPECL [`inverse (x:num->num)`; `0..k+1`] Hypermap_and_fan.PERMUTES_IMP_INSIDE) THEN
10418                    ASM_REWRITE_TAC[] THEN
10419                    DISCH_THEN (MP_TAC o SPEC `k + 1`) THEN
10420                    ASM_REWRITE_TAC[IN_NUMSEG; LE_0; LE_REFL];
10421                  ALL_TAC
10422                ] THEN
10423
10424                CONJ_TAC THENL
10425                [
10426                  EXISTS_TAC `r:num` THEN
10427                    EXISTS_TAC `(x:num->num) o (f:num->num->num) r` THEN
10428                    ASM_REWRITE_TAC[] THEN
10429                    SUBGOAL_THEN `(x:num->num) o (f:num->num->num) r permutes 0..k+1` MP_TAC THENL
10430                    [
10431                      MATCH_MP_TAC PERMUTES_COMPOSE THEN
10432                        ASM_SIMP_TAC[];
10433                      ALL_TAC
10434                    ] THEN
10435
10436                    SIMP_TAC[permutes; IN_NUMSEG; DE_MORGAN_THM; NOT_LE; ARITH_RULE `~(x < 0)`] THEN
10437                    DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC (fun th -> ALL_TAC)) THEN
10438                    X_GEN_TAC `j:num` THEN
10439                    ONCE_REWRITE_TAC[ARITH_RULE `k < j <=> j = k + 1 \/ k + 1 < j`] THEN
10440                    DISCH_THEN DISJ_CASES_TAC THENL
10441                    [
10442                      ASM_REWRITE_TAC[] THEN
10443                        EXPAND_TAC "r" THEN
10444                        REWRITE_TAC[o_THM] THEN
10445                        EXPAND_TAC "f" THEN
10446                        REWRITE_TAC[] THEN
10447                        MP_TAC (ISPECL [`x:num->num`; `0..k+1`] PERMUTES_INVERSES) THEN
10448                        ASM_SIMP_TAC[];
10449                      ALL_TAC
10450                    ] THEN
10451
10452                    ASM_SIMP_TAC[];
10453                  ALL_TAC
10454                ] THEN
10455
10456                EXPAND_TAC "g" THEN REWRITE_TAC[GSYM o_ASSOC] THEN
10457                ASM_SIMP_TAC[I_O_ID]
10458          ];
10459        ALL_TAC
10460      ] THEN
10461
10462      REPEAT STRIP_TAC THEN
10463      SUBGOAL_THEN `j < k + 2 /\ j < k + 1` ASSUME_TAC THENL
10464      [
10465        UNDISCH_TAC `j <= k:num` THEN ARITH_TAC;
10466        ALL_TAC
10467      ] THEN
10468
10469      SUBGOAL_THEN `i < k + 2` ASSUME_TAC THENL
10470      [
10471        UNDISCH_TAC `i IN 0..k+1` THEN REWRITE_TAC[IN_NUMSEG] THEN
10472          ARITH_TAC;
10473        ALL_TAC
10474      ] THEN
10475
10476      SUBGOAL_THEN `LENGTH (DROP (ul:(real^3)list) i) = k + 1` ASSUME_TAC THENL
10477      [
10478        MP_TAC (ISPECL [`i:num`; `ul:(real^3)list`] LENGTH_DROP) THEN
10479          ASM_REWRITE_TAC[] THEN
10480          ARITH_TAC;
10481        ALL_TAC
10482      ] THEN
10483
10484      ASM_SIMP_TAC[left_action_list; EL_TABLE] THEN
10485      ABBREV_TAC `r = inverse (sigma:num->num) j` THEN
10486      MP_TAC (ISPECL [`i:num`; `r:num`; `ul:(real^3)list`] EL_DROP) THEN
10487
10488      SUBGOAL_THEN `r <= k:num` ASSUME_TAC THENL
10489      [
10490        MP_TAC (ISPECL [`sigma:num->num`; `0..k`] PERMUTES_INVERSE) THEN
10491          ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
10492          MP_TAC (ISPECL [`inverse (sigma:num->num)`; `0..k`] Hypermap_and_fan.PERMUTES_IMP_INSIDE) THEN
10493          ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o SPEC `j:num`) THEN
10494          ASM_REWRITE_TAC[IN_NUMSEG; LE_0];
10495        ALL_TAC
10496      ] THEN
10497
10498      ASM_REWRITE_TAC[ARITH_RULE `r < (k + 2) - 1 <=> r <= k`] THEN
10499      DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
10500      EXPAND_TAC "g" THEN REWRITE_TAC[] THEN
10501
10502      SUBGOAL_THEN `inverse ((sigma:num->num) o (fi:num->num->num) i) = (f:num->num->num) i o inverse sigma` (fun th -> REWRITE_TAC[th]) THENL
10503      [
10504        MATCH_MP_TAC INVERSE_UNIQUE_o THEN
10505          SUBGOAL_THEN `!a:num->num b:num->num c:num->num d:num->num. (a o b) o c o d = a o (b o c) o d` (fun th -> REWRITE_TAC[th]) THENL
10506          [
10507            REWRITE_TAC[o_ASSOC];
10508            ALL_TAC
10509          ] THEN
10510
10511          UNDISCH_TAC `!i. i <= k + 1 ==> (f:num->num->num) i o fi i = I /\ fi i o f i = I` THEN
10512          DISCH_THEN (MP_TAC o SPEC `i:num`) THEN
10513          ASM_REWRITE_TAC[ARITH_RULE `i <= k + 1 <=> i < k + 2`] THEN
10514          DISCH_TAC THEN
10515          MP_TAC (ISPECL [`sigma:num->num`; `0..k`] PERMUTES_INVERSES_o) THEN
10516          ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
10517          ASM_REWRITE_TAC[I_O_ID];
10518        ALL_TAC
10519      ] THEN
10520
10521      ASM_REWRITE_TAC[o_THM] THEN
10522      EXPAND_TAC "f" THEN
10523      ASM_SIMP_TAC[ARITH_RULE `r <= k ==> ~(r = k + 1) /\ r < k + 1`] THEN
10524      ONCE_REWRITE_TAC[GSYM NOT_LE] THEN
10525      COND_CASES_TAC THEN ASM_REWRITE_TAC[]);;
10526
10527
10528
10529
10530 (******************************************)
10531
10532 (* WQPRRDY *)
10533
10534 let WQPRRDY = prove(`!V ul k. packing V /\ ul IN barV V k /\ hl ul < sqrt(&2) ==>
10535                       (convex hull (set_of_list ul) = UNIONS { rogers V (left_action_list p ul) | p permutes (0..k) })`,
10536    GEN_TAC THEN REWRITE_TAC[IN] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
10537      INDUCT_TAC THEN REPEAT STRIP_TAC THENL
10538      [
10539        SUBGOAL_THEN `?x:real^3. ul = [x]` CHOOSE_TAC THENL
10540          [
10541            EXISTS_TAC `HD ul:real^3` THEN
10542              MATCH_MP_TAC LENGTH_1_LEMMA THEN
10543              UNDISCH_TAC `barV V 0 ul` THEN SIMP_TAC[BARV; ARITH];
10544            ALL_TAC
10545          ] THEN
10546
10547          ASM_REWRITE_TAC[set_of_list; CONVEX_HULL_SING; PERMUTES_TRIVIAL; SING_GSPEC_APP; LEFT_ACTION_LIST_I] THEN
10548          REWRITE_TAC[ROGERS; LENGTH; ARITH_RULE `j < SUC 0 <=> j = 0`; SING_GSPEC; IMAGE_LEMMA; IN_SING; SING_GSPEC_APP; CONVEX_HULL_SING] THEN
10549          REWRITE_TAC[OMEGA_LIST_N; HD; UNIONS_1];
10550        ALL_TAC
10551      ] THEN
10552
10553      ABBREV_TAC `S:real^3->bool = set_of_list ul` THEN
10554      MP_TAC (ISPECL [`S:real^3->bool`; `omega_list V ul`] CONVEX_HULL_EXCHANGE_UNION) THEN
10555      ANTS_TAC THENL
10556      [
10557        EXPAND_TAC "S" THEN
10558          MATCH_MP_TAC XNHPWAB2 THEN
10559          EXISTS_TAC `SUC k` THEN ASM_REWRITE_TAC[IN];
10560        ALL_TAC
10561      ] THEN
10562
10563      DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
10564      ABBREV_TAC `u = omega_list V ul` THEN
10565
10566      EXPAND_TAC "S" THEN ASM_REWRITE_TAC[IN_SET_OF_LIST] THEN
10567      MP_TAC (ISPECL [`V:real^3->bool`; `ul:(real^3)list`; `SUC k`] BARV_IMP_LENGTH_EQ_CARD) THEN
10568      ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
10569
10570
10571      MP_TAC (SPEC `k:num` IVFICRK_real3) THEN
10572      DISCH_THEN (CHOOSE_THEN (CONJUNCTS_THEN2 (LABEL_TAC "g0") ASSUME_TAC)) THEN
10573      POP_ASSUM (MP_TAC o ISPEC `ul:(real^3)list`) THEN
10574      ASM_REWRITE_TAC[ARITH_RULE `SUC k + 1 = k + 2`; IN_NUMSEG; LE_0] THEN DISCH_THEN (LABEL_TAC "tmp") THEN
10575
10576      SUBGOAL_THEN `!i p. i < SUC k + 1 /\ p permutes 0..k ==> g (i,p) permutes 0..SUC k` (LABEL_TAC "g1") THENL
10577      [
10578        REPEAT STRIP_TAC THEN
10579          REMOVE_THEN "g0" MP_TAC THEN
10580          REWRITE_TAC[BIJ; INJ; GSYM CONJ_ASSOC] THEN
10581          DISCH_THEN (CONJUNCTS_THEN2 MP_TAC (fun th -> ALL_TAC)) THEN
10582          DISCH_THEN (MP_TAC o SPEC `i:num, p:num->num`) THEN
10583          REWRITE_TAC[IN_ELIM_THM; ADD1] THEN
10584          ANTS_TAC THENL
10585          [
10586            MAP_EVERY EXISTS_TAC [`i:num`; `p:num->num`] THEN
10587              ASM_REWRITE_TAC[IN_NUMSEG; LE_0; ARITH_RULE `i <= k + 1 <=> i < SUC k + 1`];
10588            ALL_TAC
10589          ] THEN
10590          REWRITE_TAC[];
10591        ALL_TAC
10592      ] THEN
10593
10594      SUBGOAL_THEN `!s. s permutes 0..SUC k ==> ?i p. i < SUC k + 1 /\ p permutes 0..k /\ s = g(i,p)` (LABEL_TAC "g2") THENL
10595      [
10596        REWRITE_TAC[ADD1; ARITH_RULE `i < (k + 1) + 1 <=> i <= k + 1`] THEN
10597          REPEAT STRIP_TAC THEN
10598          REMOVE_THEN "g0" MP_TAC THEN
10599          REWRITE_TAC[BIJ; SURJ] THEN
10600          REPLICATE_TAC 2 (DISCH_THEN (CONJUNCTS_THEN2 (fun th -> ALL_TAC) MP_TAC)) THEN
10601          DISCH_THEN (MP_TAC o SPEC `s:num->num`) THEN
10602          ASM_REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG; LE_0] THEN
10603          STRIP_TAC THEN
10604          MAP_EVERY EXISTS_TAC [`i:num`; `sigma:num->num`] THEN
10605          POP_ASSUM MP_TAC THEN
10606          ASM_REWRITE_TAC[EQ_SYM_EQ];
10607        ALL_TAC
10608      ] THEN
10609
10610      REMOVE_THEN "g0" (fun th -> ALL_TAC) THEN
10611
10612      SUBGOAL_THEN `!i p r. i < SUC k + 1 /\ r <= k /\ p permutes 0..k ==> truncate_simplex r (left_action_list (g(i,p)) ul:(real^3)list) = truncate_simplex r (left_action_list p (DROP ul i))` (LABEL_TAC "tr") THENL
10613      [
10614        REPEAT STRIP_TAC THEN
10615          REWRITE_TAC[LIST_EL_EQ] THEN
10616          ABBREV_TAC `xl:(real^3)list = truncate_simplex r (left_action_list (g (i:num,p:num->num)) ul)` THEN
10617          ABBREV_TAC `yl:(real^3)list = truncate_simplex r (left_action_list p (DROP ul i))` THEN
10618
10619          MP_TAC (ISPECL [`i:num`; `ul:(real^3)list`] LENGTH_DROP) THEN
10620          ASM_REWRITE_TAC[ARITH_RULE `(SUC k + 1) - 1 = SUC k`] THEN DISCH_TAC THEN
10621          MP_TAC (ISPECL [`r:num`; `left_action_list (g (i:num,p:num->num)) ul:(real^3)list`] LENGTH_TRUNCATE_SIMPLEX) THEN
10622          MP_TAC (ARITH_RULE `r <= k ==> r + 1 <= SUC k + 1`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
10623          ASM_REWRITE_TAC[LENGTH_LEFT_ACTION_LIST] THEN
10624
10625          MP_TAC (ISPECL [`r:num`; `left_action_list p (DROP ul i):(real^3)list`] LENGTH_TRUNCATE_SIMPLEX) THEN
10626          ASM_SIMP_TAC[LENGTH_LEFT_ACTION_LIST; ARITH_RULE `r <= k ==> r + 1 <= SUC k`] THEN
10627
10628          REPEAT STRIP_TAC THEN
10629          MP_TAC (ISPECL [`left_action_list (g(i:num,p:num->num)) ul:(real^3)list`; `r:num`; `j:num`] EL_TRUNCATE_SIMPLEX) THEN
10630          ASM_REWRITE_TAC[LENGTH_LEFT_ACTION_LIST] THEN
10631          MP_TAC (ARITH_RULE `j < r + 1 ==> j <= r`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
10632
10633          MP_TAC (ISPECL [`left_action_list p (DROP ul i):(real^3)list`; `r:num`; `j:num`] EL_TRUNCATE_SIMPLEX) THEN
10634          ASM_REWRITE_TAC[LENGTH_LEFT_ACTION_LIST; ARITH_RULE `r + 1 <= SUC k <=> r <= k`] THEN
10635          DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
10636          FIRST_X_ASSUM MATCH_MP_TAC THEN
10637          ASM_REWRITE_TAC[] THEN
10638          UNDISCH_TAC `r <= k:num` THEN UNDISCH_TAC `j <= r:num` THEN UNDISCH_TAC `i < SUC k + 1` THEN
10639          ARITH_TAC;
10640        ALL_TAC
10641      ] THEN
10642
10643      REMOVE_THEN "tmp" (fun th -> ALL_TAC) THEN
10644
10645      SUBGOAL_THEN `!i b:real^3. i < SUC k + 1 /\ b = EL i ul ==> convex hull (u INSERT (S DELETE b)) = UNIONS {convex hull (u INSERT rogers V (left_action_list p (DROP ul i))) | p permutes 0..k}` ASSUME_TAC THENL
10646      [
10647        REPEAT STRIP_TAC THEN
10648          MP_TAC (ISPECL [`i:num`; `ul:(real^3)list`] SET_OF_LIST_DELETE_EQ_DROP) THEN
10649          ASM_REWRITE_TAC[] THEN
10650          DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
10651
10652          ABBREV_TAC `vl:(real^3)list = DROP ul i` THEN
10653          FIRST_X_ASSUM (MP_TAC o SPEC `vl:(real^3)list`) THEN
10654          ANTS_TAC THENL
10655          [
10656            ASM_REWRITE_TAC[] THEN
10657              FIRST_X_ASSUM (MP_TAC o SPECL [`i:num`; `I:num->num`; `k:num`]) THEN
10658              ASM_REWRITE_TAC[PERMUTES_I; LE_REFL; LEFT_ACTION_LIST_I] THEN
10659              MP_TAC (ISPECL [`i:num`; `ul:(real^3)list`] LENGTH_DROP) THEN
10660              ASM_REWRITE_TAC[ARITH_RULE `(SUC k + 1) - 1 = k + 1`] THEN DISCH_TAC THEN
10661              ABBREV_TAC `xl:(real^3)list = left_action_list (g (i:num, I:num->num)) ul` THEN
10662              SUBGOAL_THEN `truncate_simplex k vl = vl:(real^3)list` (fun th -> REWRITE_TAC[th]) THENL
10663              [
10664                MP_TAC (ISPECL [`k:num`; `vl:(real^3)list`; `vl:(real^3)list`] TRUNCATE_SIMPLEX_INITIAL_SUBLIST) THEN
10665                  ASM_REWRITE_TAC[LE_REFL; INITIAL_SUBLIST_REFL];
10666                ALL_TAC
10667              ] THEN
10668
10669              DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
10670              FIRST_X_ASSUM (MP_TAC o SPECL [`i:num`; `I:num->num`]) THEN
10671              ASM_REWRITE_TAC[PERMUTES_I] THEN DISCH_TAC THEN
10672
10673              MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `SUC k`; `(g(i:num,I:num->num)):num->num`] YIFVQDV) THEN
10674              ASM_REWRITE_TAC[IN] THEN DISCH_TAC THEN
10675              CONJ_TAC THENL
10676              [
10677                MATCH_MP_TAC TRUNCATE_SIMPLEX_BARV THEN
10678                  EXISTS_TAC `SUC k` THEN ASM_REWRITE_TAC[ARITH_RULE `k <= SUC k`];
10679                ALL_TAC
10680              ] THEN
10681
10682              MATCH_MP_TAC REAL_LET_TRANS THEN
10683              EXISTS_TAC `hl (xl:(real^3)list)` THEN
10684              CONJ_TAC THENL
10685              [
10686                MATCH_MP_TAC HL_DECREASE THEN
10687                  MAP_EVERY EXISTS_TAC [`V:real^3->bool`; `SUC k`] THEN
10688                  ASM_REWRITE_TAC[IN; ARITH_RULE `k <= SUC k`];
10689                ALL_TAC
10690              ] THEN
10691
10692              EXPAND_TAC "xl" THEN
10693              REWRITE_TAC[HL] THEN
10694              ASM_SIMP_TAC[ARITH_RULE `(SUC k + 1) - 1 = SUC k`; SET_OF_LIST_LEFT_ACTION_LIST] THEN
10695              EXPAND_TAC "S" THEN REWRITE_TAC[GSYM HL] THEN ASM_REWRITE_TAC[];
10696            ALL_TAC
10697          ] THEN
10698
10699
10700          SUBGOAL_THEN `convex hull (u:real^3 INSERT set_of_list vl) = convex hull (u INSERT convex hull set_of_list vl)` (fun th -> REWRITE_TAC[th]) THENL
10701          [
10702            MP_TAC (ISPECL [`{u:real^3}`; `set_of_list vl:real^3->bool`] CONV_UNION_lemma) THEN
10703              REWRITE_TAC[SET_RULE `!x s. {x:real^3} UNION s = x INSERT s`];
10704            ALL_TAC
10705          ] THEN
10706
10707          DISCH_THEN (LABEL_TAC "A") THEN ASM_REWRITE_TAC[] THEN
10708          ABBREV_TAC `f = {rogers V (left_action_list p vl) | p permutes 0..k}` THEN
10709          ONCE_REWRITE_TAC[SET_RULE `!x s. (x:real^3) INSERT s = {x} UNION s`] THEN
10710          MP_TAC (ISPECL [`f:(real^3->bool)->bool`; `{u:real^3}`] CONVEX_HULL_UNION_UNIONS) THEN
10711          ANTS_TAC THENL
10712          [
10713            REMOVE_THEN "A" (fun th -> REWRITE_TAC[SYM th]) THEN
10714              REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; CONVEX_CONVEX_HULL] THEN
10715              EXISTS_TAC `rogers V vl` THEN
10716              EXPAND_TAC "f" THEN
10717              REWRITE_TAC[IN_ELIM_THM] THEN
10718              EXISTS_TAC `I:num->num` THEN
10719              REWRITE_TAC[LEFT_ACTION_LIST_I; PERMUTES_I];
10720            ALL_TAC
10721          ] THEN
10722
10723          DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
10724          AP_TERM_TAC THEN
10725          ASM SET_TAC[];
10726        ALL_TAC
10727      ] THEN
10728
10729
10730      SUBGOAL_THEN `!i p. i < SUC k + 1 /\ p permutes 0..k ==> convex hull (u:real^3 INSERT rogers V (left_action_list p (DROP ul i))) = rogers V (left_action_list (g (i, p)) ul)` (LABEL_TAC "r") THENL
10731      [
10732        REPEAT STRIP_TAC THEN
10733          REWRITE_TAC[ROGERS] THEN
10734          ABBREV_TAC `xl:(real^3)list = left_action_list p (DROP ul i)` THEN
10735          ABBREV_TAC `yl:(real^3)list = left_action_list (g (i:num, p:num->num)) ul` THEN
10736          SUBGOAL_THEN `!s:real^3->bool. convex hull (u INSERT convex hull s) = convex hull (u INSERT s)` (fun th -> REWRITE_TAC[th]) THENL
10737          [
10738            GEN_TAC THEN
10739              MP_TAC (ISPECL [`{u:real^3}`; `s:real^3->bool`] CONV_UNION_lemma) THEN
10740              SIMP_TAC[SET_RULE `{u:real^3} UNION s = u INSERT s`];
10741            ALL_TAC
10742          ] THEN
10743
10744          AP_TERM_TAC THEN
10745          EXPAND_TAC "xl" THEN EXPAND_TAC "yl" THEN
10746          ASM_REWRITE_TAC[LENGTH_LEFT_ACTION_LIST] THEN
10747
10748          MP_TAC (ISPECL [`i:num`; `ul:(real^3)list`] LENGTH_DROP) THEN
10749          ASM_REWRITE_TAC[ARITH_RULE `(SUC k + 1) - 1 = SUC k`] THEN DISCH_TAC THEN
10750
10751          SUBGOAL_THEN `u = omega_list_n V yl (SUC k)` ASSUME_TAC THENL
10752          [
10753            MP_TAC (SPECL [`V:real^3->bool`; `ul:(real^3)list`; `SUC k`; `(g (i:num, p:num->num)):num->num`] YIFVQDV) THEN
10754              ASM_SIMP_TAC[IN] THEN
10755              DISCH_THEN (fun th -> REWRITE_TAC[GSYM th]) THEN
10756
10757              MP_TAC (SPECL [`V:real^3->bool`; `yl:(real^3)list`; `SUC k`] OMEGA_LIST_LEMMA) THEN
10758              EXPAND_TAC "yl" THEN ASM_REWRITE_TAC[LENGTH_LEFT_ACTION_LIST; LE_REFL] THEN
10759              MP_TAC (ISPECL [`SUC k`; `yl:(real^3)list`; `yl:(real^3)list`] TRUNCATE_SIMPLEX_INITIAL_SUBLIST) THEN
10760              EXPAND_TAC "yl" THEN ASM_REWRITE_TAC[LENGTH_LEFT_ACTION_LIST; LE_REFL; INITIAL_SUBLIST_REFL] THEN
10761              DISCH_THEN (fun th -> ASM_REWRITE_TAC[th]);
10762            ALL_TAC
10763          ] THEN
10764
10765          SUBGOAL_THEN `!j. j < SUC k ==> omega_list_n V xl j = omega_list_n V yl j` ASSUME_TAC THENL
10766          [
10767            REPEAT STRIP_TAC THEN
10768              REMOVE_THEN "tr" (MP_TAC o SPECL [`i:num`; `p:num->num`; `k:num`]) THEN
10769              ASM_REWRITE_TAC[LE_REFL] THEN
10770              DISCH_TAC THEN
10771
10772              MP_TAC (SPECL [`V:real^3->bool`; `xl:(real^3)list`; `j:num`; `k - j:num`] OMEGA_LIST_N_LEMMA) THEN
10773              MP_TAC (SPECL [`V:real^3->bool`; `yl:(real^3)list`; `j:num`; `k - j:num`] OMEGA_LIST_N_LEMMA) THEN
10774              MP_TAC (ARITH_RULE `j < SUC k ==> j + k - j = k /\ j + k - j + 1 = k + 1`) THEN
10775              ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
10776              EXPAND_TAC "yl" THEN EXPAND_TAC "xl" THEN REWRITE_TAC[LENGTH_LEFT_ACTION_LIST] THEN
10777              ASM_REWRITE_TAC[ARITH_RULE `k + 1 <= SUC k /\ k + 1 <= SUC k + 1`] THEN
10778              SIMP_TAC[];
10779            ALL_TAC
10780          ] THEN
10781
10782          ASM_REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INSERT; IN_ELIM_THM] THEN
10783          GEN_TAC THEN EQ_TAC THENL
10784          [
10785            STRIP_TAC THENL
10786              [
10787                EXISTS_TAC `SUC k` THEN
10788                  ASM_REWRITE_TAC[] THEN ARITH_TAC;
10789                ALL_TAC
10790              ] THEN
10791
10792              EXISTS_TAC `x':num` THEN
10793              ASM_SIMP_TAC[] THEN POP_ASSUM MP_TAC THEN ARITH_TAC;
10794            ALL_TAC
10795          ] THEN
10796
10797          STRIP_TAC THEN
10798          ASM_CASES_TAC `x' = SUC k` THENL
10799          [
10800            DISJ1_TAC THEN
10801              ASM_SIMP_TAC[];
10802            ALL_TAC
10803          ] THEN
10804
10805          DISJ2_TAC THEN
10806          EXISTS_TAC `x':num` THEN
10807          MP_TAC (ARITH_RULE `x' < SUC k + 1 /\ ~(x' = SUC k) ==> x' < SUC k`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
10808          ASM_SIMP_TAC[];
10809        ALL_TAC
10810      ] THEN
10811
10812
10813
10814      REWRITE_TAC[EXTENSION; IN_UNIONS; IN_ELIM_THM] THEN GEN_TAC THEN
10815      REWRITE_TAC[GSYM EXTENSION; MEM_EXISTS_EL] THEN
10816      EQ_TAC THENL
10817      [
10818        ASM_REWRITE_TAC[] THEN
10819          STRIP_TAC THEN
10820          POP_ASSUM MP_TAC THEN
10821          ASM_REWRITE_TAC[] THEN REMOVE_ASSUM THEN
10822          FIRST_X_ASSUM (MP_TAC o SPECL [`i:num`; `b:real^3`]) THEN
10823          ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
10824          REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN
10825          STRIP_TAC THEN
10826          POP_ASSUM MP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN
10827          FIRST_X_ASSUM (MP_TAC o SPECL [`i:num`; `p:num->num`]) THEN
10828          ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
10829          DISCH_TAC THEN
10830
10831          EXISTS_TAC `rogers V (left_action_list (g (i:num, p:num->num)) ul)` THEN
10832          ASM_REWRITE_TAC[] THEN
10833          EXISTS_TAC `(g (i:num, p:num->num)):num->num` THEN
10834          ASM_SIMP_TAC[];
10835        ALL_TAC
10836      ] THEN
10837
10838      STRIP_TAC THEN
10839      POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
10840      FIRST_X_ASSUM (MP_TAC o SPEC `p:num->num`) THEN
10841      ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
10842
10843      EXISTS_TAC `convex hull (u:real^3 INSERT (S DELETE (EL i ul)))` THEN
10844      CONJ_TAC THENL
10845      [
10846        EXISTS_TAC `EL i ul:real^3` THEN REWRITE_TAC[] THEN
10847          EXISTS_TAC `i:num` THEN
10848          ASM_REWRITE_TAC[];
10849        ALL_TAC
10850      ] THEN
10851
10852      MATCH_MP_TAC IN_TRANS THEN
10853      EXISTS_TAC `rogers V (left_action_list p ul)` THEN
10854      ASM_REWRITE_TAC[] THEN
10855
10856      FIRST_X_ASSUM (MP_TAC o SPECL [`i:num`; `p':num->num`]) THEN
10857      ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN
10858      FIRST_X_ASSUM (MP_TAC o SPECL [`i:num`; `EL i ul:real^3`]) THEN
10859      ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN
10860      REWRITE_TAC[SUBSET; IN_UNIONS] THEN
10861      REPEAT STRIP_TAC THEN
10862      EXISTS_TAC `convex hull (u INSERT rogers V (left_action_list p' (DROP ul i)))` THEN
10863      ASM_REWRITE_TAC[IN_ELIM_THM] THEN
10864      EXISTS_TAC `p':num->num` THEN
10865      ASM_REWRITE_TAC[]);;
10866
10867
10868
10869
10870
10871 end;;
10872