legacy/oldleg/collect_geom.ml

   1 needs "Multivariate/vectors.ml";; (* Eventually should load entire *)\r
   2 \r
   3 \r
   4 (* let DOT_BASIS_BASIS_UNEQUAL = prove(`!i j. ~(i = j) ==> (basis i) dot (basis j) = &0`,\r
   5   SIMP_TAC[basis; dot; LAMBDA_BETA] THEN ONCE_REWRITE_TAC[COND_RAND] THEN\r
   6    SIMP_TAC[SUM_0; REAL_MUL_RZERO; REAL_MUL_LZERO; COND_ID]);; *)\r
   7 \r
   8 needs "Examples/analysis.ml";; (* multivariate-complex theory. *)          \r
   9 needs "Examples/transc.ml";; (* Then it won't need these three. *)\r
  10 needs "convex_header.ml";; \r
  11 needs "definitions_kepler.ml";;\r
  12 needs "geomdetail.ml";;\r
  13 \r
  14 prioritize_real();;\r
  15 \r
  16 let ups_x = new_definition ` ups_x x1 x2 x6 =\r
  17          --x1 * x1 - x2 * x2 - x6 * x6 +\r
  18          &2 * x1 * x6 +\r
  19          &2 * x1 * x2 +\r
  20          &2 * x2 * x6 `;;\r
  21 let rho = new_definition ` rho (x12 :real) x13 x14 x23 x24 x34 =\r
  22          --(x14 * x14 * x23 * x23) -\r
  23          x13 * x13 * x24 * x24 -\r
  24          x12 * x12 * x34 * x34 +\r
  25          &2 *\r
  26          (x12 * x14 * x23 * x34 +\r
  27           x12 * x13 * x24 * x34 +\r
  28           x13 * x14 * x23 * x24) `;;\r
  29 let chi = new_definition ` chi x12 x13 x14 x23 x24 x34 =\r
  30          x13 * x23 * x24 +\r
  31          x14 * x23 * x24 +\r
  32          x12 * x23 * x34 +\r
  33          x14 * x23 * x34 +\r
  34          x12 * x24 * x34 +\r
  35          x13 * x24 * x34 -\r
  36          &2 * x23 * x24 * x34 -\r
  37          x12 * x34 * x34 -\r
  38          x14 * x23 * x23 -\r
  39          x13 * x24 * x24 `;;\r
  40 let delta = new_definition ` delta x12 x13 x14 x23 x24 x34 =\r
  41    --(x12 * x13 * x23) -\r
  42          x12 * x14 * x24 -\r
  43          x13 * x14 * x34 -\r
  44          x23 * x24 * x34 +\r
  45          x12 * x34 * (--x12 + x13 + x14 + x23 + x24 - x34) + \r
  46          x13 * x24 * (x12 - x13 + x14 + x23 - x24 + x34 ) +\r
  47          x14 * x23 * ( x12 + x13 - x14 - x23 + x24 + x34 ) `;;\r
  48 \r
  49 let eta_v = new_definition ` eta_v v1 v2 (v3: real^N) =\r
  50         let e1 = dist (v2, v3) in\r
  51           let e2 = dist (v1, v3) in\r
  52           let e3 = dist (v2, v1) in\r
  53           e1 * e2 * e3 / sqrt ( ups_x (e1 pow 2 ) ( e2 pow 2) ( e3 pow 2 ) ) `;;\r
  54 \r
  55 \r
  56 let max_real3 = new_definition ` max_real3 x y z = max_real (max_real x y ) z `;;\r
  57 let ups_x_pow2 = new_definition` ups_x_pow2 x y z = ups_x ( x*x ) ( y * y) ( z * z)`;;\r
  58 let plane_norm = new_definition `\r
  59   plane_norm p <=>\r
  60          (?n v0. ~(n = vec 0) /\ p = {v | n dot (v - v0) = &0}) `;;\r
  61 \r
  62 \r
  63 let delta_x34 = new_definition ` delta_x34 x12 x13 x14 x23 x24 x34  = \r
  64 -- &2 * x12 * x34 + \r
  65 (--x13 * x14 +\r
  66       --x23 * x24 +\r
  67       x13 * x24 +\r
  68       x14 * x23 +\r
  69       --x12 * x12 +\r
  70       x12 * x14 +\r
  71       x12 * x24 +\r
  72       x12 * x13 +\r
  73       x12 * x23) `;;\r
  74 \r
  75 \r
  76 let plane_3p = new_definition `plane_3p (a:real^3) b c =\r
  77          {x | ~collinear {a, b, c} /\\r
  78               (?ta tb tc. ta + tb + tc = &1 /\ x = ta % a + tb % b + tc % c)}`;;\r
  79 \r
  80 \r
  81 (* end new_definition *)\r
  82 \r
  83 (* NGUYEN DUC PHUONG *)\r
  84 (* Definition of Cayley  Menger square cm3 *)\r
  85 let cm3_ups_x = new_definition `!(v1:real^3) (v2:real^3) (v3:real^3).\r
  86    cm3_ups_x v1 v2 v3 = \r
  87   (((v2 - v1)$2 * (v3 - v1)$3 ) - ((v2 - v1)$3 * (v3 - v1)$2)) pow 2 +\r
  88   (((v2 - v1)$3 * (v3 - v1)$1 ) - ((v2 - v1)$1 * (v3 - v1)$3)) pow 2 +\r
  89   (((v2 - v1)$1 * (v3 - v1)$2 ) - ((v2 - v1)$2 * (v3 - v1)$1)) pow 2 `;;\r
  90 \r
  91 (* Nguyen Tuyen Hoang, Nguyen Duc Phuong *)\r
  92 \r
  93 (* The polynomial ups can be expressed as a Cayley- Menger square *)  \r
  94 \r
  95 let lemma_cm3 = prove (`!(x:real^3) y. \r
  96 (x-y)$1 = x$1 - y$1 /\ (x-y)$2 = x$2 - y$2 /\ (x-y)$3 = x$3 - y$3`, \r
  97 \r
  98 (REPEAT GEN_TAC) THEN (REPEAT CONJ_TAC) THENL \r
  99 [(MESON_TAC[VECTOR_SUB_COMPONENT;DIMINDEX_3;ARITH_RULE `1 <= 1 /\ 1 <= 3`]);\r
 100 (MESON_TAC[VECTOR_SUB_COMPONENT;DIMINDEX_3;ARITH_RULE `1 <= 2 /\ 2 <= 3`]);\r
 101 (MESON_TAC[VECTOR_SUB_COMPONENT;DIMINDEX_3;ARITH_RULE `1 <= 3 /\ 3 <= 3`])]);;\r
 102 \r
 103 let lemma7 = prove ( `! (v1 : real ^3)(v2: real^3)(v3:real^3).\r
 104   cm3_ups_x v1 v2 v3 = \r
 105   ups_x (norm (v1 -v2) pow 2) (norm (v2 -v3) pow 2) (norm (v3 -v1) pow 2) / &4`,\r
 106 \r
 107  (REPEAT GEN_TAC) THEN\r
 108  (REWRITE_TAC[cm3_ups_x; ups_x]) THEN\r
 109  (REWRITE_TAC[GSYM DOT_SQUARE_NORM;DOT_3;REAL_POW_2]) THEN\r
 110  (REWRITE_TAC[lemma_cm3]) THEN\r
 111   REAL_ARITH_TAC );;\r
 112 \r
 113 let pow_g = prove ( `! (x:real). &0 <= x pow 2`,\r
 114   GEN_TAC THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]);;\r
 115 \r
 116 let lemma8 = prove ( `! (v1:real^3)(v2:real^3)(v3:real^3). \r
 117 &0 <= ups_x (norm (v1 - v2) pow 2)(norm (v2 - v3) pow 2)(norm (v3 - v1) pow 2)`,\r
 118  (REPEAT GEN_TAC)\r
 119 THEN (MATCH_MP_TAC (REAL_ARITH `&0 <= a/ &4 ==> &0 <= a `))\r
 120 THEN (REWRITE_TAC[GSYM lemma7])\r
 121 THEN (REWRITE_TAC[cm3_ups_x])\r
 122 \r
 123 THEN (ABBREV_TAC `(a:real) = (((v2:real^3) - v1)$2 * (v3 - v1)$3 - (v2 - v1)$3 * (v3 - v1)$2) pow 2`)\r
 124 THEN (FIRST_X_ASSUM ((LABEL_TAC "1") o GSYM))\r
 125 THEN (ABBREV_TAC `(b:real) = (((v2:real^3) - v1)$3 * (v3 - v1)$1 - (v2 - v1)$1 * (v3 - v1)$3) pow 2`)\r
 126 THEN (FIRST_X_ASSUM((LABEL_TAC "2") o GSYM))\r
 127 THEN (ABBREV_TAC `(c:real) = (((v2:real^3) - v1)$1 * (v3 - v1)$2 - (v2 - v1)$2 * (v3 - v1)$1) pow 2`)\r
 128 THEN (FIRST_X_ASSUM((LABEL_TAC "3") o GSYM))\r
 129 \r
 130 THEN (MATCH_MP_TAC (SPEC_ALL REAL_LE_ADD))\r
 131 THEN CONJ_TAC\r
 132 THEN (ASM_REWRITE_TAC[pow_g])\r
 133 THEN (MATCH_MP_TAC (SPEC_ALL REAL_LE_ADD))\r
 134 THEN CONJ_TAC\r
 135 THEN (ASM_REWRITE_TAC[pow_g]));;\r
 136 \r
 137 (* ========== *)\r
 138 (* QUANG TRUONG *)\r
 139 (* ============ *)\r
 140 let GONTONG = REAL_RING ` ((a + b) + c = a + b + c ) `;;\r
 141 let SUB_SUM_SUB = REAL_RING ` (a - ( b + c ) = a - b - c )/\( a - (b- c) = a - b + c )` ;;\r
 142 \r
 143 (* lemma 4, p 7 *)\r
 144 let JVUNDLC = prove(`!a b c s.\r
 145      s = (a + b + c) / &2\r
 146      ==> &16 * s * (s - a) * (s - b) * (s - c) =\r
 147          ups_x (a pow 2) (b pow 2) (c pow 2)`, SIMP_TAC [ ups_x] THEN \r
 148 REWRITE_TAC[REAL_FIELD` a / &2 - b = ( a - &2 * b ) / &2 `] THEN \r
 149 REWRITE_TAC[REAL_FIELD ` &16 * ( a / &2 ) * ( b / &2 ) * (c / &2 ) *\r
 150 ( d / &2 ) = a * b * c * d `] THEN REAL_ARITH_TAC);;\r
 151 \r
 152 let SET_TAC =\r
 153    let basicthms =\r
 154     [NOT_IN_EMPTY; IN_UNIV; IN_UNION; IN_INTER; IN_DIFF; IN_INSERT;\r
 155      IN_DELETE; IN_REST; IN_INTERS; IN_UNIONS; IN_IMAGE] in\r
 156    let allthms = basicthms @ map (REWRITE_RULE[IN]) basicthms @\r
 157                  [IN_ELIM_THM; IN] in\r
 158    let PRESET_TAC =\r
 159      TRY(POP_ASSUM_LIST(MP_TAC o end_itlist CONJ)) THEN\r
 160      REPEAT COND_CASES_TAC THEN\r
 161      REWRITE_TAC[EXTENSION; SUBSET; PSUBSET; DISJOINT; SING] THEN\r
 162      REWRITE_TAC allthms in\r
 163    fun ths ->\r
 164      PRESET_TAC THEN\r
 165      (if ths = [] then ALL_TAC else MP_TAC(end_itlist CONJ ths)) THEN\r
 166      MESON_TAC[];;\r
 167 \r
 168  let SET_RULE tm = prove(tm,SET_TAC[]);;\r
 169 \r
 170 (* some TRUONG TACTICS *)\r
 171 \r
 172 let PHA = REWRITE_TAC[ MESON[] ` (a/\b)/\c <=> a/\ b /\ c `];;\r
 173 \r
 174 let NGOAC = REWRITE_TAC[ MESON[] ` a/\b/\c <=> (a/\b)/\c `];;\r
 175 \r
 176 let DAO = NGOAC THEN REWRITE_TAC[ MESON[]` a /\ b <=> b /\ a`];;\r
 177 \r
 178 let PHAT = REWRITE_TAC[ MESON[] ` (a\/b)\/c <=> a\/b\/c `];;\r
 179 \r
 180 let NGOACT =  REWRITE_TAC[ GSYM (MESON[] ` (a\/b)\/c <=> a\/b\/c `)];;\r
 181 \r
 182 let KHANANG = PHA THEN REWRITE_TAC[ MESON[]` ( a\/ b ) /\ c <=> a /\ c \/ b /\ c `] THEN \r
 183  REWRITE_TAC[ MESON[]` a /\ ( b \/ c ) <=> a /\ b \/ a /\ c `];;\r
 184 \r
 185 let ATTACH thm = MATCH_MP (MESON[]` ! a b. ( a ==> b ) ==> ( a <=> a /\ b )`) thm;;\r
 186 \r
 187 let NHANH tm = ONCE_REWRITE_TAC[ ATTACH (tm)];;\r
 188 let STRIP_TR = REPEAT STRIP_TAC THEN REPEAT (FIRST_X_ASSUM MP_TAC)\r
 189       THEN REWRITE_TAC[IMP_IMP] THEN PHA;;\r
 190 \r
 191 \r
 192 let elimin = REWRITE_RULE[IN];;\r
 193 \r
 194 let CONV_EM = prove(`conv {} = {}:real^A->bool`,\r
 195   REWRITE_TAC[conv;sgn_ge;affsign;UNION_EMPTY;FUN_EQ_THM;elimin\r
 196 NOT_IN_EMPTY;lin_combo;SUM_CLAUSES]\r
 197   THEN REAL_ARITH_TAC);;\r
 198 \r
 199 let CONV_SING = prove(`!u. conv {u:real^A} = {u}`,\r
 200  REWRITE_TAC[conv;sgn_ge;affsign;FUN_EQ_THM;UNION_EMPTY;lin_combo;SUM_SING;VSUM_SING;\r
 201  elimin IN_SING] THEN REPEAT GEN_TAC THEN\r
 202  REWRITE_TAC[TAUT `(p <=> q) = ((p ==> q) /\ (q ==> p))`] THEN\r
 203  REPEAT STRIP_TAC THENL [ASM_MESON_TAC[VECTOR_MUL_LID];\r
 204  ASM_REWRITE_TAC[]] THEN EXISTS_TAC `\ (v:real^A). &1` THEN\r
 205  MESON_TAC[VECTOR_MUL_LID;REAL_ARITH `&0 <= &1`] );;\r
 206 \r
 207 let IN_ACT_SING = SET_RULE `! a x. ({a} x <=> a = x ) /\ ( x IN {a} <=> x = a) /\ {a} a`;;\r
 208 \r
 209 let IN_SET2 = SET_RULE `!a b x.\r
 210          (x IN {a, b} <=> x = a \/ x = b) /\ ({a, b} x <=> x = a \/ x = b)`;;\r
 211 \r
 212 let SUM_DIS2 = prove(`! x y f. ~(x=y) ==> sum {x,y} f = f x + f y `,REWRITE_TAC[\r
 213    SET_RULE ` ~( x = y)\r
 214  <=> ~(x IN {y})`] THEN MESON_TAC[ FINITE_RULES; SUM_CLAUSES; SUM_SING]);;\r
 215 \r
 216 \r
 217 let VSUM_DIS2 = prove(` ! x y f. ~(x=y) ==>  vsum {x,y} f = f x + f y`, REWRITE_TAC[\r
 218    SET_RULE ` ~( x = y)\r
 219  <=> ~(x IN {y})`] THEN MESON_TAC[ FINITE_RULES; VSUM_CLAUSES; VSUM_SING]);;\r
 220 \r
 221 let NOV10 = prove(` ! x y. (x = y\r
 222       ==> (!x. y = x <=>\r
 223                (?a b. &0 <= a /\ &0 <= b /\ a + b = &1 /\ x = a % y + b % y))) `,\r
 224 REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB] THEN \r
 225 REWRITE_TAC[ MESON[VECTOR_MUL_LID]` a + b = &1 /\ x = (a + b) % y <=> a + b = &1 /\ \r
 226 x = y`]THEN REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN NGOAC THEN \r
 227 REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN MATCH_MP_TAC (MESON[]` a ==> ( x = y <=> a /\\r
 228  y = x )`)THEN EXISTS_TAC `&0` THEN EXISTS_TAC ` &1` THEN REAL_ARITH_TAC);;\r
 229 \r
 230 \r
 231 let TRUONG_LEMMA = prove\r
 232   (  `!x y x':real^N.\r
 233        (?f. x' = f x % x + f y % y /\ (&0 <= f x /\ &0 <= f y) /\\r
 234             f x + f y = &1) <=>\r
 235        (?a b. &0 <= a /\ &0 <= b /\ a + b = &1 /\ x' = a % x + b % y)`   ,\r
 236    REPEAT GEN_TAC THEN EQ_TAC \r
 237 THENL [MESON_TAC[]; STRIP_TAC] THEN\r
 238    ASM_CASES_TAC `y:real^N = x` THENL\r
 239     [EXISTS_TAC `\x:real^N. &1 / &2`;\r
 240      EXISTS_TAC `\u:real^N. if u = x then (a:real) else b`] THEN\r
 241    ASM_REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB] THEN\r
 242    CONV_TAC REAL_RAT_REDUCE_CONV);;\r
 243 \r
 244 let CONV_SET2 = prove(` ! x y:real^A. conv {x,y} = {w | ? a b. &0 <= a /\ &0 <= b /\ a + b = &1 /\\r
 245   w = a%x + b%y}`,\r
 246 ONCE_REWRITE_TAC[ MESON[] ` (! a b. P a b ) <=> ( ! a b. a = b \/ ~( a= b)\r
 247   ==> P a b )`] THEN \r
 248 REWRITE_TAC[ MESON[]` a \/ b ==> c <=> ( a==> c) /\ ( b==> c)`] THEN \r
 249 SIMP_TAC[] THEN REWRITE_TAC[ SET_RULE ` {a,a} = {a}`; CONV_SING; FUN_EQ_THM;\r
 250  IN_ELIM_THM] THEN REWRITE_TAC[ IN_ACT_SING] THEN REWRITE_TAC[NOV10] THEN \r
 251 REWRITE_TAC[conv; sgn_ge; affsign; lin_combo] THEN \r
 252 REWRITE_TAC[UNION_EMPTY; IN_SET2] THEN \r
 253 ONCE_REWRITE_TAC[ MESON[]`  ~(x = y) ==> (!x'. (?f. P f x') <=> l x') <=>\r
 254   ~(x = y) ==> (!x'. (?f. ~(x=y) /\ P f x') <=> l x')`] THEN \r
 255 REWRITE_TAC[ MESON[VSUM_DIS2; SUM_DIS2]` ~(x = y) /\x' = vsum {x, y} ff /\ l /\ \r
 256 sum {x, y} f = &1 <=> ~(x = y) /\ x' = ff x + ff y /\ l /\ f x + f y = &1 `] THEN \r
 257 REWRITE_TAC[ MESON[]` (!w. w = x \/ w = y ==> &0 <= f w) <=> &0 <= f x /\ &0 <= f y`] \r
 258 THEN ONCE_REWRITE_TAC[ GSYM (MESON[]`  ~(x = y) ==> (!x'. (?f. P f x') <=> l x') <=>\r
 259   ~(x = y) ==> (!x'. (?f. ~(x=y) /\ P f x') <=> l x')`)] THEN \r
 260 REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[ TRUONG_LEMMA]);;\r
 261 \r
 262 let LE_OF_ZPGPXNN = prove(` ! a b v v1 v2 . &0 <= a /\ &0 <= b /\ a + b = &1 /\\r
 263  v = a % v1 + b % v2  ==> dist ( v,v1) + dist (v,v2) = dist(v1,v2)`, \r
 264 SIMP_TAC[dist; REAL_ARITH ` a + b = &1 <=> b = &1 - a `] THEN \r
 265 REWRITE_TAC[VECTOR_ARITH ` (a % v1 + (&1 - a) % v2) - v1 = ( a - &1 )%( v1 - v2)`] THEN \r
 266 REWRITE_TAC[VECTOR_ARITH` (a % v1 + (&1 - a) % v2) - v2 = a % ( v1 - v2) `] THEN \r
 267 SIMP_TAC[NORM_MUL; GSYM REAL_ABS_REFL] THEN REWRITE_TAC[ REAL_ARITH ` abs ( a - &1 )\r
 268  = abs ( &1 - a ) `] THEN REAL_ARITH_TAC);;\r
 269 \r
 270 let LENGTH_EQUA = prove(` ! v v1 v2. v IN conv {v1,v2} ==> dist (v,v1) + \r
 271  dist (v,v2) = dist (v1,v2) `,REWRITE_TAC[CONV_SET2; IN_ELIM_THM] THEN \r
 272 MESON_TAC[LE_OF_ZPGPXNN]);;\r
 273 \r
 274 let simp_def2 = new_axiom`(!a b v0.\r
 275           aff_gt {a, b} {v0} =\r
 276           {x | ?ta tb t.\r
 277                    ta + tb + t = &1 /\ &0 < t /\ x = ta % a + tb % b + t % v0} /\\r
 278           aff_ge {a, b} {v0} =\r
 279           {x | ?ta tb t.\r
 280                    ta + tb + t = &1 /\\r
 281                    &0 <= t /\\r
 282                    x = ta % a + tb % b + t % v0}) /\\r
 283      (!x y z.\r
 284           conv0 {x, y, z} =\r
 285           {t | ?a b c.\r
 286                    a + b + c = &1 /\\r
 287                    &0 < a /\\r
 288                    &0 < b /\\r
 289                    &0 < c /\\r
 290                    t = a % x + b % y + c % z}) /\\r
 291      (!x y z.\r
 292           affine hull {x, y, z} =\r
 293           {t | ?a b c. a + b + c = &1 /\ t = a % x + b % y + c % z})/\\r
 294  (!v1 v2 v3.\r
 295           aff_lt {v2, v3} {v1} =\r
 296           {x | ?t2 t3 t1.\r
 297                    t2 + t3 + t1 = &1 /\\r
 298                    t1 < &0 /\\r
 299                    x = t2 % v2 + t3 % v3 + t1 % v1}) `;;\r
 300 \r
 301 (* lemma 10. p 14 *)\r
 302 let ZPGPXNN = prove(`!v1 v2 v. dist (v1,v2) < dist (v,v1) + dist (v,v2) ==> \r
 303  ~(v IN conv {v1, v2})`,\r
 304 REWRITE_TAC[MESON[] `a ==> ~ b <=> ~(a /\ b )`] THEN REWRITE_TAC[CONV_SET2; IN_ELIM_THM]\r
 305 THEN MESON_TAC[LE_OF_ZPGPXNN; REAL_ARITH ` a < b ==> ~ ( a = b ) `]);;\r
 306 \r
 307 let REDUCE_T2 = MESON[]` !P Q.\r
 308      (!v1 v2 v3 t1 t2 t3. P v1 t1 v2 t2 v3 t3 <=> P v2 t2 v1 t1 v3 t3) /\\r
 309      (!v1 v2 v3. Q v1 v2 v3 <=> Q v2 v1 v3) /\\r
 310      (!v1 v2 v3 t1 t2 t3.\r
 311           ~(t1 = &0 /\ t3 = &0) /\ P v1 t1 v2 t2 v3 t3 ==> Q v1 v2 v3)\r
 312      ==> (!v1 v2 v3 t1 t2 t3.\r
 313               ~(t1 = &0 /\ t2 = &0 /\ t3 = &0) /\ P v1 t1 v2 t2 v3 t3\r
 314               ==> Q v1 v2 v3)`;;\r
 315 \r
 316 let VEC_PER2_3 = VECTOR_ARITH `((a:real^N ) + b + c = b + a + c)/\\r
 317    ( (a:real^N ) + b + c = c + b + a )`;;\r
 318 let PER2_IN3 = SET_RULE `  {a,b,c} = {b,a,c} /\ {a,b,c} = {c,b,a}`;;\r
 319 \r
 320 let REDUCE_T3 = MESON[]`!P Q.\r
 321      (!v1 v2 v3 t1 t2 t3. P v1 t1 v2 t2 v3 t3 <=> P v3 t3 v2 t2 v1 t1) /\\r
 322      (!v1 v2 v3. Q v1 v2 v3 <=> Q v3 v2 v1) /\\r
 323      (!v1 v2 v3 t1 t2 t3. ~(t1 = &0) /\ P v1 t1 v2 t2 v3 t3 ==> Q v1 v2 v3)\r
 324      ==> (!v1 v2 v3 t1 t2 t3.\r
 325               ~(t1 = &0 /\ t3 = &0) /\ P v1 t1 v2 t2 v3 t3 ==> Q v1 v2 v3)`;;\r
 326 \r
 327 \r
 328 let SUB_PACKING = prove(`!sub s.\r
 329      packing s /\ sub SUBSET s\r
 330      ==> (!x y. x IN sub /\ y IN sub /\ ~(x = y) ==> &2 <= d3 x y)`,\r
 331 REWRITE_TAC[ packing; GSYM d3] THEN SET_TAC[]);;\r
 332 \r
 333 \r
 334 let PAIR_EQ_EXPAND =\r
 335  SET_RULE `{a,b} = {c,d} <=> a = c /\ b = d \/ a = d /\ b = c`;;\r
 336 \r
 337 let IN_SET3 = SET_RULE ` x IN {a,b,c} <=> x = a \/ x = b \/ x = c `;;\r
 338 let IN_SET4 = SET_RULE ` x IN {a,b,c,d} <=> x = a \/ x = b \/ x = c \/ x = d `;;\r
 339 \r
 340 (* le 8. p 13 *)\r
 341 let SGFCDZO = prove(`! (v1:real^3) v2 v3 t1 t2 t3.\r
 342      t1 % v1 + t2 % v2 + t3 % v3 = vec 0 /\\r
 343      t1 + t2 + t3 = &0 /\\r
 344      ~(t1 = &0 /\ t2 = &0 /\ t3 = &0)\r
 345      ==> collinear {v1, v2, v3}`, \r
 346 ONCE_REWRITE_TAC[MESON[]` a /\ b/\c <=> c /\ a /\ b `] THEN \r
 347 MATCH_MP_TAC REDUCE_T2 THEN \r
 348 CONJ_TAC THENL [SIMP_TAC[VEC_PER2_3; REAL_ADD_AC]; CONJ_TAC THENL \r
 349   [SIMP_TAC[PER2_IN3]; MATCH_MP_TAC REDUCE_T3]] THEN \r
 350 CONJ_TAC THENL [SIMP_TAC[REAL_ADD_AC; VEC_PER2_3]; \r
 351 CONJ_TAC THENL [SIMP_TAC[PER2_IN3];  REWRITE_TAC[]]] THEN \r
 352 REPEAT GEN_TAC THEN REWRITE_TAC[collinear] THEN \r
 353 STRIP_TAC THEN EXISTS_TAC `v2 - (v3:real^3)` THEN \r
 354 ONCE_REWRITE_TAC[MESON[]` x IN s /\ y IN s <=> \r
 355   ( x = y \/ ~ ( x = y))/\ x IN s /\ y IN s `] THEN \r
 356 REWRITE_TAC[IN_SET3] THEN REPEAT GEN_TAC THEN \r
 357 REWRITE_TAC[MESON[]` (a \/ b) /\ c ==> d <=> (a /\ c ==> d) /\ (b /\ c ==> d)`] \r
 358 THEN CONJ_TAC THENL [DISCH_TAC THEN EXISTS_TAC `&0` THEN \r
 359 FIRST_X_ASSUM MP_TAC THEN MATCH_MP_TAC (MESON[]` (a ==> c) ==> a /\ b ==> c `) THEN \r
 360 MESON_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_EQ]; STRIP_TAC] THENL [\r
 361 \r
 362 ASM_MESON_TAC[] ;\r
 363 \r
 364 EXISTS_TAC ` t3  / t1 ` THEN ASM_SIMP_TAC[] THEN STRIP_TR THEN \r
 365 ONCE_REWRITE_TAC[MESON[VECTOR_MUL_LCANCEL]`\r
 366   ~(t1 = &0) /\ a ==> x = y <=> ~(t1 = &0) /\ a ==> t1 % x = t1 % y`] THEN \r
 367 REWRITE_TAC[VECTOR_MUL_ASSOC] THEN SIMP_TAC[REAL_DIV_LMUL] THEN \r
 368 ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN \r
 369 REWRITE_TAC[ VECTOR_ARITH ` ( a + b + (c:real^N) ) - vec 0 = vec 0 <=>\r
 370   a = -- ( b + c ) `; REAL_ARITH` a + b + c = &0 <=> a = -- ( b + c ) `] THEN \r
 371 SIMP_TAC[VECTOR_SUB_LDISTRIB] THEN \r
 372 MESON_TAC[VECTOR_ARITH ` --(t2 % v2 + t3 % v3) - --(t2 + t3) % v2 - \r
 373   (t3 % v2 - t3 % v3) = vec 0`]; \r
 374 \r
 375 EXISTS_TAC ` ( -- t2 ) / t1 ` THEN ASM_SIMP_TAC[] THEN STRIP_TR THEN \r
 376 ONCE_REWRITE_TAC[MESON[VECTOR_MUL_LCANCEL]`\r
 377   ~(t1 = &0) /\ a ==> x = y <=> ~(t1 = &0) /\ a ==> t1 % x = t1 % y`] THEN \r
 378 REWRITE_TAC[VECTOR_MUL_ASSOC] THEN SIMP_TAC[REAL_DIV_LMUL] THEN \r
 379 ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN \r
 380 REWRITE_TAC[ VECTOR_ARITH ` ( a + b + (c:real^N) ) - vec 0 = vec 0 <=>\r
 381   a = -- ( b + c ) `; REAL_ARITH` a + b + c = &0 <=> a = -- ( b + c ) `] THEN \r
 382 SIMP_TAC[VECTOR_SUB_LDISTRIB] THEN \r
 383 MESON_TAC[VECTOR_ARITH ` --(t2 % v2 + t3 % v3) - --(t2 + t3) % v3 - \r
 384  (--t2 % v2 - --t2 % v3) =  vec 0`];\r
 385 \r
 386 \r
 387 EXISTS_TAC ` ( -- t3) / t1 ` THEN ASM_SIMP_TAC[] THEN STRIP_TR THEN \r
 388 ONCE_REWRITE_TAC[MESON[VECTOR_MUL_LCANCEL]`\r
 389   ~(t1 = &0) /\ a ==> x = y <=> ~(t1 = &0) /\ a ==> t1 % x = t1 % y`] THEN \r
 390 REWRITE_TAC[VECTOR_MUL_ASSOC] THEN SIMP_TAC[REAL_DIV_LMUL] THEN \r
 391 ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN \r
 392 REWRITE_TAC[ VECTOR_ARITH ` ( a + b + (c:real^N) ) - vec 0 = vec 0 <=>\r
 393   a = -- ( b + c ) `; REAL_ARITH` a + b + c = &0 <=> a = -- ( b + c ) `] THEN \r
 394 SIMP_TAC[VECTOR_SUB_LDISTRIB] THEN MESON_TAC[VECTOR_ARITH ` --(t2 + t3) % v2 \r
 395 - --(t2 % v2 + t3 % v3) - (--t3 % v2 - --t3 % v3) = vec 0`];\r
 396 \r
 397 \r
 398 ASM_MESON_TAC[];\r
 399 \r
 400 \r
 401 EXISTS_TAC ` &1 ` THEN ASM_SIMP_TAC[VECTOR_MUL_LID];\r
 402 \r
 403 \r
 404 EXISTS_TAC ` t2 / t1 ` THEN ASM_SIMP_TAC[] THEN STRIP_TR THEN \r
 405 ONCE_REWRITE_TAC[MESON[VECTOR_MUL_LCANCEL]`\r
 406   ~(t1 = &0) /\ a ==> x = y <=> ~(t1 = &0) /\ a ==> t1 % x = t1 % y`] THEN \r
 407 REWRITE_TAC[VECTOR_MUL_ASSOC] THEN SIMP_TAC[REAL_DIV_LMUL] THEN \r
 408 ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN \r
 409 REWRITE_TAC[ VECTOR_ARITH ` ( a + b + (c:real^N) ) - vec 0 = vec 0 <=>\r
 410   a = -- ( b + c ) `; REAL_ARITH` a + b + c = &0 <=> a = -- ( b + c ) `] THEN \r
 411 SIMP_TAC[VECTOR_SUB_LDISTRIB] THEN \r
 412 MESON_TAC[VECTOR_ARITH ` --(t2 + t3) % v3 - --(t2 % v2 + t3 % v3) -\r
 413    (t2 % v2 - t2 % v3) = vec 0`];\r
 414 \r
 415 EXISTS_TAC ` -- &1 ` THEN ASM_MESON_TAC[VECTOR_ARITH ` v3 - v2 = -- &1 % (v2 - v3)`];\r
 416 \r
 417 \r
 418 ASM_MESON_TAC[]]);;\r
 419 \r
 420 \r
 421 (* le 2. p 6 *)\r
 422 let RHUFIIB = prove( ` !x12 x13 x14 x23 x24 x34.\r
 423          rho x12 x13 x14 x23 x24 x34 * ups_x x34 x24 x23 =\r
 424          chi x12 x13 x14 x23 x24 x34 pow 2 +\r
 425          &4 * delta x12 x13 x14 x23 x24 x34 * x34 * x24 * x23 `,\r
 426 REWRITE_TAC[rho; chi; delta; ups_x] THEN REAL_ARITH_TAC);;\r
 427 \r
 428 \r
 429 let RIGHT_END_POINT = prove( `!x aa bb.\r
 430      (?a b. &0 < a /\ b = &0 /\ a + b = &1 /\ x = a % aa + b % bb) <=> x = aa`,\r
 431 REPEAT GEN_TAC THEN EQ_TAC THENL [STRIP_TR THEN \r
 432 REWRITE_TAC[ MESON[REAL_ARITH `b = &0 /\ a + b = &1 <=> b= &0 /\ a = &1 `]`\r
 433    b = &0 /\ a + b = &1 /\ P a b  <=>  b = &0 /\ a = &1 /\ P (&1 ) ( &0 ) `] THEN \r
 434 MESON_TAC[VECTOR_ARITH ` &1 % aa + &0 % bb = aa `];\r
 435 DISCH_TAC  THEN EXISTS_TAC ` &1 ` THEN EXISTS_TAC ` &0 ` THEN \r
 436 REWRITE_TAC[REAL_ARITH ` &0 < &1 /\ &1 + &0 = &1 `] THEN \r
 437 ASM_MESON_TAC[VECTOR_ARITH ` &1 % aa + &0 % bb = aa `]]);;\r
 438 \r
 439 let LEFT_END_POINT = prove(` !x aa bb.\r
 440      (?a b. a = &0 /\ &0 < b /\ a + b = &1 /\ x = &0 % aa + &1 % bb)\r
 441   <=> x = bb `,\r
 442 REWRITE_TAC[VECTOR_ARITH ` &0 % aa + &1 % bb = bb `] THEN \r
 443 MESON_TAC[REAL_ARITH ` &0 = &0 /\ &0 < &1 /\ &0 + &1 = &1 `]);;\r
 444 \r
 445 \r
 446 let CONV_CONV0 = prove(`! x a b. x IN conv {a,b} <=> x = a \/ x = b \/ x IN conv0 {a,b} `,\r
 447 REWRITE_TAC[CONV_SET2; CONV0_SET2; IN_ELIM_THM] THEN \r
 448 REWRITE_TAC[REAL_ARITH ` &0 <= a <=> a = &0 \/ &0 < a `] THEN \r
 449 KHANANG THEN REWRITE_TAC[EXISTS_OR_THM] THEN \r
 450 SIMP_TAC[MESON[REAL_ARITH ` ~(a = &0 /\ b = &0 /\ a + b = &1)`]`\r
 451   ~(a = &0 /\ b = &0 /\ a + b = &1 /\ las )` ] THEN \r
 452 REWRITE_TAC[MESON[REAL_ARITH ` a = &0 /\ a + b = &1 <=> a = &0 /\ b = &1 `]`\r
 453   a = &0 /\ &0 < b /\ a + b = &1 /\ x = a % aa + b % ba <=>\r
 454      a = &0 /\ &0 < b /\ a + b = &1 /\ x = &0 % aa + &1 % ba`] THEN \r
 455 MESON_TAC[ RIGHT_END_POINT; LEFT_END_POINT]);;\r
 456 \r
 457 \r
 458 \r
 459 \r
 460 let CON3_SUB_CONE3 = prove(` ! w1 v1 v2 v3. conv {v1, v2, v3} SUBSET cone w1 {v1,v2,v3}`,\r
 461 REWRITE_TAC[CONV_SET3; cone; GSYM aff_ge_def; simp_def] THEN \r
 462 REWRITE_TAC[ SET_RULE ` {x | p x} SUBSET {x | q x} <=> ( ! x. p x ==> q x)`] THEN \r
 463 MESON_TAC[ REAL_ARITH ` &0 + a = a `; VECTOR_ARITH ` &0 % x + y = y `]);;\r
 464 \r
 465 \r
 466 \r
 467 let QHSEWMI = prove (` !v1 v2 v3 w1 w2.\r
 468          ~(conv {w1, w2} INTER conv {v1, v2, v3} = {}) /\\r
 469          ~(w1 IN conv {v1, v2, v3})\r
 470          ==> w2 IN cone w1 {v1, v2, v3}`,\r
 471 REWRITE_TAC[INTER_DIF_EM_EX] THEN REPEAT GEN_TAC THEN REWRITE_TAC[CONV_CONV0] THEN \r
 472 STRIP_TAC THENL [ASM_MESON_TAC[]; \r
 473 ASM_MESON_TAC[CON3_SUB_CONE3;SET_RULE`a SUBSET b <=> (! x. x IN a ==> x IN b )`];\r
 474 ASM_MESON_TAC[REWRITE_RULE[INTER_DIF_EM_EX] AFF_LE_CONE ]]);;\r
 475 \r
 476 \r
 477 let GONTONG = REWRITE_TAC[REAL_ARITH ` ( a + b ) + c = a + b + c `];;\r
 478 \r
 479 (* le 27. p 20 *)\r
 480 let MAEWNPU = prove(` ?b c.\r
 481          !x12 x13 x14 x23 x24 x34.\r
 482              delta x12 x13 x14 x23 x24 x34 =\r
 483              --x12 * x34 pow 2 +\r
 484              b x12 x13 x14 x23 x24 * x34 +\r
 485              c x12 x13 x14 x23 x24 `,\r
 486 REWRITE_TAC[delta; REAL_ARITH ` a - b = a + -- b `; \r
 487   REAL_ARITH ` a * (b + c )= a * b + a * c ` ] THEN \r
 488 REWRITE_TAC[REAL_ARITH ` a * b * -- c = -- a * b * c /\ -- ( a * b ) = -- a * b `] THEN \r
 489 REWRITE_TAC[REAL_ARITH` x12 * x34 * x23 + x12 * x34 * x24 +\r
 490    --x12 * x34 * x34 = x12 * x34 * x23 + x12 * x34 * x24 +\r
 491    -- x12 * ( x34 pow 2 )  `] THEN \r
 492 REWRITE_TAC[REAL_ARITH ` ( a + b ) + c = a + b + c `] THEN \r
 493 REWRITE_TAC[REAL_ARITH ` a + b * c pow 2 + d = b * c pow 2 + a + d `] THEN \r
 494 ONCE_REWRITE_TAC[REAL_ARITH `a + b + c + d + e = a + d + b + c + e `] THEN \r
 495 REWRITE_TAC[REAL_ARITH ` a * b * c = ( a * b ) * c `] THEN \r
 496 REPLICATE_TAC 30 ( ONCE_REWRITE_TAC[REAL_ARITH ` a * x pow 2 + b * x + d + e\r
 497   = a * x pow 2 + b * x + e + d `] THEN GONTONG THEN REWRITE_TAC[ REAL_ARITH \r
 498  ` a * x pow 2 + b * x + d * x  + e = a * x pow 2 + ( b  +  d)  * x  + e`]) THEN \r
 499 REPLICATE_TAC 50 ( ONCE_REWRITE_TAC[REAL_ARITH ` a * x pow 2 + b * x + d + e\r
 500   = a * x pow 2 + b * x + e + d `] THEN GONTONG THEN ONCE_REWRITE_TAC[ REAL_ARITH ` a * x pow 2 + b * x + (d * x) * h  + e\r
 501  = a * x pow 2 + ( b  +  d * h )  * x  + e`]) THEN \r
 502 EXISTS_TAC ` (\ x12 x13 x14 x23 x24. --x13 * x14 +\r
 503           --x23 * x24 +\r
 504           x13 * x24 +\r
 505           x14 * x23 +\r
 506           --x12 * x12 +\r
 507           x12 * x14 +\r
 508           x12 * x24 +\r
 509           x12 * x13 +\r
 510           x12 * x23 ) ` THEN \r
 511 EXISTS_TAC ` (\ x12 x13 x14 x23 x24. (x14 * x23) * x12 +\r
 512          (x14 * x23) * x13 +\r
 513          (--x14 * x23) * x14 +\r
 514          (--x14 * x23) * x23 +\r
 515          (x14 * x23) * x24 +\r
 516          (--x12 * x13) * x23 +\r
 517          (--x12 * x14) * x24 +\r
 518          (x13 * x24) * x12 +\r
 519          (--x13 * x24) * x13 +\r
 520          (x13 * x24) * x14 +\r
 521          (x13 * x24) * x23 +\r
 522          (--x13 * x24) * x24 ) ` THEN \r
 523 SIMP_TAC[]);;\r
 524 \r
 525 (* ----new ------- *)\r
 526 \r
 527 let DELTA_COEFS = new_specification ["b_coef"; "c_coef"] MAEWNPU;;\r
 528 \r
 529 \r
 530 let DELTA_X34 = prove(` !x12 x13 x14 x23 x24 x34.\r
 531      delta x12 x13 x14 x23 x24 x34 =\r
 532      --x12 * x34 pow 2 +\r
 533      (--x13 * x14 +\r
 534       --x23 * x24 +\r
 535       x13 * x24 +\r
 536       x14 * x23 +\r
 537       --x12 * x12 +\r
 538       x12 * x14 +\r
 539       x12 * x24 +\r
 540       x12 * x13 +\r
 541       x12 * x23) *\r
 542      x34 +\r
 543      (x14 * x23) * x12 +\r
 544      (x14 * x23) * x13 +\r
 545      (--x14 * x23) * x14 +\r
 546      (--x14 * x23) * x23 +\r
 547      (x14 * x23) * x24 +\r
 548      (--x12 * x13) * x23 +\r
 549      (--x12 * x14) * x24 +\r
 550      (x13 * x24) * x12 +\r
 551      (--x13 * x24) * x13 +\r
 552      (x13 * x24) * x14 +\r
 553      (x13 * x24) * x23 +\r
 554      (--x13 * x24) * x24`, REWRITE_TAC[delta] THEN REAL_ARITH_TAC);;\r
 555 \r
 556 let C_COEF_FORMULA = prove(`! x12 x13 x14 x23 x24. c_coef x12 x13 x14 x23 x24\r
 557   = (x14 * x23) * x12 +\r
 558          (x14 * x23) * x13 +\r
 559          (--x14 * x23) * x14 +\r
 560          (--x14 * x23) * x23 +\r
 561          (x14 * x23) * x24 +\r
 562          (--x12 * x13) * x23 +\r
 563          (--x12 * x14) * x24 +\r
 564          (x13 * x24) * x12 +\r
 565          (--x13 * x24) * x13 +\r
 566          (x13 * x24) * x14 +\r
 567          (x13 * x24) * x23 +\r
 568          (--x13 * x24) * x24`, MP_TAC DELTA_COEFS THEN \r
 569 NHANH (MESON[]` (!x12 x13 x14 x23 x24 x34. p x12 x13 x14 x23 x24 x34)\r
 570   ==> (! x12 x13 x14 x23 x24. p x12 x13 x14 x23 x24 (&0) ) `) THEN \r
 571 REWRITE_TAC[DELTA_X34] THEN \r
 572 REWRITE_TAC[REAL_ARITH ` &0 pow 2 = &0 `; REAL_MUL_RZERO; REAL_ADD_LID] THEN \r
 573 SIMP_TAC[]);;\r
 574 \r
 575 let BC_DEL_FOR = prove(` ! x12 x13 x14 x23 x24. b_coef x12 x13 x14 x23 x24 =\r
 576   --x13 * x14 +\r
 577           --x23 * x24 +\r
 578           x13 * x24 +\r
 579           x14 * x23 +\r
 580           --x12 * x12 +\r
 581           x12 * x14 +\r
 582           x12 * x24 +\r
 583           x12 * x13 +\r
 584           x12 * x23 /\ \r
 585   c_coef x12 x13 x14 x23 x24 =\r
 586          (x14 * x23) * x12 +\r
 587          (x14 * x23) * x13 +\r
 588          (--x14 * x23) * x14 +\r
 589          (--x14 * x23) * x23 +\r
 590          (x14 * x23) * x24 +\r
 591          (--x12 * x13) * x23 +\r
 592          (--x12 * x14) * x24 +\r
 593          (x13 * x24) * x12 +\r
 594          (--x13 * x24) * x13 +\r
 595          (x13 * x24) * x14 +\r
 596          (x13 * x24) * x23 +\r
 597          (--x13 * x24) * x24 `, REWRITE_TAC[C_COEF_FORMULA] THEN \r
 598 MP_TAC DELTA_COEFS THEN NHANH (MESON[]` (!x12 x13 x14 x23 x24 x34. \r
 599 p x12 x13 x14 x23 x24 x34)\r
 600   ==> (! x12 x13 x14 x23 x24. p x12 x13 x14 x23 x24 (&1) ) `) THEN \r
 601 REWRITE_TAC[DELTA_X34; C_COEF_FORMULA] THEN \r
 602 REWRITE_TAC[REAL_ARITH ` a + b + c = a + b' + c <=> b = b' `] THEN \r
 603 SIMP_TAC[REAL_RING` a * &1 = a `]);;\r
 604 \r
 605 let AGBWHRD = prove(` !x12 x13 x14 x23 x24 x12 x13 x14 x23 x24.\r
 606          b_coef x12 x13 x14 x23 x24 pow 2 +\r
 607          &4 * x12 * c_coef x12 x13 x14 x23 x24 =\r
 608          ups_x x12 x23 x13 * ups_x x12 x24 x14`, REWRITE_TAC[BC_DEL_FOR; ups_x] THEN \r
 609 REAL_ARITH_TAC);;\r
 610 \r
 611 \r
 612 let COLLINEAR_EX = prove(` ! x y (z:real^3) . collinear {x,y,z} <=> ( ? a b c. a + b + c = &0 /\ ~ ( a = &0 /\\r
 613 b = &0 /\ c = &0 ) /\ a % x + b % y + c % z = vec 0 ) `,\r
 614 REWRITE_TAC[collinear] THEN \r
 615 REPEAT GEN_TAC THEN \r
 616 STRIP_TR THEN \r
 617 EQ_TAC THENL [\r
 618 NHANH (SET_RULE` (!x' y'. x' IN {x, y, z} /\ y' IN {x, y, z} ==> P x' y' )\r
 619     ==> P x y /\ P x z `) THEN \r
 620 STRIP_TR THEN \r
 621 DISJ_CASES_TAC (MESON[]` c = &0 /\ c' = &0 \/ ~( c = &0 /\ c' = &0  ) `) THENL [\r
 622 ASM_SIMP_TAC[VECTOR_ARITH ` x - y = &0 % t <=> y = x`] THEN \r
 623 DISCH_TAC THEN \r
 624 EXISTS_TAC ` &1 ` THEN EXISTS_TAC ` &1 ` THEN \r
 625 EXISTS_TAC ` -- &2 ` THEN \r
 626 REWRITE_TAC[REAL_ARITH ` &1 + &1 + -- &2 = &0 /\\r
 627  ~(&1 = &0 /\ &1 = &0 /\ -- &2 = &0)`; VECTOR_ARITH` &1 % x + &1 % x + \r
 628   -- &2 % x = vec 0`];\r
 629 \r
 630 \r
 631 \r
 632 NHANH (MESON[VECTOR_MUL_LCANCEL]` x = c % u /\\r
 633   y  = c' % u ==> c' % x = c' % (c % u) /\ c % y = c % c' % u `) THEN \r
 634 REWRITE_TAC[VECTOR_ARITH ` x = c' % c % u /\ y = c % c' % u <=>\r
 635    x = y /\ y = c % c' % u`] THEN \r
 636 REWRITE_TAC[VECTOR_ARITH ` c' % (x - y) = c % (x - z) <=> (c - c' ) % x + c' % y +\r
 637   -- c % z = vec 0 `] THEN \r
 638 ASM_MESON_TAC[REAL_ARITH ` (( c - b ) + b + -- c = &0 ) /\ (~( c = &0 ) \r
 639    <=> ~( -- c = &0 ))`]];REWRITE_TAC[GSYM collinear] THEN MESON_TAC[SGFCDZO]]);;\r
 640 \r
 641 \r
 642 let MAX_REAL_LESS_EX = prove(`!x y a. max_real x y <= a <=> x <= a /\ y <= a`,\r
 643 REWRITE_TAC[max_real; COND_EXPAND; COND_ELIM_THM;COND_RAND; COND_RATOR] THEN \r
 644 REPEAT GEN_TAC THEN \r
 645 MESON_TAC[REAL_ARITH ` (~ ( b < a ) /\ b <= c ==> a <= c)`;  REAL_ARITH ` a < b /\ b <= c ==> a <= c `]);;\r
 646 \r
 647 \r
 648 let MAX_REAL3_LESS_EX = prove(`! x y z a. max_real3 x y z <= a <=> x <= a /\ \r
 649 y <= a /\ z <= a `, REWRITE_TAC[max_real3; MAX_REAL_LESS_EX] THEN MESON_TAC[]);;\r
 650 \r
 651 \r
 652 MESON[]` (!x y z.\r
 653           (P x y z <=> P y x z) /\\r
 654           (P x y z <=> P x z y) /\\r
 655           (Q x y z <=> Q y x z) /\\r
 656           (Q x y z <=> Q x z y)) /\\r
 657      (!x y z. P x y z ==> Q x y z)\r
 658      ==> (!x y z. P x y z ==> Q x y z /\ Q y x z /\ Q z x y)`;;\r
 659 (* ========== *)\r
 660 \r
 661 let UPS_X_SYM = prove(` ! x y z. ups_x x y z = ups_x y x z /\\r
 662   ups_x x y z = ups_x x z y `, REWRITE_TAC[ups_x] THEN REAL_ARITH_TAC);;\r
 663 \r
 664 let PER_MUL3 = REAL_ARITH ` a*b*c = b * a * c /\ a *b *c = a * c * b `;;\r
 665 \r
 666 let ETA_X_SYM = prove(` ! x y z. &0 <= x /\ &0 <= y /\ &0 <= z /\ &0 <= ups_x x y z ==>\r
 667   eta_x x y z = eta_x y x z /\ eta_x x y z = eta_x x z y `,\r
 668 REWRITE_TAC[eta_x] THEN \r
 669 NHANH (MESON[UPS_X_SYM]` &0 <= ups_x x y z ==> &0 <= ups_x y x z \r
 670   /\ &0 <= ups_x x z y `) THEN \r
 671 NHANH (MESON[REAL_LE_MUL]`&0 <= x /\ &0 <= y /\ &0 <= z /\ las ==> \r
 672   &0 <= x * y * z`) THEN \r
 673 PHA THEN NHANH (MESON[REAL_LE_DIV; REAL_ARITH ` a * b * c = b * a * c \r
 674   /\ a * b * c = a * c * b `]`\r
 675   &0 <= ups_x x y z /\ &0 <= aa /\ &0 <= bb /\ &0 <= x * y * z\r
 676      ==> &0 <= (x * y * z) / ups_x x y z /\\r
 677          &0 <= (y * x * z) / aa /\\r
 678          &0 <= (x * z * y) / bb`) THEN \r
 679 SIMP_TAC[SQRT_INJ] THEN \r
 680 MESON_TAC[UPS_X_SYM; PER_MUL3]);;\r
 681 \r
 682 let ETA_Y_SYM = prove(` ! x y z. &0 <= ups_x (x * x) (y * y) (z * z) ==>\r
 683   eta_y x y z = eta_y y x z /\ eta_y x y z = eta_y x z y `,\r
 684 REWRITE_TAC[eta_y] THEN REPEAT LET_TAC THEN MESON_TAC[ETA_X_SYM; REAL_LE_SQUARE]);;\r
 685 \r
 686 \r
 687 \r
 688 let ETA_Y_SYMM = MESON[UPS_X_SYM; ETA_Y_SYM]` ! x y z. &0 <= ups_x (x * x) (y * y) (z * z)\r
 689    ==> eta_y x y z = eta_y x z y /\\r
 690          eta_y x y z = eta_y y x z /\\r
 691          eta_y x y z = eta_y z x y /\\r
 692          eta_y x y z = eta_y y z x /\\r
 693          eta_y x y z = eta_y z y x`;;\r
 694 \r
 695 \r
 696 let IMPLY_POS = prove(`! x y z . &0 <= ups_x (x * x) (y * y) (z * z) ==>\r
 697   &0 <= ((z * z) * (x * x) * y * y) / ups_x (z * z) (x * x) (y * y) /\ \r
 698   &0 <= ((x * x) * (y * y) * z * z) / ups_x (x * x) (y * y) (z * z) /\\r
 699   &0 <= ((y * y) * (z * z) * x * x) / ups_x (y * y) (z * z) (x * x) `, MP_TAC\r
 700  REAL_LE_SQUARE THEN MP_TAC REAL_LE_MUL THEN MESON_TAC[UPS_X_SYM; REAL_LE_DIV]);;\r
 701 \r
 702 let POW2_COND = MESON[REAL_ABS_REFL; REAL_LE_SQUARE_ABS]` ! a b. &0 <= a /\ &0 <= b ==> \r
 703 ( a <= b <=> a pow 2 <= b pow 2 ) `;;\r
 704 \r
 705 \r
 706 let TRUONGG = prove(`! x y z. &0 < ups_x_pow2 z x y ==> \r
 707  ((z * z) * (x * x) * y * y) / ups_x (z * z) (x * x) (y * y) -\r
 708     z pow 2 / &4 = ( z pow 2 * (( z pow 2 - x pow 2 - y pow 2 ) pow 2 )) \r
 709    / (&4 * ups_x_pow2 z x y )`,\r
 710 REWRITE_TAC[ups_x; ups_x_pow2] THEN CONV_TAC REAL_FIELD);;\r
 711 \r
 712 let RE_TRUONGG = REWRITE_RULE[GSYM ups_x_pow2] TRUONGG;;\r
 713 \r
 714 let HVXIKHW = prove(` !x y z.\r
 715          &0 <= x /\ &0 <= y /\ &0 <= z /\ &0 < ups_x_pow2 x y z\r
 716          ==> max_real3 x y z / &2 <= eta_y x y z`,\r
 717 REWRITE_TAC[REAL_ARITH` a / &2 <= b <=> a <= &2 * b `; MAX_REAL3_LESS_EX] THEN \r
 718 REWRITE_TAC[eta_x; ups_x_pow2] THEN \r
 719 NHANH (REAL_ARITH` &0 < a ==> &0 <= a `) THEN \r
 720 DAO THEN REPEAT GEN_TAC THEN \r
 721 REWRITE_TAC[MESON[ETA_Y_SYMM]` &0 <= ups_x (x * x) (y * y) (z * z) /\ las\r
 722  ==> z <= &2 * eta_y x y z /\ x <= &2 * eta_y x y z /\ y <= &2 * eta_y x y z \r
 723   <=> &0 <= ups_x (x * x) (y * y) (z * z) /\ las\r
 724  ==> z <= &2 * eta_y z x y /\ x <= &2 * eta_y x y z /\ y <= &2 * eta_y y z x`] THEN \r
 725 REWRITE_TAC[eta_y] THEN CONV_TAC (TOP_DEPTH_CONV let_CONV) THEN REWRITE_TAC[eta_x] \r
 726 THEN NHANH (SPEC_ALL IMPLY_POS) THEN \r
 727 NHANH (SPEC_ALL (prove(` ! a b x y. &0 <= a / b /\ &0 <= x /\ &0 <= y ==>\r
 728    &0 <=  &2 * sqrt ( a/b) /\ &0 <= &2 * sqrt x /\ &0 <= &2 * sqrt y `,\r
 729 REWRITE_TAC[REAL_ARITH ` &0 <= &2 * a <=> &0 <= a `] THEN \r
 730 SIMP_TAC[SQRT_WORKS]))) THEN SIMP_TAC[POW2_COND] THEN \r
 731 REWRITE_TAC[REAL_ARITH ` x <= ( &2 * y ) pow 2 <=> x / &4 <= y pow 2 `] THEN \r
 732 SIMP_TAC[ SQRT_POW_2] THEN REWRITE_TAC[ GSYM ups_x_pow2] THEN \r
 733 REWRITE_TAC[REAL_FIELD` a / b <= c <=> &0 <= c - a / b `] THEN \r
 734 SIMP_TAC[ups_x_pow2; UPS_X_SYM; RE_TRUONGG] THEN DAO THEN \r
 735 MATCH_MP_TAC (MESON[]` (a4 ==> l) ==> (a1/\a2/\a3/\a4/\a5) ==> l `) THEN \r
 736 MP_TAC REAL_LE_SQUARE THEN MP_TAC REAL_LE_MUL THEN MP_TAC REAL_LE_DIV THEN \r
 737 REWRITE_TAC[GSYM REAL_POW_2] THEN MESON_TAC[REAL_ARITH ` &0 < a ==> &0 <= &4 * a `]);;\r
 738 \r
 739 \r
 740 let EXISTS_INV = REAL_FIELD` ~( a = &0 ) <=> a * &1 / a = &1 /\ &1 / a * a = &1 `;;\r
 741 \r
 742 \r
 743 let MIDDLE_POINT = prove(` ! x y (z:real^3) . collinear {x,y,z} ==> x IN conv {y,z} \/ \r
 744 y IN conv {x,z} \/  z IN conv {x,y} `, REWRITE_TAC[COLLINEAR_EX] THEN REPEAT \r
 745 GEN_TAC THEN \r
 746 MATCH_MP_TAC (prove(`(!(a:real) (b:real) (c:real). P a b c <=> P (--a) (--b) (--c)) /\\r
 747    ((?a b c. &0 <= a /\ P a b c) ==> l) ==>  ( ? a b c. P a b c ) ==> l `,\r
 748  DISCH_TAC THEN ASM_MESON_TAC[REAL_ARITH ` ! a. a <= &0 \/ &0 <= a`;\r
 749    REAL_ARITH ` a <= &0 <=> &0 <= -- a `])) THEN \r
 750 CONJ_TAC THENL [MESON_TAC[REAL_ARITH` a = &0 <=> -- a = &0 `; REAL_ARITH ` a + b + c = &0\r
 751   <=> --a + --b + --c = &0`; VECTOR_ARITH ` a % x + b % y + c % z = vec 0\r
 752   <=> --a % x + --b % y + --c % z = vec 0 `]; STRIP_TAC] THEN \r
 753 DISJ_CASES_TAC (REAL_ARITH ` &0 < b \/ b <= &0`) THENL\r
 754 [STRIP_TR THEN REWRITE_TAC[VECTOR_ARITH ` a + b + c % z = vec 0 <=>\r
 755   --c % z = a + b `] THEN \r
 756 NHANH (MESON[VECTOR_MUL_LCANCEL]` a % x = y ==> (&1 / a) % a % x = &1 / a % y `) THEN \r
 757 REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN \r
 758 REWRITE_TAC[MESON[]` a1/\a2/\a3/\a4/\a5 ==> l <=> a1 /\ a5 /\ a2 ==>\r
 759   a3/\a4 ==> l `] THEN \r
 760 NHANH (REAL_FIELD ` &0 <= a /\ &0 < b /\ a + b + c = &0 ==> \r
 761   a / ( -- c ) + b /( -- c ) = &1 /\ ~ ( -- c = &0 )/\ &0 < -- c `) THEN \r
 762 SIMP_TAC[EXISTS_INV] THEN \r
 763 ONCE_REWRITE_TAC[MESON[POS_EQ_INV_POS]` a /\ &0 < c <=> a /\ &0 < &1 / c `] THEN \r
 764 REWRITE_TAC[VECTOR_MUL_LID; CONV_SET2; IN_ELIM_THM; GSYM (REAL_ARITH` a / b =\r
 765    &1 / b * a `)] THEN \r
 766 ONCE_REWRITE_TAC[REAL_ARITH` a / b = &1 / b * a `] THEN \r
 767 MP_TAC (GEN_ALL (MESON[REAL_ARITH`( a * &1 = a ) /\ ( &0 < a ==> &0 <= a )`; \r
 768  REAL_LE_MUL]` &0 < &1 / c * &1 /\ ( &0 <= a \/ &0 < a ) ==> &0 <= &1 / c * a `)) THEN \r
 769 MESON_TAC[]; STRIP_TR THEN \r
 770 NHANH (MESON[REAL_ARITH` &0 <= c \/ c <= &0`]` a + b + v = &0 ==>\r
 771   &0 <= v \/ v <= &0 `) THEN \r
 772 REWRITE_TAC[MESON[]` a1/\(a2 /\ (aa\/ bb))/\ dd <=>\r
 773   (aa\/bb) /\ a1/\a2/\dd`] THEN SPEC_TAC (`a:real`, `a:real`) THEN \r
 774 SPEC_TAC (`b:real`, `b:real`) THEN SPEC_TAC (`c:real`, `c:real`) THEN \r
 775 KHANANG THEN REWRITE_TAC[(prove( `&0 <= c /\ &0 <= a /\ a + b + c = &0 /\\r
 776  ~(a = &0 /\ b = &0 /\ c = &0) /\ a % x + b % y + c % z = vec 0 /\\r
 777  b <= &0 <=> --a <= &0 /\ &0 <= --b /\ --b + --c + --a = &0 /\\r
 778  ~(--b = &0 /\ --c = &0 /\ --a = &0) /\ --b % y + --c % z + -- a % x = vec 0 /\\r
 779  --c <= &0`, MESON_TAC[\r
 780 REAL_ARITH ` (a = &0 <=> --a = &0) /\ ( b <= &0 <=> &0 <= -- b ) /\\r
 781      (&0 <= a <=> --a <= &0) /\\r
 782      (a + b + c = &0 <=> --b + --c + -- a = &0)`;\r
 783 VECTOR_ARITH` a % x + b % y + c % z = vec 0 <=> \r
 784  --b % y + --c % z + --a % x = vec 0 `]))] THEN \r
 785 REWRITE_TAC[MESON[]` a \/ b ==> c <=> (a ==> c) /\(b==>c)`] THEN \r
 786 REWRITE_TAC[MESON[REAL_ARITH `&0 <= a <=> a = &0 \/ &0 < a `]`\r
 787   c <= &0 /\ &0 <= a /\ l <=> ( a = &0 \/ &0 < a ) /\ c <= &0 /\ l`] THEN \r
 788 KHANANG THEN \r
 789 REWRITE_TAC[MESON[REAL_ARITH `a = &0 /\ c <= &0 /\ a + b + c = &0 /\ b <= &0\r
 790      ==> a = &0 /\ b = &0 /\ c = &0`]`a = &0 /\      c <= &0 /\\r
 791       a + b + c = &0 /\ ~(a = &0 /\ b = &0 /\ c = &0) /\a2/\ b <= &0 <=> F `] THEN \r
 792 NHANH (MESON[REAL_FIELD ` &0 < a /\\r
 793          a + b + c = &0 ==> -- b / a + -- c / a = &1 `]`&0 < a /\      c <= &0 /\\r
 794       a + b + c = &0 /\ l ==> --b / a + --c / a = &1 `) THEN \r
 795 REWRITE_TAC[VECTOR_ARITH `  a % x + b % y + c % z = vec 0 <=>\r
 796   a % x = -- b % y + -- c % z `] THEN \r
 797 NHANH (MESON[VECTOR_MUL_LCANCEL]` a % x = y ==> &1 / a % a % x = &1 / a % y `) THEN \r
 798 REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_ARITH ` &1 / a * b \r
 799   = b / a `;VECTOR_MUL_LID ] THEN PHA THEN \r
 800 PURE_ONCE_REWRITE_TAC[MESON[REAL_FIELD ` &0 < a ==> a / a = &1`]`\r
 801    &0 < a /\ P ( a / a) <=> &0 < a /\ P ( &1 ) `] THEN \r
 802 REWRITE_TAC[VECTOR_MUL_LID ] THEN \r
 803 REWRITE_TAC[MESON[SET_RULE ` {a,b} = {b,a}`]` y IN conv {x, z} \/ z IN conv {x, y}\r
 804   <=> y IN conv {z,x} \/ z IN conv {x,y} `] THEN \r
 805 REWRITE_TAC[CONV_SET2; IN_ELIM_THM] THEN \r
 806 REWRITE_TAC[ REAL_ARITH ` a <= &0 <=> &0 <= -- a `] THEN \r
 807 MESON_TAC[REAL_LE_DIV; REAL_ARITH ` &0 < a ==> &0 <= a `]]);;\r
 808 \r
 809 (* \r
 810 let REAL_SQRTSOSFIELD =\r
 811  let inv_tm = `inv:real->real`\r
 812  and sqrt_tm = `sqrt:real->real` in\r
 813  let prenex_conv =\r
 814    TOP_DEPTH_CONV BETA_CONV THENC\r
 815    PURE_REWRITE_CONV[FORALL_SIMP; EXISTS_SIMP; real_div;\r
 816                      REAL_INV_INV; REAL_INV_MUL; GSYM REAL_POW_INV] THENC\r
 817    NNFC_CONV THENC DEPTH_BINOP_CONV `(/\)` CONDS_CELIM_CONV THENC\r
 818    PRENEX_CONV\r
 819  and setup_conv = NNF_CONV THENC WEAK_CNF_CONV THENC CONJ_CANON_CONV\r
 820  and core_rule t =\r
 821    try REAL_ARITH t\r
 822    with Failure _ -> try REAL_RING t\r
 823    with Failure _ -> REAL_SOS t\r
 824  and is_inv =\r
 825    let is_div = is_binop `(/):real->real->real` in\r
 826    fun tm -> (is_div tm or (is_comb tm & rator tm = inv_tm)) &\r
 827              not(is_ratconst(rand tm))\r
 828  and is_sqrt tm = is_comb tm & rator tm = sqrt_tm in\r
 829  let SQRT_HYP_THM = prove\r
 830   (`!x. &0 <= x ==> &0 <= sqrt x /\ (sqrt x) * (sqrt x) = x`,\r
 831    MESON_TAC[SQRT_POS_LE; SQRT_POW_2; REAL_POW_2]) in\r
 832  let BASIC_REAL_FIELD tm =\r
 833    let is_freeinv t = is_inv t & free_in t tm\r
 834    and is_freesqrt t = is_sqrt t & free_in t tm in\r
 835    let itms = setify(map rand (find_terms is_freeinv tm)) in\r
 836    let hyps = map (fun t -> SPEC t REAL_MUL_RINV) itms in\r
 837    let tm' = itlist (fun th t -> mk_imp(concl th,t)) hyps tm in\r
 838    let itms' = map (curry mk_comb inv_tm) itms in\r
 839    let gvs = map (genvar o type_of) itms' in\r
 840    let tm'' = subst (zip gvs itms') tm' in\r
 841    let stms = setify(map rand (find_terms is_freesqrt tm'')) in\r
 842    let syps =  map (fun t -> SPEC t SQRT_HYP_THM) stms in\r
 843    let tm''' = itlist (fun th t -> mk_imp(concl th,t)) syps tm'' in\r
 844    let stms' = map (curry mk_comb sqrt_tm) stms in\r
 845    let hvs = map (genvar o type_of) stms' in\r
 846    let tm'''' = subst (zip hvs stms') tm''' in\r
 847    let th1 = setup_conv tm'''' in\r
 848    let cjs = conjuncts(rand(concl th1)) in\r
 849    let ths = map core_rule cjs in\r
 850    let th2 = EQ_MP (SYM th1) (end_itlist CONJ ths) in\r
 851    rev_itlist (C MP) (syps @ hyps)\r
 852               (INST (zip itms' gvs @ zip stms' hvs) th2) in\r
 853  fun tm ->\r
 854    let th0 = prenex_conv tm in\r
 855    let tm0 = rand(concl th0) in\r
 856    let avs,bod = strip_forall tm0 in\r
 857    let th1 = setup_conv bod in\r
 858    let ths = map BASIC_REAL_FIELD (conjuncts(rand(concl th1))) in\r
 859    EQ_MP (SYM th0) (GENL avs (EQ_MP (SYM th1) (end_itlist CONJ ths)));;\r
 860 \r
 861 *)\r
 862 let IN_CONV_COLLINEAR = prove(` ! (v:real^3) v1 v2. v IN conv {v1,v2} ==> \r
 863 collinear {v,v1,v2} `, REWRITE_TAC[COLLINEAR_EX] THEN \r
 864 REWRITE_TAC[COLLINEAR_EX; CONV_SET2; IN_ELIM_THM] THEN \r
 865 REWRITE_TAC[VECTOR_ARITH ` v = a % v1 + b % v2 <=> \r
 866    &1 % v + -- a % v1 + -- b % v2 = vec 0 `] THEN \r
 867 MESON_TAC[REAL_ARITH `~ ( &1 = &0 ) /\ (a + b = &1 <=> &1 + --a + --b = &0 )`]);;\r
 868 \r
 869 let COLLINERA_AS_IN_CONV2 = prove(` ! x y (z:real^3) . collinear {x,y,z} <=> \r
 870 x IN conv {y,z} \/ \r
 871 y IN conv {x,z} \/  z IN conv {x,y}`, \r
 872 MESON_TAC[PER_SET3; IN_CONV_COLLINEAR; MIDDLE_POINT]);;\r
 873 \r
 874 \r
 875 let LENGTH_EQ_EX = prove(`!v v1 v2.\r
 876      dist (v1,v) + dist (v,v2) = dist (v1,v2) <=>\r
 877      ~(dist (v1,v2) < dist (v1,v) + dist (v,v2))`,\r
 878 REPEAT GEN_TAC THEN \r
 879 REWRITE_TAC[REAL_ARITH ` ~( a < b) <=> b <= a `] THEN \r
 880 EQ_TAC THENL [REAL_ARITH_TAC; \r
 881 NHANH (MESON[DIST_TRIANGLE]` dist (v1,v) + dist (v,v2) <= dist (v1,v2)\r
 882   ==> dist(v1,v2) <= dist (v1,v) + dist (v,v2)`) THEN \r
 883 REAL_ARITH_TAC]);;\r
 884 \r
 885 \r
 886 let BETWEEN_IMP_IN_CONVEX_HULL = new_axiom` !v v1 v2. dist(v1,v) + dist(v,v2) = \r
 887 dist(v1,v2)\r
 888  ==> (?a b. &0 <= a /\ &0 <= b /\ a + b = &1 /\  v = a % v1 + b % v2)`;;\r
 889 (* HARRISON have proved this lemma as following, but it must be loaded after convex.ml *)\r
 890 (*   let BETWEEN_IFF_IN_CONVEX_HULL = prove\r
 891   (`!v v1 v2:real^N.\r
 892          dist(v1,v) + dist(v,v2) = dist(v1,v2) <=> v IN convex hull {v1,v2}`,\r
 893    REPEAT GEN_TAC THEN ASM_CASES_TAC  `v1:real^N = v2` THENL\r
 894     [ASM_REWRITE_TAC[INSERT_AC; CONVEX_HULL_SING; IN_SING] THEN NORM_ARITH_TAC;\r
 895      REWRITE_TAC[CONVEX_HULL_2_ALT; IN_ELIM_THM] THEN EQ_TAC THENL\r
 896       [DISCH_TAC THEN EXISTS_TAC `dist(v1:real^N,v) / dist(v1,v2)` THEN\r
 897        ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; DIST_POS_LT] THEN CONJ_TAC\r
 898        THENL [FIRST_ASSUM(SUBST1_TAC o SYM) THEN NORM_ARITH_TAC; ALL_TAC] THEN\r
 899        MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN\r
 900        EXISTS_TAC `dist(v1:real^N,v2)` THEN\r
 901        ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_ADD_LDISTRIB; REAL_SUB_LDISTRIB;\r
 902                     REAL_DIV_LMUL; DIST_EQ_0] THEN\r
 903        FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIST_TRIANGLE_EQ] o SYM) THEN\r
 904        FIRST_ASSUM(SUBST1_TAC o SYM) THEN\r
 905        REWRITE_TAC[dist; REAL_ARITH `(a + b) * &1 - a = b`] THEN\r
 906        VECTOR_ARITH_TAC;\r
 907        STRIP_TAC THEN ASM_REWRITE_TAC[dist] THEN\r
 908        REWRITE_TAC[VECTOR_ARITH `a - (a + b:real^N) = --b`;\r
 909                    VECTOR_ARITH `(a + u % (b - a)) - b = (&1 - u) % (a - b)`;\r
 910                    NORM_NEG; NORM_MUL; GSYM REAL_ADD_LDISTRIB] THEN\r
 911        REWRITE_TAC[NORM_SUB] THEN REPEAT(POP_ASSUM MP_TAC) THEN\r
 912        CONV_TAC REAL_FIELD]]);;\r
 913 \r
 914 From this, your version follows easily:\r
 915 \r
 916  let BETWEEN_IMP_IN_CONVEX_HULL = prove\r
 917   (`!v v1 v2. dist(v1,v) + dist(v,v2) = dist(v1,v2)\r
 918               ==> (?a b. &0 <= a /\ &0 <= b /\ a + b = &1 /\\r
 919                          v = a % v1 + b % v2)`,\r
 920    REWRITE_TAC[BETWEEN_IFF_IN_CONVEX_HULL; CONVEX_HULL_2; IN_ELIM_THM] THEN\r
 921    REWRITE_TAC[CONJ_ASSOC]);;\r
 922 *)\r
 923 \r
 924 \r
 925 \r
 926 let PRE_HE = prove(` ! x y z. let p = ( x + y + z ) / &2 in\r
 927   ups_x_pow2 x y z = &16 * p * ( p - x ) * ( p - y ) * ( p - z ) `,\r
 928 CONV_TAC (TOP_DEPTH_CONV let_CONV) THEN \r
 929 REWRITE_TAC[ups_x_pow2; ups_x] THEN REAL_ARITH_TAC);;\r
 930 \r
 931 let PRE_HER = prove(`!x y z.\r
 932      ups_x_pow2 x y z =\r
 933      &16 *\r
 934      (x + y + z) / &2 *\r
 935      ((x + y + z) / &2 - x) *\r
 936      ((x + y + z) / &2 - y) *\r
 937      ((x + y + z) / &2 - z)`, \r
 938 REWRITE_TAC[ups_x_pow2; ups_x] THEN REAL_ARITH_TAC);;\r
 939 \r
 940 \r
 941 let TRIVIVAL_LE = prove(`!v1 v2 v3.\r
 942      ~(v2 = v3 /\ v1 = v2)\r
 943      ==> ~(dist (v1,v2) + dist (v1,v3) + dist (v2,v3) = &0)`,\r
 944 SIMP_TAC[DE_MORGAN_THM; DIST_NZ] THEN \r
 945 NHANH (MESON[DIST_POS_LE]`&0 < dist (v2,v3) \/ &0 < dist (v1,v2) ==>\r
 946   &0 <= dist(v1,v3) `) THEN MP_TAC DIST_POS_LE THEN KHANANG THEN \r
 947 REWRITE_TAC[OR_IMP_EX] THEN \r
 948 NHANH (MESON[DIST_POS_LE]`&0 < dist (v2,v3) /\ &0 <= dist (v1,v3)\r
 949   ==> &0 <= dist(v1,v2) `) THEN \r
 950 SIMP_TAC[REAL_ARITH`( &0 < a /\ &0 <= b ) /\ &0 <= c ==> ~(c + b + a = &0 ) `] THEN \r
 951 NHANH (MESON[DIST_POS_LE]`&0 < dist (v1,v2) /\ &0 <= dist (v1,v3) ==>\r
 952   &0 <= dist(v2,v3) `) THEN \r
 953 MESON_TAC[REAL_ARITH ` &0 < a /\ &0 <= b /\ &0 <= c ==> ~( a + b + c = &0 ) `]);;\r
 954 \r
 955 \r
 956 \r
 957 let MID_COND = prove(` ! v v1 v2. v IN conv {v1,v2} <=> dist(v1,v) + dist(v,v2)\r
 958  = dist(v1,v2) `, REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[LENGTH_EQUA; DIST_SYM];\r
 959 REWRITE_TAC[CONV_SET2; IN_ELIM_THM] THEN \r
 960 MESON_TAC[DIST_SYM; BETWEEN_IMP_IN_CONVEX_HULL]]);;\r
 961 \r
 962 \r
 963 (* lemma 9. p 13 *)\r
 964 let FHFMKIY = prove(`!(v1:real^3) v2 v3 x12 x13 x23.\r
 965          x12 = dist (v1,v2) pow 2 /\\r
 966          x13 = dist (v1,v3) pow 2 /\\r
 967          x23 = dist (v2,v3) pow 2\r
 968          ==> (collinear {v1, v2, v3} <=> ups_x x12 x13 x23 = &0)`,\r
 969 REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[COLLINERA_AS_IN_CONV2]\r
 970  THEN REWRITE_TAC[REAL_ARITH ` x pow 2 = x * x `; GSYM ups_x_pow2] THEN \r
 971 REWRITE_TAC[PRE_HER] THEN REWRITE_TAC[REAL_ENTIRE] THEN \r
 972 ONCE_REWRITE_TAC[MESON[]`( v1 IN conv {v2, v3} \/ a \/ b <=> l ) <=> \r
 973 (v1 = v2 /\ v1 = v3 ) \/  ~(v1 = v2 /\ v1 = v3) ==> ( v1 IN conv {v2, v3} \r
 974 \/ a \/ b <=> l )`] THEN REWRITE_TAC[OR_IMP_EX] THEN \r
 975 SIMP_TAC[DIST_SYM; DIST_REFL; MESON[]` a= b/\ a= c <=> b = c /\ a= b`] THEN \r
 976 SIMP_TAC[SET_RULE ` {a,a} = {a} /\ a IN {a} `; CONV_SING;\r
 977    REAL_ARITH ` (&0 + &0 + &0)/ &2 = &0 `] THEN SIMP_TAC[ TRIVIVAL_LE; \r
 978 REAL_ARITH `~( &16 = &0) /\(~( a = &0) ==> ~( a / &2 = &0))`] THEN \r
 979 REWRITE_TAC[REAL_ARITH ` (a+ b + c ) / &2 - a = &0 <=> b + c = a `] THEN \r
 980 REWRITE_TAC[REAL_ARITH ` (a+ b + c ) / &2 - b = &0 <=> c + a = b  `] THEN \r
 981 REWRITE_TAC[REAL_ARITH ` (a+ b + c ) / &2 - c = &0 <=> a + b = c `] THEN \r
 982 REWRITE_TAC[MESON[SET_RULE `{a,b} = {b,a} `]`v2 IN conv {v1, v3} \/ v3 IN \r
 983 conv {v1, v2}  <=> v2 IN conv {v3,v1} \/ v3 IN conv {v1, v2}`] THEN \r
 984 REWRITE_TAC[MID_COND] THEN MESON_TAC[DIST_SYM]);;\r
 985 \r
 986 (* le 11. p 14 *)\r
 987 (* NGUYEN QUANG TRUONG *)\r
 988 \r
 989 \r
 990 (* These following lemma are Multivariate/convex.ml *)\r
 991 let AFFINE_HULL_EXPLICIT = new_axiom` \r
 992   !p. affine hull p =\r
 993      {y | ?s u.\r
 994               FINITE s /\\r
 995               ~(s = {}) /\\r
 996               s SUBSET p /\\r
 997               sum s u = &1 /\\r
 998               vsum s (\v. u v % v) = y}` ;;\r
 999 \r
1000 let affine_dependent = new_definition\r
1001  `affine_dependent (s:real^N -> bool) <=>\r
1002         ?x. x IN s /\ x IN (affine hull (s DELETE x))`;;\r
1003 \r
1004 let AFFINE_DEPENDENT_EXPLICIT_FINITE = new_axiom\r
1005 `!s. FINITE(s:real^N -> bool)\r
1006        ==> (affine_dependent s <=>\r
1007             ?u. sum s u = &0 /\\r
1008                 (?v. v IN s /\ ~(u v = &0)) /\\r
1009                 vsum s (\v. u v % v) = vec 0)`;;\r
1010 \r
1011  let AFFINE_HULL_FINITE = prove\r
1012   (`!s:real^N->bool.\r
1013        FINITE s\r
1014        ==> affine hull s = {y | ?u. sum s u = &1 /\ vsum s (\v. u v % v) = y}`,\r
1015    GEN_TAC THEN DISCH_TAC THEN\r
1016    REWRITE_TAC[EXTENSION; AFFINE_HULL_EXPLICIT; IN_ELIM_THM] THEN\r
1017    X_GEN_TAC `x:real^N` THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL\r
1018     [MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `f:real^N->real`] THEN\r
1019      STRIP_TAC THEN\r
1020      EXISTS_TAC `\x:real^N. if x IN t then f x else &0` THEN\r
1021      REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COND_RAND] THEN\r
1022      ONCE_REWRITE_TAC[COND_RATOR] THEN REWRITE_TAC[VECTOR_MUL_LZERO] THEN\r
1023      ASM_SIMP_TAC[GSYM VSUM_RESTRICT_SET; GSYM SUM_RESTRICT_SET] THEN\r
1024      ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`];\r
1025      X_GEN_TAC `f:real^N->real` THEN\r
1026      ASM_CASES_TAC `s:real^N->bool = {}` THEN\r
1027      ASM_REWRITE_TAC[SUM_CLAUSES; REAL_OF_NUM_EQ; ARITH] THEN STRIP_TAC THEN\r
1028      MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `f:real^N->real`] THEN\r
1029      ASM_REWRITE_TAC[GSYM EXTENSION; SUBSET_REFL]]);;\r
1030 \r
1031  let IN_AFFINE_HULL_IMP_COLLINEAR = prove\r
1032   (`!a b c:real^N. a IN (affine hull {b,c}) ==> collinear {a,b,c}`,\r
1033    REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC\r
1034     [`a:real^N = b`; `a:real^N = c`; `b:real^N = c`] THEN\r
1035    TRY(ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_SING; COLLINEAR_2] THEN NO_TAC) THEN\r
1036    SIMP_TAC[AFFINE_HULL_FINITE; FINITE_INSERT; FINITE_SING] THEN\r
1037    SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; FINITE_RULES; REAL_ADD_RID] THEN\r
1038    ASM_REWRITE_TAC[IN_INSERT; IN_ELIM_THM; NOT_IN_EMPTY; VECTOR_ADD_RID] THEN\r
1039    DISCH_THEN(X_CHOOSE_THEN `f:real^N->real` STRIP_ASSUME_TAC) THEN\r
1040    ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {c,b,a}`] THEN\r
1041    ASM_REWRITE_TAC[COLLINEAR_3; COLLINEAR_LEMMA; VECTOR_SUB_EQ] THEN\r
1042    EXISTS_TAC `(f:real^N->real) c` THEN EXPAND_TAC "a" THEN\r
1043    FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (REAL_ARITH\r
1044     `b + c = &1 ==> b = &1 - c`)) THEN VECTOR_ARITH_TAC);;\r
1045 \r
1046 \r
1047  let AFFINE_DEPENDENT_3_IMP_COLLINEAR = prove\r
1048   (`!a b c:real^N. affine_dependent{a,b,c} ==> collinear{a,b,c}`,\r
1049    REPEAT GEN_TAC THEN\r
1050    MAP_EVERY ASM_CASES_TAC\r
1051     [`a:real^N = b`; `a:real^N = c`; `b:real^N = c`] THEN\r
1052    TRY(ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_SING; COLLINEAR_2] THEN NO_TAC) THEN\r
1053    REWRITE_TAC[affine_dependent; IN_INSERT; NOT_IN_EMPTY] THEN STRIP_TAC THEN\r
1054    FIRST_X_ASSUM SUBST_ALL_TAC THENL\r
1055     [ALL_TAC;\r
1056      ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,a,c}`];\r
1057      ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {c,b,a}`]] THEN\r
1058    MATCH_MP_TAC IN_AFFINE_HULL_IMP_COLLINEAR THEN\r
1059    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]\r
1060     `x IN s ==> s = t ==> x IN t`)) THEN\r
1061    AP_TERM_TAC THEN ASM SET_TAC[]);;\r
1062 \r
1063 (* LEMMA 11 *)\r
1064 let FAFKVLR = prove\r
1065  (`!v1 v2 v3 v:real^N.\r
1066        ~collinear{v1,v2,v3} /\ v IN (affine hull {v1,v2,v3})\r
1067 \r
1068        ==> ?t1 t2 t3. v = t1 % v1 + t2 % v2 + t3 % v3 /\\r
1069                       t1 + t2 + t3 = &1 /\\r
1070                       !ta tb tc. v = ta % v1 + tb % v2 + tc % v3 /\\r
1071 \r
1072                                  ta + tb + tc = &1\r
1073                                  ==> ta = t1 /\ tb = t2 /\ tc = t3`,\r
1074  REPEAT GEN_TAC THEN\r
1075  MAP_EVERY ASM_CASES_TAC\r
1076   [`v1:real^N = v2`; `v2:real^N = v3`; `v1:real^N = v3`] THEN\r
1077  TRY(ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_SING; COLLINEAR_2] THEN NO_TAC) THEN\r
1078  SIMP_TAC[AFFINE_HULL_FINITE; FINITE_INSERT; FINITE_SING; IN_ELIM_THM] THEN\r
1079  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN\r
1080  SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; FINITE_INSERT; FINITE_SING;\r
1081           SUM_SING; VSUM_SING] THEN\r
1082  ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; LEFT_IMP_EXISTS_THM] THEN\r
1083  X_GEN_TAC `f:real^N->real` THEN STRIP_TAC THEN\r
1084  MAP_EVERY EXISTS_TAC\r
1085   [`(f:real^N->real) v1`; `(f:real^N->real) v2`; `(f:real^N->real) v3`] THEN\r
1086  ASM_REWRITE_TAC[] THEN REPEAT GEN_TAC THEN EXPAND_TAC "v" THEN\r
1087  DISCH_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN\r
1088  UNDISCH_TAC `~collinear{v1:real^N,v2,v3}` THEN REWRITE_TAC[] THEN\r
1089  MATCH_MP_TAC AFFINE_DEPENDENT_3_IMP_COLLINEAR THEN\r
1090  SIMP_TAC[AFFINE_DEPENDENT_EXPLICIT_FINITE; FINITE_INSERT; FINITE_RULES;\r
1091           SUM_CLAUSES; VSUM_CLAUSES] THEN\r
1092  ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN\r
1093  EXISTS_TAC `\x. if x = v1 then f v1 - ta\r
1094                  else if x = v2 then f v2 - tb\r
1095                  else (f:real^N->real) v3 - tc` THEN\r
1096  ASM_REWRITE_TAC[REAL_ADD_RID; VECTOR_ADD_RID] THEN REPEAT CONJ_TAC THENL\r
1097   [ASM_REAL_ARITH_TAC;\r
1098    ASM_REWRITE_TAC[EXISTS_OR_THM; RIGHT_OR_DISTRIB; UNWIND_THM2] THEN\r
1099    ASM_REWRITE_TAC[REAL_SUB_0] THEN ASM_MESON_TAC[];\r
1100    ASM_REWRITE_TAC[VECTOR_ARITH\r
1101     `(a - a') % x + (b - b') % y + (c - c') % z = vec 0 <=>\r
1102      a % x + b % y + c % z = a' % x + b' % y + c' % z`] THEN\r
1103    ASM_MESON_TAC[]]);;\r
1104 \r
1105 \r
1106 \r
1107  let FAFKVLR_ALT = prove\r
1108   (`!v1 v2 v3 v:real^N.\r
1109          ~collinear{v1,v2,v3} /\ v IN (affine hull {v1,v2,v3})\r
1110          ==> ?!(t1,t2,t3). v = t1 % v1 + t2 % v2 + t3 % v3 /\\r
1111                            t1 + t2 + t3 = &1`,\r
1112    REWRITE_TAC(map(REWRITE_RULE[ETA_AX])\r
1113     [EXISTS_UNIQUE; FORALL_PAIR_THM; EXISTS_PAIR_THM]) THEN\r
1114    REWRITE_TAC[PAIR_EQ; GSYM CONJ_ASSOC; FAFKVLR]);;\r
1115 \r
1116 \r
1117 let equivalent_lemma = prove(` (?t1 t2 t3.\r
1118          !v1 v2 v3 (v:real^N).\r
1119              v IN affine hull {v1, v2, v3} /\ ~collinear {v1, v2, v3}\r
1120              ==> v =\r
1121                  t1 v1 v2 v3 v % v1 + t2 v1 v2 v3 v % v2 + t3 v1 v2 v3 v % v3 /\\r
1122                  t1 v1 v2 v3 v + t2 v1 v2 v3 v + t3 v1 v2 v3 v = &1 /\\r
1123                  (!ta tb tc.\r
1124                       v = ta % v1 + tb % v2 + tc % v3 /\ ta + tb + tc = &1 \r
1125                       ==> ta = t1 v1 v2 v3 v /\\r
1126                           tb = t2 v1 v2 v3 v /\\r
1127                           tc = t3 v1 v2 v3 v))  <=>\r
1128      \r
1129           ( !v1 v2 v3 (v:real^N).\r
1130              v IN affine hull {v1, v2, v3} /\ ~collinear {v1, v2, v3}\r
1131           ==> (?t1 t2 t3.\r
1132                    v = t1 % v1 + t2 % v2 + t3 % v3 /\\r
1133                    t1 + t2 + t3 = &1 /\\r
1134                    (!ta tb tc.\r
1135                         v = ta % v1 + tb % v2 + tc % v3 /\ ta + tb + tc = &1\r
1136                         ==> ta = t1 /\ tb = t2 /\ tc = t3))) `,\r
1137 REWRITE_TAC[GSYM SKOLEM_THM; LEFT_FORALL_IMP_THM; RIGHT_EXISTS_IMP_THM]);;\r
1138 \r
1139 \r
1140  let LAMBDA_TRIPLED_THM = prove\r
1141   (`!t. (\(x,y,z). t x y z) = (\p. t (FST p) (FST(SND p)) (SND(SND p)))`,\r
1142    REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]);;\r
1143 \r
1144  let FORALL_TRIPLED_THM = prove\r
1145   (`!P. (!(x,y,z). P x y z) <=> (!x y z. P x y z)`,\r
1146    REWRITE_TAC[LAMBDA_TRIPLED_THM] THEN REWRITE_TAC[FORALL_PAIR_THM]);;\r
1147 \r
1148  let EXISTS_TRIPLED_THM = prove\r
1149   (`!P. (?(x,y,z). P x y z) <=> (?x y z. P x y z)`,\r
1150    REWRITE_TAC[LAMBDA_TRIPLED_THM] THEN REWRITE_TAC[EXISTS_PAIR_THM]);;\r
1151 \r
1152  let EXISTS_UNIQUE_TRIPLED_THM = prove\r
1153   (`!P. (?!(x,y,z). P x y z) <=>\r
1154         (?x y z. P x y z /\\r
1155                  (!x' y' z'. P x' y' z' ==> x' = x /\ y' = y /\ z' = z))`,\r
1156    REWRITE_TAC[REWRITE_RULE[ETA_AX] EXISTS_UNIQUE] THEN\r
1157    REWRITE_TAC[FORALL_TRIPLED_THM; EXISTS_TRIPLED_THM] THEN\r
1158    REWRITE_TAC[EXISTS_PAIR_THM; FORALL_PAIR_THM; PAIR_EQ]);;\r
1159 \r
1160 \r
1161  let theoremmm = prove\r
1162  (`( !v1 v2 v3 v:real^N.\r
1163       v IN affine hull {v1, v2, v3} /\ ~collinear {v1, v2, v3}\r
1164       ==> (?t1 t2 t3.\r
1165                v = t1 % v1 + t2 % v2 + t3 % v3 /\\r
1166                t1 + t2 + t3 = &1 /\\r
1167                (!ta tb tc.\r
1168                     v = ta % v1 + tb % v2 + tc % v3 /\\r
1169                     ta + tb + tc = &1\r
1170                     ==> ta = t1 /\ tb = t2 /\ tc = t3)) )\r
1171    <=>\r
1172    ( !v1 v2 v3 v:real^N.\r
1173             ~collinear {v1, v2, v3} /\ v IN affine hull {v1, v2, v3}\r
1174             ==> (?!(t1,t2,t3). v = t1 % v1 + t2 % v2 + t3 % v3 /\\r
1175                                t1 + t2 + t3 = &1))`,\r
1176    REWRITE_TAC[EXISTS_UNIQUE_TRIPLED_THM] THEN REWRITE_TAC[CONJ_ACI]);;\r
1177 \r
1178 \r
1179 \r
1180 \r
1181 let FAFKVLR = prove(` (?t1 t2 t3.\r
1182          !v1 v2 v3 (v:real^N).\r
1183              v IN affine hull {v1, v2, v3} /\ ~collinear {v1, v2, v3}\r
1184              ==> v =\r
1185                  t1 v1 v2 v3 v % v1 + t2 v1 v2 v3 v % v2 + t3 v1 v2 v3 v % v3 /\\r
1186                  t1 v1 v2 v3 v + t2 v1 v2 v3 v + t3 v1 v2 v3 v = &1 /\\r
1187                  (!ta tb tc.\r
1188                       v = ta % v1 + tb % v2 + tc % v3 /\ ta + tb + tc = &1 \r
1189                       ==> ta = t1 v1 v2 v3 v /\\r
1190                           tb = t2 v1 v2 v3 v /\\r
1191                           tc = t3 v1 v2 v3 v))  `,\r
1192 SIMP_TAC[equivalent_lemma; FAFKVLR]);;\r
1193 let LEMMA11 = FAFKVLR;;\r
1194 let lemma11 = REWRITE_RULE[equivalent_lemma] FAFKVLR;;\r
1195 let COEFS = new_specification ["coef1"; "coef2"; "coef3"] FAFKVLR;;\r
1196 \r
1197 let lem11 = REWRITE_RULE[simp_def2; IN_ELIM_THM] lemma11;;\r
1198 \r
1199 let REAL_PER3 = REAL_ARITH `!a b c. a + b + c = b + a + c /\ a + b + c = c + b + a `;;\r
1200 \r
1201 \r
1202 MESON[VEC_PER2_3]` (!ta tb tc.\r
1203       v = ta % v1 + tb % v2 + tc % v3 ==> ta = t1 /\ tb = t2 /\ tc = t3) /\bbb/\\r
1204  v = ta''' % v1 + tb''' % v2 + t''' % v3 /\\r
1205  v = ta'' % v3 + tb'' % v1 + t'' % v2 /\\r
1206  v = ta' % v2 + tb' % v3 + t' % v1 /\\r
1207 aa  ==> t' = t1 /\ t'' = t2 /\ t''' = t3 `;;\r
1208 \r
1209 \r
1210 let IN_CONV3_EQ = prove(`! (v:real^3) v1 v2 v3. ~collinear {v1,v2,v3} ==> (v IN conv {v1, v2, v3} <=> \r
1211   v IN aff_ge {v1,v2} {v3} /\\r
1212   v IN aff_ge {v2,v3} {v1} /\ v IN aff_ge {v3,v1} {v2} )`,\r
1213 REWRITE_TAC[CONV_SET3; simp_def2; IN_ELIM_THM] THEN \r
1214 REPEAT GEN_TAC THEN DISCH_TAC THEN  EQ_TAC THENL [\r
1215 MESON_TAC[REAL_ARITH` a + b + c = b + a + c /\ a + b + c = c + b + a `;\r
1216   VECTOR_ARITH `(a:real^N) + b + c = b + a + c /\ a + b + c = c + b + a `; lem11]; \r
1217 NHANH (MESON[]` (? a b c. P a b c /\ Q c /\ R a b c) /\ aa /\ bb ==>\r
1218    (? a b c. P a b c /\ R a b c) `) THEN \r
1219 FIRST_X_ASSUM MP_TAC THEN \r
1220 REWRITE_TAC[IMP_IMP] THEN \r
1221 REWRITE_TAC[MESON[]` ~a/\ b <=> b /\ ~ a `] THEN \r
1222 PHA THEN \r
1223 NHANH (SPEC_ALL lem11) THEN \r
1224 STRIP_TR THEN REWRITE_TAC[MESON[]` (v = w:real^N) /\ a <=> a /\ v = w `] THEN PHA] THEN \r
1225 NHANH (MESON[VEC_PER2_3; REAL_PER3]` ta + tb + t = &1 /\\r
1226  &0 <= t /\\r
1227  ta' + tb' + t' = &1 /\\r
1228  &0 <= t' /\\r
1229  ta'' + tb'' + t'' = &1 /\\r
1230  &0 <= t'' /\\r
1231 a1/\\r
1232 a2/\\r
1233  t1 + t2 + t3 = &1 /\\r
1234  (!ta tb tc.\r
1235       ta + tb + tc = &1 /\ v = ta % v1 + tb % v2 + tc % v3\r
1236       ==> ta = t1 /\ tb = t2 /\ tc = t3) /\\r
1237  v = t1 % v1 + t2 % v2 + t3 % v3 /\\r
1238 a3/\\r
1239  v = ta'' % v3 + tb'' % v1 + t'' % v2 /\\r
1240  v = ta' % v2 + tb' % v3 + t' % v1 /\\r
1241  v = ta % v1 + tb % v2 + t % v3 ==> t1 = t' /\ t2 = t'' /\ t3 = t`) THEN \r
1242 MESON_TAC[]);;\r
1243 \r
1244 \r
1245 let IN_CONV03_EQ = prove(\r
1246 `! (v:real^3) v1 v2 v3. ~collinear {v1,v2,v3} ==> \r
1247 (v IN conv0 {v1, v2, v3} <=>   v IN aff_gt {v1,v2} {v3} /\\r
1248   v IN aff_gt {v2,v3} {v1} /\ v IN aff_gt {v3,v1} {v2} )`,\r
1249 REWRITE_TAC[CONV_SET3; simp_def2; IN_ELIM_THM] THEN \r
1250 REPEAT GEN_TAC THEN DISCH_TAC THEN  EQ_TAC THENL [\r
1251 MESON_TAC[REAL_ARITH` a + b + c = b + a + c /\ a + b + c = c + b + a `;\r
1252   VECTOR_ARITH `(a:real^N) + b + c = b + a + c /\ a + b + c = c + b + a `; lem11]; \r
1253 NHANH (MESON[]` (? a b c. P a b c /\ Q c /\ R a b c) /\ aa /\ bb ==>\r
1254    (? a b c. P a b c /\ R a b c) `) THEN \r
1255 FIRST_X_ASSUM MP_TAC THEN \r
1256 REWRITE_TAC[IMP_IMP] THEN \r
1257 REWRITE_TAC[MESON[]` ~a/\ b <=> b /\ ~ a `] THEN \r
1258 PHA THEN \r
1259 NHANH (SPEC_ALL lem11) THEN \r
1260 STRIP_TR THEN REWRITE_TAC[MESON[]` (v = w:real^N) /\ a <=> a /\ v = w `]]\r
1261  THEN PHA THEN NHANH (MESON[VEC_PER2_3; REAL_PER3]`\r
1262   ta + tb + t = &1 /\\r
1263  &0 < t /\\r
1264  ta' + tb' + t' = &1 /\\r
1265  &0 < t' /\\r
1266  ta'' + tb'' + t'' = &1 /\\r
1267  &0 < t'' /\ a33 /\ a22 /\\r
1268  t1 + t2 + t3 = &1 /\\r
1269  (!ta tb tc.\r
1270       ta + tb + tc = &1 /\ v = ta % v1 + tb % v2 + tc % v3\r
1271       ==> ta = t1 /\ tb = t2 /\ tc = t3) /\\r
1272  v = t1 % v1 + t2 % v2 + t3 % v3 /\ a11 /\\r
1273  v = ta'' % v3 + tb'' % v1 + t'' % v2 /\\r
1274  v = ta' % v2 + tb' % v3 + t' % v1 /\\r
1275  v = ta % v1 + tb % v2 + t % v3 ==>\r
1276   t1 = t' /\ t2 = t'' /\ t3 = t `) THEN MESON_TAC[]);;\r
1277 \r
1278 \r
1279 \r
1280 let AFFINE_SET_GEN_BY_TWO_POINTS = \r
1281 prove(`! a b. affine {x | ?ta tb. ta + tb = &1 /\ x = ta % a + tb % b}`,\r
1282 REWRITE_TAC[affine; IN_ELIM_THM] THEN \r
1283 REPEAT GEN_TAC THEN \r
1284 STRIP_TAC THEN \r
1285 EXISTS_TAC ` u * ta + v * ta' ` THEN \r
1286 EXISTS_TAC ` u * tb + v * tb' ` THEN \r
1287 REWRITE_TAC[REAL_ARITH ` (u * ta + v * ta') + u * tb + v * tb' =\r
1288   u * (ta + tb) + v * (ta' + tb' ) `] THEN \r
1289 ASM_SIMP_TAC[REAL_ARITH ` a * &1 = a `] THEN \r
1290 CONV_TAC VECTOR_ARITH);;\r
1291 \r
1292 \r
1293 \r
1294 let GENERATING_POINT_IN_SET_AFF = prove(` ! a b. {a,b} SUBSET {x | ?ta tb. \r
1295 ta + tb = &1 /\ x = ta % a + tb % b}`,REWRITE_TAC[SET2_SU_EX; IN_ELIM_THM]\r
1296 THEN REPEAT GEN_TAC THEN \r
1297 MESON_TAC[REAL_ARITH` &0 + &1 = &1 /\ a + b = b + a`; VECTOR_ARITH `\r
1298   a = &0 % b + &1 % a /\ a = &1 % a + &0 % b `]);;\r
1299 \r
1300 \r
1301 let AFF_2POINTS_INTERPRET = prove(`!a b. aff {a, b} = {x | ?ta tb. ta + tb = &1 /\ x = ta % a + tb % b}`,\r
1302 REWRITE_TAC[aff; hull] THEN \r
1303 REPEAT GEN_TAC THEN \r
1304 REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN \r
1305 SIMP_TAC[INTERS_SUBSET; AFFINE_SET_GEN_BY_TWO_POINTS;\r
1306   GENERATING_POINT_IN_SET_AFF] THEN \r
1307 REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN \r
1308 REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERS; affine] THEN \r
1309 SET_TAC[]);;\r
1310 \r
1311 \r
1312 let IN_AFF_GE_INTERPRET_TO_AFF_GT_AND_AFF = prove(` ! v v1 v2 v3 . \r
1313 v IN aff_ge {v1,v2} {v3} <=> v IN aff_gt {v1,v2} {v3} \/\r
1314   v IN aff {v1,v2} `,\r
1315 REWRITE_TAC[simp_def2; AFF_2POINTS_INTERPRET; IN_ELIM_THM ] THEN \r
1316 REWRITE_TAC [REAL_ARITH ` &0 <= a <=> &0 < a \/ a = &0 `] THEN \r
1317 MESON_TAC[REAL_ARITH ` (&0 <= a <=> &0 < a \/ a = &0 )/\( a + &0 = a ) `;\r
1318   VECTOR_ARITH ` a + &0 % c = a `]);;\r
1319 \r
1320 let DOWN_TAC = REPEAT (FIRST_X_ASSUM MP_TAC) THEN REWRITE_TAC[IMP_IMP] THEN PHA;;\r
1321 let IMP_IMP_TAC = REWRITE_TAC[IMP_IMP] THEN PHA;;\r
1322 \r
1323 \r
1324 let AFFINE_AFF_HULL = prove(` ! s. affine ( aff s ) `, \r
1325 REWRITE_TAC[aff; AFFINE_AFFINE_HULL]);;\r
1326 \r
1327 \r
1328 let AFFINE_CONTAIN_LINE = prove(`! a b s. affine s /\ {a,b} SUBSET s ==>\r
1329  aff {a,b} SUBSET s `,\r
1330 REWRITE_TAC[affine ; AFF_2POINTS_INTERPRET; IN_ELIM_THM] THEN SET_TAC[]);;\r
1331 \r
1332 let VECTOR_SUB_DISTRIBUTE = VECTOR_ARITH ` ! a x y. a % x - a % y = a % ( x - y ) `;;\r
1333 \r
1334 \r
1335 let CHANGE_SIDE = prove(` ~( a = &0 ) ==> ( x = a % y <=> ( &1 / a) % x = y )`,\r
1336 MESON_TAC[ VECTOR_ARITH `  ( a * b ) % x = a % b % x `; VECTOR_MUL_LID;\r
1337   REAL_FIELD `~( a = &0 ) ==>  a * &1 / a = &1 `; VECTOR_MUL_LCANCEL]);;\r
1338 \r
1339 \r
1340 let PRE_INVERSE_SUB = prove(` ! a b v w. {a, b} SUBSET aff {v, w} /\ ~(a = b)\r
1341  ==> {v, w} SUBSET aff {a, b}`, \r
1342 REWRITE_TAC[AFF_2POINTS_INTERPRET; SET2_SU_EX; IN_ELIM_THM] THEN \r
1343 REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT (FIRST_X_ASSUM MP_TAC) THEN \r
1344 REWRITE_TAC[IMP_IMP] THEN PHA THEN \r
1345 NHANH (MESON[]` (a:real^N) = b /\ gg /\ a' = b' /\ ll ==> a - a' = b - b' `) THEN \r
1346 REWRITE_TAC[VECTOR_ARITH` (ta % v + tb % w) - (ta' % v + tb' % w) =\r
1347   ( ta - ta') % v + ( tb - tb' ) % w `] THEN \r
1348 PHA THEN REWRITE_TAC[MESON[]` a = &1 /\ b <=> b /\ a = &1 `] THEN PHA THEN \r
1349 NHANH (REAL_ARITH ` ta + tb = &1 /\ ta' + tb' = &1 ==> ta' - ta = tb - tb' `) THEN \r
1350 REWRITE_TAC[VECTOR_ARITH ` a + ( x - y ) % b = a - ( y - x) % b `] THEN \r
1351 REWRITE_TAC[MESON[]` a - b = ta % v - tb % w /\aa/\\r
1352    ta = tb <=> a - b = ta % v - ta % w /\ aa /\ ta = tb `] THEN \r
1353 ASM_CASES_TAC `(ta:real) = ta' ` THENL [ASM_SIMP_TAC[REAL_SUB_REFL; \r
1354 VECTOR_MUL_LZERO; VECTOR_SUB_RZERO; VECTOR_SUB_EQ] THEN MESON_TAC[]; ALL_TAC] THEN \r
1355 REWRITE_TAC[VECTOR_SUB_DISTRIBUTE] THEN FIRST_X_ASSUM MP_TAC THEN \r
1356 ONCE_REWRITE_TAC[REAL_ARITH` ~( a = b) <=> ~( a - b = &0 )`] THEN IMP_IMP_TAC THEN \r
1357 REWRITE_TAC[MESON[]` ~( a = b:real) /\ l <=> l /\ ~(a = b) `; MESON[]` \r
1358 a = d % b /\ l  <=> l /\  a = d % b `] THEN PHA THEN \r
1359 REWRITE_TAC[MESON[CHANGE_SIDE]` x = a % y /\ ~( a = &0 ) <=>  &1 / a % x = y /\\r
1360  ~( a = &0 )`] THEN NHANH (MESON[VECTOR_MUL_LCANCEL]` ta - ta' = tb' - tb /\\r
1361  a = b  /\ l ==> tb % a = tb % b /\ ta % a = ta % b `) THEN \r
1362 ONCE_REWRITE_TAC[MESON[]` a = (b:real^n) /\ l <=> l /\ a = b `] THEN PHA \r
1363 THEN REWRITE_TAC[GSYM VECTOR_SUB_DISTRIBUTE] THEN \r
1364 ONCE_REWRITE_TAC[VECTOR_ARITH` a = (b:real^N) /\ a1 = (b1:real^N) /\ a2 = \r
1365   (b2:real^N) <=> a2 = b2 /\ a + a2 = b + b2 /\ a2 - a1 = b2 - b1 `] THEN \r
1366 REWRITE_TAC[VECTOR_ARITH` (ta % v + tb % w) - (ta % v - ta % w) = ( ta + tb ) % w `;\r
1367   VECTOR_ARITH` tb % v - tb % w + ta % v + tb % w = ( ta + tb ) % v `] THEN \r
1368 REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH` a - ( x % a - y % b ) = \r
1369 (&1 - x ) % a + y % b `] THEN REWRITE_TAC[VECTOR_ARITH` a % x - b % y + x = \r
1370 (a + &1 ) % x + --b % y `] THEN \r
1371 REWRITE_TAC[MESON[]` a = &1 /\ b = &1 /\ l <=> a = &1 /\ l /\b = &1 `] THEN \r
1372 DAO THEN MATCH_MP_TAC (MESON[]`( a1 /\a2/\a3/\a5 ==> l) ==> \r
1373 (a1/\a2/\a3/\a4/\a5/\a6   ==> l ) `) THEN PURE_ONCE_REWRITE_TAC[ MESON[]`\r
1374  a + b = &1 /\ P ( a + b ) <=> a + b = &1 /\  P (&1) `] THEN \r
1375 REWRITE_TAC[VECTOR_MUL_LID] THEN MESON_TAC[REAL_FIELD ` ~(ta - ta' = &0)\r
1376      ==> (tb * &1 / (ta - ta') + &1) + --(tb * &1 / (ta - ta')) = &1 /\ \r
1377   &1 - ta * &1 / (ta - ta') + ta * &1 / (ta - ta') = &1 `]);;\r
1378 \r
1379 \r
1380 \r
1381 let LEMMA5 = prove(\r
1382 `!(a:real^N) b x. line x /\ {a, b} SUBSET x /\ ~(a = b) ==> x = aff {a, b}`,\r
1383 REWRITE_TAC[line; GSYM aff] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN \r
1384 REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN ASM_SIMP_TAC[AFFINE_AFF_HULL; \r
1385 AFFINE_CONTAIN_LINE] THEN STRIP_TR THEN \r
1386 ABBREV_TAC ` (ki : bool ) = aff {(v:real^N), (w:real^N)} \r
1387   SUBSET aff {(a:real^N), (b:real^N)}` THEN \r
1388 REWRITE_TAC[MESON[]` a/\b/\c ==> d <=> b ==> a/\c ==> d `] THEN SIMP_TAC[]\r
1389 THEN DISCH_TAC THEN IMP_IMP_TAC THEN \r
1390 NHANH (MESON[PRE_INVERSE_SUB]`{a, b} SUBSET aff {v, w} /\ aa /\ ~(a = b) \r
1391   ==> {v, w} SUBSET aff {a, b} `) THEN \r
1392 NHANH (MESON[AFFINE_AFF_HULL]` aa /\ v SUBSET aff {a, b} ==> affine (aff {a,b})`)\r
1393 THEN DOWN_TAC THEN MESON_TAC[AFFINE_CONTAIN_LINE]);;\r
1394 \r
1395 let RCEABUJ = LEMMA5;;\r
1396 \r
1397 \r
1398 let COL_EQ_UPS_0 = GEN_ALL (MESON[FHFMKIY]` collinear {(v1:real^3), v2, v3} <=>\r
1399  ups_x (dist (v1,v2) pow 2) (dist (v1,v3) pow 2) (dist (v2,v3) pow 2) = &0`);;\r
1400 \r
1401 \r
1402 \r
1403 let EQ_POW2_COND = prove(`!a b. &0 <= a /\ &0 <= b ==> (a = b <=> a pow 2 = b pow 2)`,\r
1404 REWRITE_TAC[REAL_ARITH` a = b <=> a <= b /\ b <= a `] THEN SIMP_TAC[POW2_COND]);;\r
1405 \r
1406 \r
1407 let D3_POS_LE = MESON[d3; DIST_POS_LE]` ! x y. &0 <= d3 x y `;;\r
1408 \r
1409 \r
1410 let delta_x12 = new_definition ` delta_x12 x12 x13 x14 x23 x24 x34 =\r
1411   -- x13 * x23 + -- x14 * x24 + x34 * ( -- x12 + x13 + x14 + x23 + x24 + -- x34 )\r
1412   + -- x12 * x34 + x13 * x24 + x14 * x23 `;;\r
1413 \r
1414 let delta_x13 = new_definition` delta_x13 x12 x13 x14 x23 x24 x34 =\r
1415   -- x12 * x23 + -- x14 * x34 + x12 * x34 + x24 * ( x12 + -- x13 + x14 + x23 + \r
1416   -- x24 + x34 ) + -- x13 * x24 + x14 * x23 `;;\r
1417 \r
1418 let delta_x14 = new_definition`delta_x14 x12 x13 x14 x23 x24 x34 =\r
1419          --x12 * x24 +\r
1420          --x13 * x34 +\r
1421          x12 * x34 +\r
1422          x13 * x24 +\r
1423          x23 * (x12 + x13 + --x14 + --x23 + x24 + x34) +\r
1424          --x14 * x23`;;\r
1425 \r
1426 \r
1427 \r
1428 let DIST_POW2_DOT = \r
1429 prove(` ! a (b:real^N) . dist (a,b) pow 2 = ( a - b ) dot ( a- b) `,\r
1430 SIMP_TAC[dist; vector_norm; DOT_POS_LE; SQRT_WORKS]);;\r
1431 \r
1432 \r
1433 \r
1434 (* the following lemma is in Multivariate/convex.ml *)\r
1435 let AFFINE_HULL_3 = new_axiom` affine hull {a,b,c} =\r
1436     { u % a + v % b + w % c | u + v + w = &1}`;;\r
1437 \r
1438 \r
1439 let LET_TR = CONV_TAC (TOP_DEPTH_CONV let_CONV);;\r
1440 \r
1441 \r
1442 (* BEGINING *)\r
1443 (* lemma 16 SDIHJZK *)\r
1444 \r
1445 let TO_UYCH = prove(` &0 < ups_x a12 a13 a23 ==>\r
1446   delta_x12 a01 a02 a03 a12 a13 a23 / ups_x a12 a13 a23 +\r
1447      delta_x13 a01 a02 a03 a12 a13 a23 / ups_x a12 a13 a23 +\r
1448      delta_x14 a01 a02 a03 a12 a13 a23 / ups_x a12 a13 a23 =\r
1449      &1 `,\r
1450 REWRITE_TAC[ups_x; delta_x12; delta_x13; delta_x14] THEN CONV_TAC REAL_FIELD);;\r
1451 \r
1452 \r
1453 \r
1454 \r
1455 let NOT_UPS_X_ZERO_IMP_SMT = prove(`~(ups_x a12 a13 a23 = &0)\r
1456  ==> (delta_x13 a01 a02 a03 a12 a13 a23 / ups_x a12 a13 a23) pow 2 * a12 +\r
1457      delta_x13 a01 a02 a03 a12 a13 a23 / ups_x a12 a13 a23 *\r
1458      delta_x14 a01 a02 a03 a12 a13 a23 / ups_x a12 a13 a23 *\r
1459      (a12 + a13 - a23) +\r
1460      (delta_x14 a01 a02 a03 a12 a13 a23 / ups_x a12 a13 a23) pow 2 * a13 \r
1461      =\r
1462      a01 - delta a01 a02 a03 a12 a13 a23 / ups_x a12 a13 a23 /\\r
1463 \r
1464 (delta_x14 a01 a02 a03 a12 a13 a23 / ups_x a12 a13 a23) pow 2 * a23 +\r
1465      delta_x14 a01 a02 a03 a12 a13 a23 / ups_x a12 a13 a23 *\r
1466      delta_x12 a01 a02 a03 a12 a13 a23 / ups_x a12 a13 a23 *\r
1467      (a23 + a12 - a13) +\r
1468      (delta_x12 a01 a02 a03 a12 a13 a23 / ups_x a12 a13 a23) pow 2 * a12 \r
1469       =\r
1470      a02 - delta a01 a02 a03 a12 a13 a23 / ups_x a12 a13 a23 /\\r
1471 \r
1472 (delta_x12 a01 a02 a03 a12 a13 a23 / ups_x a12 a13 a23) pow 2 * a13 +\r
1473      delta_x12 a01 a02 a03 a12 a13 a23 / ups_x a12 a13 a23 *\r
1474      delta_x13 a01 a02 a03 a12 a13 a23 / ups_x a12 a13 a23 *\r
1475      (a13 + a23 - a12) +\r
1476      (delta_x13 a01 a02 a03 a12 a13 a23 / ups_x a12 a13 a23) pow 2 * a23 =\r
1477      a03 - delta a01 a02 a03 a12 a13 a23 / ups_x a12 a13 a23`,\r
1478 ONCE_REWRITE_TAC[REAL_FIELD` ~( a = &0 ) ==> ( x = y ) /\ ( xx = yy ) /\ ( xxx = yyy)\r
1479   <=> ~( a = &0 ) ==> ( x * a pow 2 = y * a pow 2 ) /\\r
1480   ( xx * a pow 2 = yy * a pow 2 ) /\\r
1481   ( xxx * a pow 2 = yyy * a pow 2 ) `] THEN \r
1482 SIMP_TAC[REAL_FIELD` ~( a = &0 ) ==> ( b - c / a ) * a pow 2 = b * a pow 2 - c * a `\r
1483   ; REAL_ADD_RDISTRIB] THEN \r
1484 SIMP_TAC[REAL_ARITH` ( a * b ) * c = a * b * c `;\r
1485   REAL_FIELD` ~ ( a = &0 ) ==> ( b / a ) pow 2 * c * a pow 2 =\r
1486   b pow 2 * c `; REAL_FIELD ` ~ ( a = &0 ) ==> b / a * c / a * d * \r
1487   a pow 2 = b * c * d `] THEN DISCH_TAC THEN \r
1488 REWRITE_TAC[delta_x12; delta_x13; delta_x14; delta; ups_x] THEN REAL_ARITH_TAC);;\r
1489 \r
1490 \r
1491 let TROI_OI_DAT_HOI = MESON[ lemma8; dist; DIST_SYM]` &0 <=\r
1492            ups_x ( dist((v1:real^3),v2) pow 2) (dist(v2,v3) pow 2)\r
1493            (dist(v1,v3) pow 2)`;;\r
1494 \r
1495 \r
1496 \r
1497 let ZERO_LE_UPS_X = MESON[TROI_OI_DAT_HOI; d3; DIST_SYM]` \r
1498   &0 <= ups_x (d3 x y pow 2) (d3 x z pow 2) (d3 y z pow 2) `;;\r
1499 \r
1500 \r
1501 let UPS_X_EQ_ZERO_COND = prove(` ! v1 v2 (v3: real^3). (collinear {v1, v2, v3} <=>\r
1502             ups_x (dist (v1,v2) pow 2) (dist (v1,v3) pow 2)\r
1503             (dist (v2,v3) pow 2) =\r
1504             &0) `,\r
1505 MP_TAC FHFMKIY THEN MESON_TAC[]);;\r
1506 \r
1507 \r
1508 \r
1509 let NORM_POW2_SUM2 = prove(` norm ( a % x + b % y ) pow 2 =\r
1510   a pow 2 * norm x pow 2 + &2 * ( a * b ) * ( x dot y ) + \r
1511   b pow 2 * norm y pow 2 `, REWRITE_TAC[vector_norm] THEN \r
1512 SIMP_TAC[DOT_POS_LE; SQRT_WORKS] THEN CONV_TAC VECTOR_ARITH);;\r
1513 \r
1514 \r
1515 \r
1516 let X_DOT_X_EQ = prove( ` x dot x = norm x pow 2 `,\r
1517 SIMP_TAC[vector_norm; DOT_POS_LE; SQRT_WORKS]);;\r
1518 \r
1519 \r
1520 \r
1521 let SUB_DIST_POW2_INTERPRETE = prove(`! x y (v:real^N) c. \r
1522 dist(x,v) pow 2 - dist(y,v) pow 2 = c <=>\r
1523 ( &2 % v  - ( x + y )) dot ( y - x ) = c `,\r
1524 SIMP_TAC[DIST_POW2_DOT; DOT_SUB_ADD; VECTOR_ARITH`\r
1525  (x - v - (y - v)) dot (x - v + y - v) =  (&2 % v - (x + y)) dot (y - x) `]);;\r
1526 \r
1527 \r
1528 let SDIHJZK = prove(`! (v1:real^3) v2 v3 (a01: real) a02 a03.\r
1529          ~collinear {v1, v2, v3} /\\r
1530          (let x12 = d3 v1 v2 pow 2 in\r
1531           let x13 = d3 v1 v3 pow 2 in\r
1532           let x23 = d3 v2 v3 pow 2 in delta a01 a02 a03 x12 x13 x23 = &0)\r
1533          ==> (?!v0. a01 = d3 v0 v1 pow 2 /\\r
1534                     a02 = d3 v0 v2 pow 2 /\\r
1535                     a03 = d3 v0 v3 pow 2 /\\r
1536                     (let x12 = d3 v1 v2 pow 2 in\r
1537                      let x13 = d3 v1 v3 pow 2 in\r
1538                      let x23 = d3 v2 v3 pow 2 in\r
1539                      let vv = ups_x x12 x13 x23 in\r
1540                      let t1 = delta_x12 a01 a02 a03 x12 x13 x23 / vv in\r
1541                      let t2 = delta_x13 a01 a02 a03 x12 x13 x23 / vv in\r
1542                      let t3 = delta_x14 a01 a02 a03 x12 x13 x23 / vv in\r
1543                      v0 = t1 % v1 + t2 % v2 + t3 % v3 /\ t1 + t2 + t3 = &1 ))`, \r
1544 REPEAT GEN_TAC THEN \r
1545 LET_TR THEN \r
1546 STRIP_TAC THEN \r
1547 REWRITE_TAC[EXISTS_UNIQUE] THEN \r
1548 EXISTS_TAC ` delta_x12 a01 a02 a03 (d3 v1 v2 pow 2) (d3 v1 v3 pow 2)\r
1549        (d3 v2 v3 pow 2) /\r
1550        ups_x (d3 v1 v2 pow 2) (d3 v1 v3 pow 2) (d3 v2 v3 pow 2) %\r
1551        v1 +\r
1552        delta_x13 a01 a02 a03 (d3 v1 v2 pow 2) (d3 v1 v3 pow 2)\r
1553        (d3 v2 v3 pow 2) /\r
1554        ups_x (d3 v1 v2 pow 2) (d3 v1 v3 pow 2) (d3 v2 v3 pow 2) %\r
1555        v2 +\r
1556        delta_x14 a01 a02 a03 (d3 v1 v2 pow 2) (d3 v1 v3 pow 2)\r
1557        (d3 v2 v3 pow 2) /\r
1558        ups_x (d3 v1 v2 pow 2) (d3 v1 v3 pow 2) (d3 v2 v3 pow 2) %\r
1559        v3 ` THEN \r
1560 UNDISCH_TAC `~collinear {(v1:real^3), v2, v3}` THEN \r
1561 MP_TAC (GEN_ALL ZERO_LE_UPS_X) THEN \r
1562 REWRITE_TAC[UPS_X_EQ_ZERO_COND] THEN \r
1563 REWRITE_TAC[MESON[]` a ==> b ==> c <=> a /\ b ==> c `; d3] THEN \r
1564 NHANH (MESON[REAL_ARITH ` &0 <= a <=> &0 < a \/ a = &0 `]`\r
1565    (!(x:real^3) y z.\r
1566         &0 <= ups_x (dist (x,y) pow 2) (dist (x,z) pow 2) (dist (y,z) pow 2)) /\\r
1567    ~(ups_x (dist (v1,v2) pow 2) (dist (v1,v3) pow 2) (dist (v2,v3) pow 2) = &0)\r
1568     ==> &0 < ups_x (dist ((v1:real^3),v2) pow 2) (dist (v1,v3) pow 2) (dist (v2,v3) pow 2) `) THEN \r
1569 REWRITE_TAC[ GSYM d3] THEN \r
1570 STRIP_TAC THEN \r
1571 CONJ_TAC THENL [\r
1572 \r
1573 UNDISCH_TAC ` &0 < ups_x (d3 v1 v2 pow 2) (d3 v1 v3 pow 2) (d3 v2 v3 pow 2)` THEN \r
1574 ABBREV_TAC ` a12 = d3 v1 v2 pow 2 ` THEN ABBREV_TAC ` a13 = d3 v1 v3 pow 2 ` THEN \r
1575 ABBREV_TAC ` a23 = d3 v2 v3 pow 2 ` THEN SIMP_TAC[TO_UYCH] THEN \r
1576 REWRITE_TAC[MESON[d3; dist] ` aa = d3 a b pow 2 <=> aa = norm ( a- b ) pow 2 `] THEN \r
1577 ONCE_REWRITE_TAC[VECTOR_ARITH ` a - b = a - &1 % b `] THEN \r
1578 NHANH (GSYM TO_UYCH) THEN SIMP_TAC[] THEN \r
1579 SIMP_TAC[VECTOR_ARITH ` (a % v1 + b % v2 + c % v3) - (a + b + c) % v2 =\r
1580      (b % v2 + c % v3 + a % v1) - (b + c + a) % v2 /\\r
1581   (a % v1 + b % v2 + c % v3) - (a + b + c) % v3 = \r
1582   (c % v3 + a % v1 + b % v2 ) - ( c + a + b ) % v3 `] THEN \r
1583 REWRITE_TAC[VECTOR_ARITH` ( a % v1 + b % v2 + c % v3)  - \r
1584   ( a + b + c ) % v1 = b % ( v2 - v1 ) + c % ( v3 - v1 ) `] THEN \r
1585 REWRITE_TAC[NORM_POW2_SUM2 ; REAL_ARITH ` &2 * ( a * b ) * c = a * b * &2 * c `] THEN \r
1586 REWRITE_TAC[VECTOR_ARITH ` &2 * ( x dot y ) = x dot x + y dot y - ( x - y ) dot ( x - y ) `] THEN \r
1587 REWRITE_TAC[VECTOR_ARITH` v1 - v3 - (v2 - v3) = (v1:real^3) - v2 `] THEN \r
1588 REWRITE_TAC[X_DOT_X_EQ; GSYM dist; GSYM d3] THEN \r
1589 SIMP_TAC[D3_SYM] THEN ASM_SIMP_TAC[] THEN STRIP_TAC THEN \r
1590 UNDISCH_TAC ` ~(ups_x a12 a13 a23 = &0)` THEN NHANH NOT_UPS_X_ZERO_IMP_SMT  THEN \r
1591 ASM_SIMP_TAC[REAL_DIV_LZERO; REAL_SUB_RZERO];\r
1592 MESON_TAC[]]);;\r
1593 \r
1594 \r
1595 \r
1596 let HALF_OF_LE16 = prove(` ! (v1:real^3) v2 v3 (a01: real) a02 a03.\r
1597          ~collinear {v1, v2, v3} /\\r
1598          (let x12 = d3 v1 v2 pow 2 in\r
1599           let x13 = d3 v1 v3 pow 2 in\r
1600           let x23 = d3 v2 v3 pow 2 in delta a01 a02 a03 x12 x13 x23 = &0)\r
1601 ==> ?v0. (v0 IN aff {v1, v2, v3} /\\r
1602        a01 = d3 v0 v1 pow 2 /\\r
1603        a02 = d3 v0 v2 pow 2 /\\r
1604        a03 = d3 v0 v3 pow 2 /\\r
1605        (let x12 = d3 v1 v2 pow 2 in\r
1606         let x13 = d3 v1 v3 pow 2 in\r
1607         let x23 = d3 v2 v3 pow 2 in\r
1608         let vv = ups_x x12 x13 x23 in\r
1609         let t1 = delta_x12 a01 a02 a03 x12 x13 x23 / vv in\r
1610         let t2 = delta_x13 a01 a02 a03 x12 x13 x23 / vv in\r
1611         let t3 = delta_x14 a01 a02 a03 x12 x13 x23 / vv in\r
1612         v0 = t1 % v1 + t2 % v2 + t3 % v3)) `,\r
1613 REPEAT GEN_TAC THEN LET_TR THEN STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE] THEN \r
1614 EXISTS_TAC ` delta_x12 a01 a02 a03 (d3 v1 v2 pow 2) (d3 v1 v3 pow 2)\r
1615        (d3 v2 v3 pow 2) /\r
1616        ups_x (d3 v1 v2 pow 2) (d3 v1 v3 pow 2) (d3 v2 v3 pow 2) %\r
1617        v1 +\r
1618        delta_x13 a01 a02 a03 (d3 v1 v2 pow 2) (d3 v1 v3 pow 2)\r
1619        (d3 v2 v3 pow 2) /\r
1620        ups_x (d3 v1 v2 pow 2) (d3 v1 v3 pow 2) (d3 v2 v3 pow 2) %\r
1621        v2 +\r
1622        delta_x14 a01 a02 a03 (d3 v1 v2 pow 2) (d3 v1 v3 pow 2)\r
1623        (d3 v2 v3 pow 2) /\r
1624        ups_x (d3 v1 v2 pow 2) (d3 v1 v3 pow 2) (d3 v2 v3 pow 2) %\r
1625        v3 ` THEN \r
1626 UNDISCH_TAC `~collinear {(v1:real^3), v2, v3}` THEN \r
1627 MP_TAC (GEN_ALL ZERO_LE_UPS_X) THEN \r
1628 REWRITE_TAC[UPS_X_EQ_ZERO_COND] THEN \r
1629 REWRITE_TAC[MESON[]` a ==> b ==> c <=> a /\ b ==> c `; d3] THEN \r
1630 NHANH (MESON[REAL_ARITH ` &0 <= a <=> &0 < a \/ a = &0 `]`\r
1631    (!(x:real^3) y z.\r
1632         &0 <= ups_x (dist (x,y) pow 2) (dist (x,z) pow 2) (dist (y,z) pow 2)) /\\r
1633    ~(ups_x (dist (v1,v2) pow 2) (dist (v1,v3) pow 2) (dist (v2,v3) pow 2) = &0)\r
1634     ==> &0 < ups_x (dist ((v1:real^3),v2) pow 2) (dist (v1,v3) pow 2) (dist (v2,v3) pow 2) `) THEN \r
1635 REWRITE_TAC[ GSYM d3] THEN \r
1636 STRIP_TAC THEN \r
1637 UNDISCH_TAC ` &0 < ups_x (d3 v1 v2 pow 2) (d3 v1 v3 pow 2) (d3 v2 v3 pow 2)` THEN \r
1638 ABBREV_TAC ` a12 = d3 v1 v2 pow 2 ` THEN ABBREV_TAC ` a13 = d3 v1 v3 pow 2 ` THEN \r
1639 ABBREV_TAC ` a23 = d3 v2 v3 pow 2 ` THEN SIMP_TAC[TO_UYCH] THEN \r
1640 REWRITE_TAC[MESON[d3; dist] ` aa = d3 a b pow 2 <=> aa = norm ( a- b ) pow 2 `] THEN \r
1641 ONCE_REWRITE_TAC[VECTOR_ARITH ` a - b = a - &1 % b `] THEN \r
1642 NHANH (GSYM TO_UYCH) THEN SIMP_TAC[] THEN \r
1643 SIMP_TAC[VECTOR_ARITH ` (a % v1 + b % v2 + c % v3) - (a + b + c) % v2 =\r
1644      (b % v2 + c % v3 + a % v1) - (b + c + a) % v2 /\\r
1645   (a % v1 + b % v2 + c % v3) - (a + b + c) % v3 = \r
1646   (c % v3 + a % v1 + b % v2 ) - ( c + a + b ) % v3 `] THEN \r
1647 REWRITE_TAC[VECTOR_ARITH` ( a % v1 + b % v2 + c % v3)  - \r
1648   ( a + b + c ) % v1 = b % ( v2 - v1 ) + c % ( v3 - v1 ) `] THEN \r
1649 REWRITE_TAC[NORM_POW2_SUM2 ; REAL_ARITH ` &2 * ( a * b ) * c = a * b * &2 * c `] THEN \r
1650 REWRITE_TAC[VECTOR_ARITH ` &2 * ( x dot y ) = x dot x + y dot y - ( x - y ) dot ( x - y ) `] THEN \r
1651 REWRITE_TAC[VECTOR_ARITH` v1 - v3 - (v2 - v3) = (v1:real^3) - v2 `] THEN \r
1652 REWRITE_TAC[X_DOT_X_EQ; GSYM dist; GSYM d3] THEN \r
1653 SIMP_TAC[D3_SYM] THEN ASM_SIMP_TAC[] THEN STRIP_TAC THEN \r
1654 UNDISCH_TAC ` ~(ups_x a12 a13 a23 = &0)` THEN NHANH NOT_UPS_X_ZERO_IMP_SMT  THEN \r
1655 ASM_SIMP_TAC[REAL_DIV_LZERO; REAL_SUB_RZERO] THEN \r
1656 REWRITE_TAC[aff; AFFINE_HULL_3; IN_ELIM_THM] THEN ASM_MESON_TAC[]);;\r
1657 \r
1658 \r
1659 \r
1660 \r
1661 let EQ_SUB_DIST_POW2_IMP_IDENTIFIED = prove(` ! v1 v2 v3 (u:real^N) w. \r
1662 {u,w} SUBSET affine hull {v1,v2,v3} /\\r
1663 dist (u,v2) pow 2 - dist (u,v1) pow 2 = dist (w,v2) pow 2 - dist (w,v1) pow 2 /\\r
1664 dist (u,v3) pow 2 - dist (u,v1) pow 2 = dist (w,v3) pow 2 - dist (w,v1) pow 2 ==>\r
1665 w = u `, \r
1666 REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN \r
1667 SIMP_TAC[SUB_DIST_POW2_INTERPRETE ] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN \r
1668 SIMP_TAC[SUB_DIST_POW2_INTERPRETE ] THEN \r
1669 ONCE_REWRITE_TAC[REAL_ARITH` a = b <=> a - b = &0 `] THEN \r
1670 SIMP_TAC[GSYM DOT_LSUB] THEN \r
1671 SIMP_TAC[GSYM DOT_LSUB; VECTOR_ARITH` a - b - ( aa - b ) =\r
1672   (a:real^N) - aa `; GSYM VECTOR_SUB_LDISTRIB; AFFINE_HULL_3;\r
1673   SET2_SU_EX; IN_ELIM_THM] THEN STRIP_TAC THEN \r
1674 REPEAT (FIRST_X_ASSUM MP_TAC ) THEN \r
1675 REWRITE_TAC[MESON[]` a ==> b ==> c <=> b /\ a ==> c `] THEN \r
1676 NHANH (MESON[]` a = (aa:real^N) /\ la /\ b = bb /\ lb ==>\r
1677   a - b = aa - bb `) THEN \r
1678 REWRITE_TAC[REAL_ARITH` a + b = &1 <=> a = &1 - b `] THEN PHA THEN \r
1679 STRIP_TAC THEN FIRST_X_ASSUM MP_TAC THEN UNDISCH_TAC`u' = &1 - (v + w')` THEN \r
1680 UNDISCH_TAC`u'' = &1 - (v' + w'')` THEN SIMP_TAC[] THEN \r
1681 SIMP_TAC[VECTOR_ARITH` ((&1 - (v' + w'')) % v1 + v' % v2 + w'' % v3) -\r
1682      ((&1 - (v + w')) % v1 + v % v2 + w' % v3) =\r
1683   ( v - v' ) % ( v1 - v2 ) + (w' - w'' ) % ( v1 - v3 ) `] THEN \r
1684 REPEAT STRIP_TAC THEN \r
1685 ONCE_REWRITE_TAC[VECTOR_ARITH ` a = b <=> b - a = vec 0` ] THEN \r
1686 REWRITE_TAC[GSYM DOT_EQ_0] THEN FIRST_X_ASSUM MP_TAC THEN \r
1687 REWRITE_TAC[MESON[]` a = b ==> a dot a = &0 <=> a = b ==>\r
1688   a dot b = &0 `] THEN \r
1689 REWRITE_TAC[DOT_RADD; DOT_RMUL; REAL_ARITH ` a * ( b dot c ) + aa * bb = &0\r
1690   <=> a * &2 * ( b dot c ) + aa * &2 * bb = &0 `] THEN \r
1691 ONCE_REWRITE_TAC[GSYM DOT_LMUL] THEN \r
1692 ABBREV_TAC ` as = &2 % ((w:real^N) - u) dot (v1 - v2)` THEN \r
1693 ABBREV_TAC ` bs = &2 % ((w:real^N) - u) dot (v1 - v3)` THEN \r
1694 DISCH_TAC THEN ASM_SIMP_TAC[] THEN REAL_ARITH_TAC);;\r
1695 \r
1696 (* lemma 16 SDIHJZK *)\r
1697 \r
1698 let SDIHJZK = prove(`! (v1:real^3) v2 v3 (a01: real) a02 a03.\r
1699          ~collinear {v1, v2, v3} /\\r
1700          (let x12 = d3 v1 v2 pow 2 in\r
1701           let x13 = d3 v1 v3 pow 2 in\r
1702           let x23 = d3 v2 v3 pow 2 in delta a01 a02 a03 x12 x13 x23 = &0)\r
1703          ==> (?v0. v0 IN aff {v1,v2,v3} /\\r
1704                     a01 = d3 v0 v1 pow 2 /\\r
1705                     a02 = d3 v0 v2 pow 2 /\\r
1706                     a03 = d3 v0 v3 pow 2 /\ \r
1707                    (! vv0. vv0 IN aff {v1,v2,v3} /\\r
1708                     a01 = d3 vv0 v1 pow 2 /\\r
1709                     a02 = d3 vv0 v2 pow 2 /\\r
1710                     a03 = d3 vv0 v3 pow 2 ==> vv0 = v0 ) /\\r
1711                     (let x12 = d3 v1 v2 pow 2 in\r
1712                      let x13 = d3 v1 v3 pow 2 in\r
1713                      let x23 = d3 v2 v3 pow 2 in\r
1714                      let vv = ups_x x12 x13 x23 in\r
1715                      let t1 = delta_x12 a01 a02 a03 x12 x13 x23  / vv in\r
1716                      let t2 = delta_x13 a01 a02 a03 x12 x13 x23  / vv in\r
1717                      let t3 = delta_x14 a01 a02 a03 x12 x13 x23  / vv in\r
1718                      v0 = t1 % v1 + t2 % v2 + t3 % v3))`,\r
1719 REPEAT GEN_TAC THEN NHANH (SPEC_ALL HALF_OF_LE16  ) THEN STRIP_TAC THEN \r
1720 EXISTS_TAC `v0:real^3` THEN ASM_SIMP_TAC[] THEN \r
1721 GEN_TAC THEN UNDISCH_TAC ` (v0:real^3) IN aff {v1, v2, v3}` THEN \r
1722 ONCE_REWRITE_TAC[REAL_ARITH ` a1 = b1 /\ a2 = b2 /\ a3 = b3 <=>\r
1723   a2 - a1 = b2 - b1 /\ a3 - a1 = b3 - b1 /\ a1 = b1 `] THEN \r
1724 REWRITE_TAC[aff; SET2_SU_EX] THEN REWRITE_TAC[d3] THEN \r
1725 PHA THEN MESON_TAC[SET2_SU_EX; EQ_SUB_DIST_POW2_IMP_IDENTIFIED]);;\r
1726 \r
1727 \r
1728 \r
1729 let SDIHJZK_INTERPRETE = prove(`!(v1:real^3) v2 v3 a01 a02 a03.\r
1730      ~collinear {v1, v2, v3} /\\r
1731      delta a01 a02 a03 (d3 v1 v2 pow 2) (d3 v1 v3 pow 2) (d3 v2 v3 pow 2) =\r
1732      &0\r
1733      ==> (?v0. v0 IN aff {v1, v2, v3} /\\r
1734                a01 = d3 v0 v1 pow 2 /\\r
1735                a02 = d3 v0 v2 pow 2 /\\r
1736                a03 = d3 v0 v3 pow 2 /\\r
1737                (!vv0. vv0 IN aff {v1, v2, v3} /\\r
1738                       a01 = d3 vv0 v1 pow 2 /\\r
1739                       a02 = d3 vv0 v2 pow 2 /\\r
1740                       a03 = d3 vv0 v3 pow 2\r
1741                       ==> vv0 = v0) /\\r
1742                v0 =\r
1743                delta_x12 a01 a02 a03 (d3 v1 v2 pow 2) (d3 v1 v3 pow 2)\r
1744                (d3 v2 v3 pow 2) /\r
1745                ups_x (d3 v1 v2 pow 2) (d3 v1 v3 pow 2) (d3 v2 v3 pow 2) %\r
1746                v1 +\r
1747                delta_x13 a01 a02 a03 (d3 v1 v2 pow 2) (d3 v1 v3 pow 2)\r
1748                (d3 v2 v3 pow 2) /\r
1749                ups_x (d3 v1 v2 pow 2) (d3 v1 v3 pow 2) (d3 v2 v3 pow 2) %\r
1750                v2 +\r
1751                delta_x14 a01 a02 a03 (d3 v1 v2 pow 2) (d3 v1 v3 pow 2)\r
1752                (d3 v2 v3 pow 2) /\r
1753                ups_x (d3 v1 v2 pow 2) (d3 v1 v3 pow 2) (d3 v2 v3 pow 2) %\r
1754                v3)`, MP_TAC SDIHJZK THEN LET_TR THEN SIMP_TAC[]);;\r
1755 \r
1756 \r
1757 \r
1758 let DELTA_RRR_INTERPRETE = prove(` delta r r r a b c = -- a * b * c + r * ups_x a b c `,\r
1759 REWRITE_TAC[delta; ups_x] THEN REAL_ARITH_TAC);;\r
1760 \r
1761 \r
1762 let NOT_UPS_X_EQ_0_IMP = prove(` ~( ups_x a b c = &0 ) \r
1763  ==> delta ( ( a * b * c ) / ups_x a b c ) ( ( a * b * c ) / ups_x a b c ) \r
1764   ( ( a * b * c ) / ups_x a b c ) a b c = &0 `,\r
1765 REWRITE_TAC[DELTA_RRR_INTERPRETE ] THEN CONV_TAC REAL_FIELD);;\r
1766 \r
1767 \r
1768 \r
1769 \r
1770 let COL_EQ_UPS_0 = GEN_ALL (MESON[FHFMKIY]` collinear {(v1:real^3), v2, v3} <=>\r
1771  ups_x (dist (v1,v2) pow 2) (dist (v1,v3) pow 2) (dist (v2,v3) pow 2) = &0`);;\r
1772 \r
1773 \r
1774 (* CDEUSDF POST ZERO_LE_UPS_X *)\r
1775 \r
1776 \r
1777 \r
1778 \r
1779 let PROVE_EXISTS_RADV = prove(`!(va:real^3) vb vc.\r
1780      ~collinear {va, vb, vc}\r
1781      ==> (?p. p IN affine hull {va, vb, vc} /\\r
1782               (?c. ( !w. w IN {va, vb, vc} ==> c = dist (p,w)) /\\r
1783                  (!p'. p' IN affine hull {va, vb, vc} /\\r
1784                     ( !w. w IN {va, vb, vc} ==> c = dist (p',w))\r
1785                     ==> p = p'))) `,\r
1786 REWRITE_TAC[COL_EQ_UPS_0] THEN \r
1787 NHANH (NOT_UPS_X_EQ_0_IMP ) THEN \r
1788 REWRITE_TAC[GSYM COL_EQ_UPS_0] THEN \r
1789 REWRITE_TAC[GSYM d3] THEN \r
1790 NHANH (SPEC_ALL SDIHJZK_INTERPRETE) THEN \r
1791 REWRITE_TAC[EXISTS_UNIQUE] THEN \r
1792 REPEAT STRIP_TAC THEN \r
1793 ABBREV_TAC ` r = (d3 va vb pow 2 * d3 va vc pow 2 * d3 vb vc pow 2) /\r
1794       ups_x (d3 va vb pow 2) (d3 va vc pow 2) (d3 vb vc pow 2)  ` THEN \r
1795 EXISTS_TAC ` v0 :real^3` THEN \r
1796 UNDISCH_TAC ` (v0:real^3) IN aff {va, vb, vc}` THEN \r
1797 SIMP_TAC[aff; SET_RULE ` (! x. x IN {a,b,c} ==> P x ) <=>\r
1798   P a /\ P b /\ P c `] THEN \r
1799 DISCH_TAC THEN EXISTS_TAC ` sqrt ( r ) ` THEN \r
1800 UNDISCH_TAC ` (d3 va vb pow 2 * d3 va vc pow 2 * d3 vb vc pow 2) /\r
1801       ups_x (d3 va vb pow 2) (d3 va vc pow 2) (d3 vb vc pow 2) = r` THEN \r
1802 NHANH (MESON[REAL_LE_SQUARE_POW; REAL_LE_DIV; REAL_LE_MUL; \r
1803   ZERO_LE_UPS_X ]` (d3 va vb pow 2 * d3 va vc pow 2 * d3 vb vc pow 2) /\r
1804  ups_x (d3 va vb pow 2) (d3 va vc pow 2) (d3 vb vc pow 2) =\r
1805  r ==> &0 <= r `) THEN \r
1806 SIMP_TAC[SQRT_WORKS; EQ_POW2_COND; D3_POS_LE] THEN \r
1807 ASM_MESON_TAC[aff]);;\r
1808 \r
1809 \r
1810 \r
1811 \r
1812 let COND_FOR_CIRCUMCENTER_PROPERTIESS = prove(`~collinear {(v1:real^3), v2, v3}\r
1813  ==> circumcenter {v1, v2, v3} IN affine hull {v1, v2, v3} /\\r
1814      (?c. !v. v IN {v1, v2, v3} ==> c = dist (circumcenter {v1, v2, v3}, v))`,\r
1815 NHANH (MESON[PROVE_EXISTS_RADV]`~collinear {(va:real^3), vb, vc}\r
1816          ==> (?p. p IN affine hull {va, vb, vc} /\\r
1817                   (?c. (!w. w IN {va, vb, vc} ==> c = dist (p,w)))) `) THEN \r
1818 REWRITE_TAC[IN; circumcenter] THEN MESON_TAC[EXISTS_THM]);;\r
1819 \r
1820 \r
1821 let DELTA_X14_RRR = prove(` delta_x14 r r r a b c = a * ( b + c - a ) `,\r
1822 REWRITE_TAC[delta_x14] THEN REAL_ARITH_TAC);;\r
1823 \r
1824 \r
1825 let DELTA_X1I_RRR = prove(` delta_x12 r r r a b c = c * ( b + a - c ) /\\r
1826   delta_x13 r r r a b c = b * ( c + a  - b ) /\\r
1827   delta_x14 r r r a b c = a * (c + b - a) `,\r
1828 REWRITE_TAC[delta_x12; delta_x13; delta_x14] THEN REAL_ARITH_TAC);;\r
1829 \r
1830 \r
1831 \r
1832 \r
1833 \r
1834 let PRE_RADV_COND = prove(` ~ collinear {va,vb,vc} ==>\r
1835 (? c. ! w. {va,vb,(vc:real^3)} w ==> c = dist(circumcenter {va,vb,vc} , w )) `,\r
1836 NHANH (COND_FOR_CIRCUMCENTER_PROPERTIESS ) THEN MESON_TAC[IN]);;\r
1837 \r
1838 \r
1839 let NOT_COL_IMP_RADV_PROPERTIY = prove(` ~collinear {(va:real^3), vb, vc}\r
1840  ==>  ( ! w. {va, vb, vc} w ==> \r
1841   radV {va, vb, vc} = dist (circumcenter {va, vb, vc},w)) `,\r
1842 NHANH (PRE_RADV_COND ) THEN SIMP_TAC[EXISTS_THM; radV]);;\r
1843 \r
1844 \r
1845 \r
1846 \r
1847 let CIRCUMCENTER_FORMULAR2 = prove(`! (va:real^3) vb vc a b c.\r
1848      a = d3 vb vc /\ b = d3 va vc /\ c = d3 va vb /\ ~collinear {va, vb, vc}\r
1849      ==> \r
1850          (let al_a =\r
1851               (a pow 2 * (b pow 2 + c pow 2 - a pow 2)) /\r
1852               (ups_x (a pow 2) (b pow 2) (c pow 2)) in\r
1853           let al_b =\r
1854               (b pow 2 * (a pow 2 + c pow 2 - b pow 2)) /\r
1855               (ups_x (a pow 2) (b pow 2) (c pow 2)) in\r
1856           let al_c =\r
1857               (c pow 2 * (a pow 2 + b pow 2 - c pow 2)) /\r
1858               (ups_x (a pow 2) (b pow 2) (c pow 2)) in\r
1859           al_a % va + al_b % vb + al_c % vc = circumcenter {va, vb, vc})`,\r
1860 REWRITE_TAC[COL_EQ_UPS_0] THEN \r
1861 NHANH (NOT_UPS_X_EQ_0_IMP) THEN \r
1862 REWRITE_TAC[GSYM COL_EQ_UPS_0; GSYM d3] THEN \r
1863 NHANH (SPEC_ALL SDIHJZK_INTERPRETE ) THEN \r
1864 REPEAT STRIP_TAC THEN \r
1865 ABBREV_TAC ` r = (d3 va vb pow 2 * d3 va vc pow 2 * d3 vb vc pow 2) /\r
1866            ups_x (d3 va vb pow 2) (d3 va vc pow 2) (d3 vb vc pow 2) ` THEN \r
1867 UNDISCH_TAC ` v0 =\r
1868       delta_x12 r r r (d3 va vb pow 2) (d3 va vc pow 2) (d3 vb vc pow 2) /\r
1869       ups_x (d3 va vb pow 2) (d3 va vc pow 2) (d3 vb vc pow 2) %\r
1870       va +\r
1871       delta_x13 r r r (d3 va vb pow 2) (d3 va vc pow 2) (d3 vb vc pow 2) /\r
1872       ups_x (d3 va vb pow 2) (d3 va vc pow 2) (d3 vb vc pow 2) %\r
1873       vb +\r
1874       delta_x14 r r r (d3 va vb pow 2) (d3 va vc pow 2) (d3 vb vc pow 2) /\r
1875       ups_x (d3 va vb pow 2) (d3 va vc pow 2) (d3 vb vc pow 2) %\r
1876       vc`  THEN \r
1877 LET_TR THEN \r
1878 UNDISCH_TAC ` a = d3 vb vc ` THEN \r
1879 UNDISCH_TAC ` b = d3 va vc ` THEN \r
1880 UNDISCH_TAC ` c = d3 va vb ` THEN \r
1881 SIMP_TAC[DELTA_X1I_RRR] THEN \r
1882 SIMP_TAC[MESON[UPS_X_SYM]` ups_x a b c = ups_x c b a `] THEN \r
1883 ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN \r
1884 SIMP_TAC[] THEN \r
1885 REPEAT STRIP_TAC THEN \r
1886 UNDISCH_TAC ` ~collinear {(va:real^3), vb, vc} ` THEN \r
1887 NHANH (COND_FOR_CIRCUMCENTER_PROPERTIESS) THEN \r
1888 REWRITE_TAC[SET_RULE ` (! x. x IN {a,b,c} ==> P x )\r
1889   <=> P a /\ P b /\ P c `] THEN \r
1890 REWRITE_TAC[SET_RULE ` (! x. x IN {a,b,c} ==> P x )\r
1891   <=> P a /\ P b /\ P c `; MESON[]` (? cc. cc = a /\ cc = b /\ cc = c)\r
1892   <=> a = b /\ a = c  `] THEN \r
1893 UNDISCH_TAC ` v0 IN aff {va, vb, (vc:real^3)}` THEN \r
1894 REWRITE_TAC[aff; SET_RULE ` a IN s ==> b /\ aa IN s /\ l ==>\r
1895   ll <=> b ==>  {a,aa} SUBSET s /\ l ==> ll `] THEN \r
1896 DISCH_TAC THEN \r
1897 UNDISCH_TAC` r = d3 v0 va pow 2 ` THEN \r
1898 UNDISCH_TAC` r = d3 v0 vb pow 2 ` THEN \r
1899 UNDISCH_TAC` r = d3 v0 vc pow 2 ` THEN \r
1900 REWRITE_TAC[MESON[]` r = a1 ==> r = a2 ==> r = a3 ==> l ==> ll <=>\r
1901   r = a1 /\ l /\ a2 = a3 /\ a1 = a3 ==> ll `;d3] THEN \r
1902 ONCE_REWRITE_TAC[MESON[]` dist(a,b) = s <=> s = dist(a,b) `] THEN \r
1903 SIMP_TAC[DIST_POS_LE; EQ_POW2_COND] THEN \r
1904 ONCE_REWRITE_TAC[REAL_ARITH` a = b <=> a - b = &0 `] THEN \r
1905 MESON_TAC[EQ_SUB_DIST_POW2_IMP_IDENTIFIED ]);;\r
1906 \r
1907 \r
1908 \r
1909 \r
1910 let NOT_COLL_IMP_RADV_FORMULAR = prove(`! (va:real^3) vb vc a b c.\r
1911      a = d3 vb vc /\ b = d3 va vc /\ c = d3 va vb /\ ~collinear {va, vb, vc}\r
1912      ==>  radV {va, vb, vc} = eta_y a b c`,\r
1913 REWRITE_TAC[COL_EQ_UPS_0] THEN \r
1914 NHANH (NOT_UPS_X_EQ_0_IMP) THEN \r
1915 REWRITE_TAC[GSYM COL_EQ_UPS_0; GSYM d3] THEN \r
1916 NHANH (SPEC_ALL SDIHJZK_INTERPRETE ) THEN \r
1917 REPEAT STRIP_TAC THEN \r
1918 ABBREV_TAC ` r = (d3 va vb pow 2 * d3 va vc pow 2 * d3 vb vc pow 2) /\r
1919            ups_x (d3 va vb pow 2) (d3 va vc pow 2) (d3 vb vc pow 2) ` THEN \r
1920 LET_TR THEN \r
1921 UNDISCH_TAC ` a = d3 vb vc ` THEN \r
1922 UNDISCH_TAC ` b = d3 va vc ` THEN \r
1923 UNDISCH_TAC ` c = d3 va vb ` THEN \r
1924 SIMP_TAC[DELTA_X1I_RRR] THEN \r
1925 SIMP_TAC[MESON[UPS_X_SYM]` ups_x a b c = ups_x c b a `] THEN \r
1926 ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN \r
1927 SIMP_TAC[] THEN \r
1928 REPEAT STRIP_TAC THEN \r
1929 UNDISCH_TAC ` ~collinear {(va:real^3), vb, vc} ` THEN \r
1930 NHANH (COND_FOR_CIRCUMCENTER_PROPERTIESS) THEN \r
1931 REWRITE_TAC[SET_RULE ` (! x. x IN {a,b,c} ==> P x )\r
1932   <=> P a /\ P b /\ P c `] THEN \r
1933 REWRITE_TAC[SET_RULE ` (! x. x IN {a,b,c} ==> P x )\r
1934   <=> P a /\ P b /\ P c `; MESON[]` (? cc. cc = a /\ cc = b /\ cc = c)\r
1935   <=> a = b /\ a = c  `] THEN \r
1936 UNDISCH_TAC ` v0 IN aff {va, vb, (vc:real^3)}` THEN \r
1937 REWRITE_TAC[aff; SET_RULE ` a IN s ==> b /\ aa IN s /\ l ==>\r
1938   ll <=> b ==>  {a,aa} SUBSET s /\ l ==> ll `] THEN \r
1939 DISCH_TAC THEN \r
1940 UNDISCH_TAC` r = d3 v0 va pow 2 ` THEN \r
1941 UNDISCH_TAC` r = d3 v0 vb pow 2 ` THEN \r
1942 UNDISCH_TAC` r = d3 v0 vc pow 2 ` THEN \r
1943 REWRITE_TAC[MESON[]` r = a1 ==> r = a2 ==> r = a3 ==> l ==> ll <=>\r
1944   r = a1 /\ l /\ a2 = a3 /\ a1 = a3 ==> ll `;d3] THEN \r
1945 ONCE_REWRITE_TAC[MESON[]` dist(a,b) = s <=> s = dist(a,b) `] THEN \r
1946 SIMP_TAC[DIST_POS_LE; EQ_POW2_COND] THEN \r
1947 ONCE_REWRITE_TAC[REAL_ARITH` a = b <=> a - b = &0 `] THEN \r
1948 REWRITE_TAC[MESON[]` ( a /\ a1 = &0 /\ a2 = &0 ) /\ b1 = &0 /\ b2 = &0 <=>\r
1949   b1 = &0 /\ b2 = &0 /\ a /\ b1 = a1 /\ b2 = a2 `] THEN \r
1950 NHANH (SPEC_ALL EQ_SUB_DIST_POW2_IMP_IDENTIFIED ) THEN \r
1951 STRIP_TAC THEN \r
1952 UNDISCH_TAC ` ~collinear {(va:real^3), vb, vc}` THEN \r
1953 NHANH (NOT_COL_IMP_RADV_PROPERTIY ) THEN \r
1954 FIRST_X_ASSUM MP_TAC THEN \r
1955 SIMP_TAC[] THEN \r
1956 SIMP_TAC[SET_RULE ` (!w. {va, vb, vc} w ==> P w ) <=>\r
1957   P va /\ P vb /\ P vc `] THEN \r
1958 REPEAT STRIP_TAC THEN \r
1959 EXPAND_TAC "a" THEN \r
1960 EXPAND_TAC "b" THEN \r
1961 EXPAND_TAC "c" THEN \r
1962 UNDISCH_TAC ` r - dist ((v0:real^3),vc) pow 2 = &0 ` THEN \r
1963 SIMP_TAC[REAL_ARITH` a - b = &0 <=> b = a `] THEN \r
1964 EXPAND_TAC "r" THEN \r
1965 REWRITE_TAC[eta_y; eta_x] THEN \r
1966 LET_TR THEN \r
1967 MP_TAC (GEN_ALL ZERO_LE_UPS_X) THEN \r
1968 SIMP_TAC[GSYM REAL_POW_2] THEN \r
1969 SIMP_TAC[REAL_ARITH` a * b * c = c * b * a `;\r
1970   UPS_X_SYM; d3] THEN \r
1971 MP_TAC (MESON[d3; DIST_POS_LE]` &0 <= d3 v0 vc `) THEN \r
1972 MP_TAC (MESON[REAL_LE_DIV; REAL_LE_MUL_EQ; REAL_LE_POW_2;REAL_LE_MUL; ZERO_LE_UPS_X;\r
1973 SQRT_WORKS]` &0 <= ((d3 va vb pow 2 * d3 va vc pow 2 * d3 vb vc pow 2) /\r
1974       ups_x (d3 va vb pow 2) (d3 va vc pow 2) (d3 vb vc pow 2)) /\\r
1975   &0 <= sqrt ((d3 va vb pow 2 * d3 va vc pow 2 * d3 vb vc pow 2) /\r
1976       ups_x (d3 va vb pow 2) (d3 va vc pow 2) (d3 vb vc pow 2)) `) THEN \r
1977 REWRITE_TAC[MESON[]` a ==> b ==> c <=> b /\ a ==> c `] THEN \r
1978 MATCH_MP_TAC (MESON[]` (a1 /\ a3 ==> l) ==> a1 /\a2 /\a3 ==> l`) THEN \r
1979 SIMP_TAC[d3; EQ_POW2_COND; SQRT_WORKS]);;\r
1980 \r
1981 \r
1982 let CDEUSDF = prove(`!(va:real^3) vb vc a b c.\r
1983      a = d3 vb vc /\ b = d3 va vc /\ c = d3 va vb /\ ~collinear {va, vb, vc}\r
1984      ==> (?p. p IN affine hull {va, vb, vc} /\\r
1985               (?c. ( !w. w IN {va, vb, vc} ==> c = dist (p,w)) /\\r
1986               (!p'. p' IN affine hull {va, vb, vc} /\\r
1987                     ( !w. w IN {va, vb, vc} ==> c = dist (p',w))\r
1988                     ==> p = p'))) /\\r
1989          (let al_a =\r
1990               (a pow 2 * (b pow 2 + c pow 2 - a pow 2)) /\r
1991               (ups_x (a pow 2) (b pow 2) (c pow 2)) in\r
1992           let al_b =\r
1993               (b pow 2 * (a pow 2 + c pow 2 - b pow 2)) /\r
1994               (ups_x (a pow 2) (b pow 2) (c pow 2)) in\r
1995           let al_c =\r
1996               (c pow 2 * (a pow 2 + b pow 2 - c pow 2)) /\r
1997               (ups_x (a pow 2) (b pow 2) (c pow 2)) in\r
1998           al_a % va + al_b % vb + al_c % vc = circumcenter {va, vb, vc}) /\\r
1999          radV {va, vb, vc} = eta_y a b c`,\r
2000 SIMP_TAC[PROVE_EXISTS_RADV; CIRCUMCENTER_FORMULAR2;  NOT_COLL_IMP_RADV_FORMULAR ]);;\r
2001 \r
2002 let LEMMA17 = CDEUSDF;;\r
2003 \r
2004 let DIST_EQ_IS_UNIQUE = prove(` {u, w} SUBSET affine hull {v1, v2, v3} /\\r
2005   dist (u,v2) = dist (u,v1) /\ dist (u,v3) = dist (u,v1) /\\r
2006   dist (w,v2) = dist (w,v1) /\ dist (w,v3) = dist (w,v1) ==>\r
2007   u = w `,\r
2008 SIMP_TAC[EQ_POW2_COND; DIST_POS_LE] THEN ONCE_REWRITE_TAC[REAL_ARITH`\r
2009  a = b <=> a - b = &0 `] THEN MESON_TAC[EQ_SUB_DIST_POW2_IMP_IDENTIFIED]);;\r
2010 \r
2011 \r
2012 let NEVER_USED_AGAIN = prove(` p IN affine hull {va, vb, vc} /\ c = dist (p,va) \r
2013 /\ c = dist (p,vb) /\ c = dist (p,vc)  ==>\r
2014   (! p'.  p' IN affine hull {va, vb, vc} /\\r
2015            dist (p',vb) = dist (p',va) /\\r
2016            dist (p',vc) = dist (p',va) <=>\r
2017   p' IN affine hull {va, vb, vc} /\\r
2018   c = dist (p',va) /\\r
2019   c = dist (p',vb) /\\r
2020   c = dist (p',vc) )`,\r
2021 MESON_TAC[DIST_EQ_IS_UNIQUE; SET2_SU_EX]);;\r
2022 \r
2023 \r
2024 \r
2025 let TRUONG_WELL = prove(`! (va:real^3) vb vc. ~collinear {va, vb, vc}\r
2026      ==> (?p. p IN affine hull {va, vb, vc} /\\r
2027               (?c. !w. w IN {va, vb, vc} ==> c = dist (p,w)) /\\r
2028               (!p'. p' IN affine hull {va, vb, vc} /\\r
2029                     (?c. !w. w IN {va, vb, vc} ==> c = dist (p',w))\r
2030                     ==> p = p'))`,\r
2031 NHANH (SPEC_ALL PROVE_EXISTS_RADV) THEN REPEAT STRIP_TAC THEN EXISTS_TAC `p:real^3`\r
2032 THEN CONJ_TAC THENL [ASM_SIMP_TAC[]; CONJ_TAC] THENL [ASM_MESON_TAC[]; \r
2033 REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC) THEN \r
2034 REWRITE_TAC[SET_RULE` (!a. a IN {x,y,z} ==> p a)\r
2035   <=> p x /\ p y /\ p z `] THEN \r
2036 REWRITE_TAC[MESON[]` (?c. c = a /\ c = b /\ c = cc ) <=>\r
2037  b = a /\ cc = a `]] THEN \r
2038 REWRITE_TAC[MESON[]` a ==> b ==> c <=> a /\b ==> c `] THEN \r
2039   PHA THEN MESON_TAC[NEVER_USED_AGAIN ]);;\r
2040 \r
2041 \r
2042 \r
2043 \r
2044 let NGAY_MONG6 = MESON[TRUONG_WELL] `! va vb (vc:real^3). \r
2045          ~collinear {va, vb, vc} ==> (?p. p IN affine hull {va, vb, vc} /\\r
2046                   (?c. !w. w IN {va, vb, vc} ==> c = dist (p,w))  ) `;;\r
2047 \r
2048 \r
2049 let CIRCUMCENTER_PROPTIES = prove(`!va vb (vc:real^3).\r
2050      ~collinear {va, vb, vc}\r
2051      ==> circumcenter {va, vb, vc} IN affine hull {va, vb, vc} /\\r
2052 (?c. !w. w IN {va, vb, vc}\r
2053                   ==> c = dist (circumcenter {va, vb, vc},w))`,\r
2054 NHANH (SPEC_ALL NGAY_MONG6) THEN REWRITE_TAC[IN; \r
2055 circumcenter; EXISTS_THM] THEN SIMP_TAC[]);;\r
2056 \r
2057 \r
2058 \r
2059 \r
2060 \r
2061 \r
2062 let SIMP_DOT_ALEM = prove(  `&0 < (b - a) dot x <=> x dot (a - b) < &0`,\r
2063 SIMP_TAC[DOT_SYM] THEN \r
2064 REWRITE_TAC[ REAL_ARITH ` a < &0 <=> &0 < -- a `; GSYM DOT_RNEG] THEN \r
2065 REWRITE_TAC[VECTOR_ARITH ` -- ((a:real^N) - b) = b - a `]);;\r
2066 \r
2067 \r
2068 \r
2069 \r
2070 let MONG7_ROI = prove(` ! p a (b:real^A). dist (p,a) = dist (p,b) <=> \r
2071   (p - &1 / &2 % ( a + b )) dot ( a - b)  = &0 `,\r
2072 REWRITE_TAC[ REAL_ARITH ` a = b <=> ~ ( a < b) /\ ~( b < a ) `; \r
2073 DIST_LT_HALF_PLANE] THEN \r
2074 REWRITE_TAC[VECTOR_ARITH` (p - &1 / &2 % (a + b)) dot (a - b)\r
2075   = &1 / &2 * ( (&2 % p - (a + b ) ) dot ( a- b ) )  `] THEN \r
2076 REWRITE_TAC[REAL_ARITH `( &1 / &2 * a < &0 <=> a < &0) /\ \r
2077 (&0 < &1 / &2 * a <=> &0 < a )`] THEN \r
2078 REWRITE_TAC[SIMP_DOT_ALEM] THEN \r
2079 SIMP_TAC[VECTOR_ARITH` (a - b) dot (c - d) = (b - a) dot (d - c)`; DOT_SYM; \r
2080 VECTOR_ADD_SYM] THEN MESON_TAC[]);;\r
2081 \r
2082 let LEMMA26 = prove(`!v1 v2 (v3:real^3) p.\r
2083      ~collinear {v1, v2, v3} /\ p = circumcenter {v1, v2, v3}\r
2084      ==> (p - &1 / &2 % (v1 + v2)) dot (v1 - v2) = &0 /\\r
2085          (p - &1 / &2 % (v2 + v3)) dot (v2 - v3) = &0 /\\r
2086          (p - &1 / &2 % (v3 + v1)) dot (v3 - v1) = &0`,\r
2087 NHANH (SPEC_ALL CIRCUMCENTER_PROPTIES) THEN \r
2088 NHANH (SET_RULE` (?c. !w. w IN {v1, v2, v3} ==> c = P w) ==> P v1 = P v2\r
2089   /\ P v2 = P v3 /\ P v3 = P v1 `) THEN \r
2090 SIMP_TAC[MONG7_ROI]);;\r
2091 \r
2092 let POXDVXO = LEMMA26;;\r
2093 \r
2094 \r
2095 \r
2096 let NOT_COLL_IMP_RADV_EQ_ETA_Y = MESON[prove(`!va vb vc a b c.\r
2097      a = d3 vb vc /\ b = d3 va vc /\ c = d3 va vb /\ ~collinear {va, vb, vc}\r
2098      ==> radV {va, vb, vc} = eta_y (d3 vb vc) (d3 va vc) (d3 va vb)`,\r
2099 SIMP_TAC[CDEUSDF])]` \r
2100   !va vb vc . ~collinear {va, vb, vc}\r
2101      ==> radV {va, vb, vc} = eta_y (d3 vb vc) (d3 va vc) (d3 va vb)`;;\r
2102 \r
2103 \r
2104  g ` ! x (y:real^N). collinear {x,y} `;;\r
2105 e (REPEAT GEN_TAC THEN REWRITE_TAC[collinear]);;\r
2106 e (EXISTS_TAC ` x -(y: real^N)`);;\r
2107 e (ASM_SIMP_TAC[SET_RULE` a = b ==> {a,b,c} = {a,c} `]);;\r
2108 e (REWRITE_TAC[IN_SET2]);;\r
2109 e (REPEAT GEN_TAC);;\r
2110 e (STRIP_TAC);;\r
2111 \r
2112 e (ASM_SIMP_TAC[] THEN EXISTS_TAC ` &0 ` THEN CONV_TAC VECTOR_ARITH);;\r
2113 \r
2114 e (ASM_SIMP_TAC[] THEN EXISTS_TAC ` &1 ` THEN CONV_TAC VECTOR_ARITH);;\r
2115 \r
2116 e (ASM_SIMP_TAC[] THEN EXISTS_TAC ` -- &1 ` THEN CONV_TAC VECTOR_ARITH);;\r
2117 \r
2118 e (ASM_SIMP_TAC[] THEN EXISTS_TAC ` &0 ` THEN CONV_TAC VECTOR_ARITH);;\r
2119 let COLLINEAR2 = top_thm();;\r
2120 \r
2121 \r
2122 let TWO_EQ_IMP_COL3 = prove(` ! (x:real^N) y z .  x = y ==> collinear {x, y, z} `,\r
2123 STRIP_TR THEN SIMP_TAC[SET_RULE` a = b ==> {a,b,c} = {a,c} `; COLLINEAR2]);;\r
2124 \r
2125 \r
2126 let NOT_CO_IMP_DIST_POS = prove(`! x y z. ~ collinear {x,y,z} ==> &0 < dist (x,y) `,\r
2127 NHANH (MESON[TWO_EQ_IMP_COL3]` ~collinear {x, y, z} ==> ~( x= y) `) THEN \r
2128 SIMP_TAC[DIST_POS_LT]);;\r
2129 \r
2130 \r
2131 let NOT_COLL_IMP_POS_SUM = prove( ` !x y z.\r
2132      ~collinear {x, y, z} ==> &0 < ( d3 x y + d3 y z + d3 z x) / &2 `,\r
2133 NHANH (SPEC_ALL NOT_CO_IMP_DIST_POS) THEN \r
2134 NHANH (MESON[DIST_POS_LE]` ~collinear {x, y, z} ==>\r
2135   &0 <= dist (y,z) /\ &0 <= dist (z,x) `) THEN \r
2136 SIMP_TAC[d3] THEN REAL_ARITH_TAC);;\r
2137 \r
2138 let PER_SET2 = SET_RULE ` {a,b} = {b,a} `;;\r
2139 \r
2140 \r
2141 let COLLINEAR_AS_IN_CONV2 = MESON[PER_SET2; COLLINERA_AS_IN_CONV2]`! x y (z:real^3). collinear {x, y, z} <=>\r
2142  x IN conv {y, z} \/ y IN conv {z, x} \/ z IN conv {x, y}`;;\r
2143 \r
2144 let COLLINEAR_IMP_POS_UPS2 = prove(` ! x y (z:real^3). ~ collinear {x,y,z} ==>\r
2145   &0 < ups_x_pow2 ( d3 x y ) ( d3 y z ) ( d3 z x ) `,\r
2146 REWRITE_TAC[PRE_HER] THEN NHANH (SPEC_ALL NOT_COLL_IMP_POS_SUM ) THEN \r
2147 REWRITE_TAC[COLLINEAR_AS_IN_CONV2] THEN REWRITE_TAC[MID_COND] THEN \r
2148 REWRITE_TAC[LENGTH_EQ_EX] THEN REWRITE_TAC[DE_MORGAN_THM] THEN \r
2149 SIMP_TAC[d3] THEN REPEAT GEN_TAC THEN SIMP_TAC[\r
2150 prove(` &0 < a ==> ( &0 < &16 * a * b <=> &0 < b ) `,\r
2151 REWRITE_TAC[REAL_ARITH ` &0 < &16 * a <=> &0 < a `] THEN \r
2152 REWRITE_TAC[REAL_LT_MUL_EQ])] THEN \r
2153 REWRITE_TAC[REAL_ARITH ` (a + b + c ) / &2 - a = ( b + c - a ) / &2 `] THEN \r
2154 REWRITE_TAC[REAL_ARITH ` (a + b + c ) / &2 - b = ( c + a - b ) / &2 `] THEN \r
2155 REWRITE_TAC[REAL_ARITH ` (a + b + c ) / &2 - c = ( a + b - c ) / &2 `] THEN \r
2156 REWRITE_TAC[REAL_ARITH ` a < b + c <=> &0 < ( b + c - a ) / &2 `] THEN \r
2157 SIMP_TAC[DIST_SYM] THEN SIMP_TAC[REAL_ARITH ` a + b - c = b + a - c `] THEN \r
2158 SIMP_TAC[REAL_LT_MUL]);;\r
2159 \r
2160 \r
2161 \r
2162 let RADV_FORMULAR = MESON[CDEUSDF]` !(va:real^3) vb vc.\r
2163      ~collinear {va, vb, vc}\r
2164      ==> radV {va, vb, vc} = eta_y (d3 vb vc) (d3 va vc) (d3 va vb)`;;\r
2165 \r
2166 \r
2167 \r
2168 let MUL3_SYM = REAL_ARITH ` ! a b c. a * b * c = b * a * c /\\r
2169   a * b * c = c * b * a `;;\r
2170 \r
2171 let ETA_X_SYMM = prove(` ! a b c. eta_x a b c = eta_x b a c /\\r
2172  eta_x a b c = eta_x c b a `,SIMP_TAC[eta_x; MUL3_SYM; UPS_X_SYM]);;\r
2173 \r
2174 let ETA_Y_SYYM = prove(` ! x y z. eta_y x y z = eta_y y x z /\ \r
2175 eta_y x y z = eta_y z y x `, REWRITE_TAC[eta_y] THEN \r
2176 CONV_TAC (TOP_DEPTH_CONV let_CONV) THEN MESON_TAC[ETA_X_SYMM]);;\r
2177 \r
2178 \r
2179 \r
2180 let NOT_COL3_IMP_DIFF = MESON[PER_SET3; TWO_EQ_IMP_COL3]`!a b c. \r
2181 ~collinear {a, b, c} ==> ~(a = b \/ a = c \/ b = c)`;;\r
2182 \r
2183 let LET_TR = CONV_TAC (TOP_DEPTH_CONV let_CONV);;\r
2184 \r
2185 \r
2186 let POW2_COND_LT = MESON[POW2_COND; REAL_ARITH ` &0 < a ==> &0 <= a `]` \r
2187   !a b. &0 < a /\ &0 < b ==> (a <= b <=> a pow 2 <= b pow 2)`;;\r
2188 \r
2189 \r
2190 let ETA_Y_2 = prove(` eta_y (&2) (&2) (&2)  = &2 / sqrt (&3) `,\r
2191 REWRITE_TAC[eta_y; eta_x; ups_x] THEN \r
2192 LET_TR THEN \r
2193 REWRITE_TAC[REAL_ARITH ` ((&2 * &2) * (&2 * &2) * &2 * &2) /\r
2194   (--(&2 * &2) * &2 * &2 - (&2 * &2) * &2 * &2 - (&2 * &2) * &2 * &2 +\r
2195    &2 * (&2 * &2) * &2 * &2 +\r
2196    &2 * (&2 * &2) * &2 * &2 +\r
2197    &2 * (&2 * &2) * &2 * &2) = &4 / &3 `] THEN \r
2198 MP_TAC (MESON[REAL_LT_DIV; MESON[SQRT_POS_LT; REAL_ARITH` &0 < &3 `] ` \r
2199 &0 < sqrt (&3) `; REAL_ARITH ` &0 < &2 /\ &0 < &4 /\ &0 < &3 `] ` &0 < &4 / &3 \r
2200 /\ &0 < &2 / sqrt (&3) `) THEN \r
2201 REWRITE_TAC[REAL_ARITH` a = b <=> a <= b /\ b <= a `] THEN \r
2202 SIMP_TAC[SQRT_POS_LT; POW2_COND_LT] THEN \r
2203 REWRITE_TAC[GSYM (REAL_ARITH` a = b <=> a <= b /\ b <= a `)] THEN \r
2204 SIMP_TAC[REAL_LT_IMP_LE; SQRT_POW_2] THEN \r
2205 REWRITE_TAC[REAL_FIELD` (a/ b) pow 2 = a pow 2 / ( b pow 2 ) `] THEN \r
2206 SIMP_TAC[REAL_ARITH ` &0 <= &3 `; SQRT_POW_2] THEN \r
2207 REAL_ARITH_TAC);;\r
2208 \r
2209 let D3_POS_LE = MESON[d3; DIST_POS_LE]` ! x y. &0 <= d3 x y `;;\r
2210 \r
2211 \r
2212 (* le 19. p 17 *)\r
2213 let BYOWBDF = new_axiom`! a b c a' b' ( c':real). &0 < a /\\r
2214          a <= a' /\\r
2215          &0 < b /\\r
2216          b <= b' /\\r
2217          &0 < c /\\r
2218          c <= c' /\\r
2219          a' pow 2 <= b pow 2 + c pow 2 /\\r
2220          b' pow 2 <= a pow 2 + c pow 2 /\\r
2221          c' pow 2 <= a pow 2 + b pow 2\r
2222          ==> eta_y a b c <= eta_y a' b' c' `;;\r
2223 \r
2224 \r
2225 let LEMMA25 = prove(` !(a:real^3) b c.\r
2226  packing {a, b, c} /\ ~ collinear {a,b,c}\r
2227          ==> &2 / sqrt (&3) <= radV {a, b, c} `, \r
2228 SIMP_TAC[RADV_FORMULAR] THEN REPEAT GEN_TAC THEN \r
2229 ASM_CASES_TAC ` (? x. x IN  { d3 b c, d3 c a, d3 a b } /\ &4 / sqrt (&3)\r
2230     <= x ) ` THENL [DOWN_TAC THEN STRIP_TAC THEN DOWN_TAC THEN \r
2231 NHANH (SPEC_ALL COLLINEAR_IMP_POS_UPS2) THEN \r
2232 REWRITE_TAC[d3] THEN NHANH (MESON[DIST_POS_LE; HVXIKHW]` \r
2233 &0 < ups_x_pow2 (dist (a,b)) (dist (b,c)) (dist (c,a))\r
2234   ==> max_real3 (dist (a,b)) (dist (b,c)) (dist (c,a)) / &2 <=\r
2235  eta_y (dist (a,b)) (dist (b,c)) (dist (c,a)) `) THEN \r
2236 REWRITE_TAC[REAL_ARITH` a / &2 <= b <=> a <= &2 * b `; MAX_REAL3_LESS_EX] THEN \r
2237 NHANH (SET_RULE ` x IN { a , b, c } /\ a1/\a2/\a3/\a4 /\ c <= aa /\ a <= aa\r
2238   /\ b <= aa ==> x <= aa `) THEN REWRITE_TAC[MESON[]` a/ b <= aa /\ l <=> l \r
2239 /\ a/b <= aa `] THEN PHA THEN DAO THEN \r
2240 NHANH (MESON[REAL_LE_TRANS]` a <= b /\ c <= a /\ l ==> c <= b `) THEN \r
2241 MATCH_MP_TAC (MESON[]` ( b ==> c ) ==> a/\b ==> c `) THEN \r
2242 REWRITE_TAC[REAL_ARITH ` &4 / a <= &2 * b <=> &2 / a <= b `] THEN \r
2243 MESON_TAC[DIST_SYM; ETA_Y_SYYM]; REWRITE_TAC[packing] THEN \r
2244 NHANH (SPEC_ALL NOT_COL3_IMP_DIFF) THEN \r
2245 NHANH (SET_RULE` (!u v. {a, b, c} u /\ {a, b, c} v /\ ~(u = v) ==> P u v )\r
2246   /\ l /\ ~(a = b \/ a = c \/ b = c) ==> P a b /\ P b c /\ P c a `) THEN \r
2247 DOWN_TAC THEN REWRITE_TAC[NOT_EXISTS_THM] THEN \r
2248 NHANH (SET_RULE` (! x. ~( x IN {a,b,c} /\ P x )) ==> ~ P a /\ ~P b /\ ~P c`) THEN \r
2249 SIMP_TAC[MESON[REAL_LE_DIV; SQRT_POS_LE; REAL_ARITH ` &0 <= &3 /\ &0 <= &4 `]`\r
2250      &0 <=  &4 / sqrt (&3)  `; D3_POS_LE; POW2_COND] THEN \r
2251 REWRITE_TAC[REAL_ARITH` ~( a <= b ) <=> b < a `] THEN \r
2252 REWRITE_TAC[REAL_FIELD` ( &4 / a ) pow 2 = &16 / ( a pow 2 ) `] THEN \r
2253 SIMP_TAC[REAL_ARITH` &0 <= &3 `; SQRT_POW_2] THEN \r
2254 NHANH (REAL_ARITH ` a < &16 / &3 ==> a <= &2 pow 2 + &2 pow 2 `) THEN \r
2255 PHA THEN REWRITE_TAC[MESON[]` a <= b + c /\ d <=> d /\ a <= b + c `] THEN \r
2256 REWRITE_TAC[GSYM d3] THEN PHA THEN \r
2257 NHANH (MESON[REAL_ARITH `&0 < &2 `; BYOWBDF]`&2 <= d3 a b /\\r
2258  &2 <= d3 b c /\ &2 <= d3 c a /\ d3 a b pow 2 <= &2 pow 2 + &2 pow 2 /\\r
2259  d3 c a pow 2 <= &2 pow 2 + &2 pow 2 /\ d3 b c pow 2 <= &2 pow 2 + &2 pow 2 \r
2260 ==>  eta_y (&2) (&2) (&2) <= eta_y (d3 a b) (d3 b c) (d3 c a) `) THEN \r
2261 DAO THEN MATCH_MP_TAC (TAUT` (a ==> b) ==> a /\ c ==> b `) THEN \r
2262 SIMP_TAC[ETA_Y_2;D3_SYM; ETA_Y_SYYM] THEN MESON_TAC[ETA_Y_SYYM]]);;\r
2263 \r
2264 let HMWTCNS = LEMMA25;;\r
2265 \r
2266 \r
2267 let COEF1_POS_EQ_V1_IN = prove(`!v1 v2 v3 (v:real^3). ~collinear {v1, v2, v3} /\ \r
2268 v IN affine hull {v1, v2, v3} ==> \r
2269   ( &0 < coef1 v1 v2 v3 v <=> v IN aff_gt {v2, v3} {v1} ) `, DAO THEN \r
2270 NHANH (SPEC_ALL COEFS) THEN REWRITE_TAC[simp_def2; IN_ELIM_THM] THEN \r
2271 MESON_TAC[REAL_ADD_AC; VEC_PER2_3]);;\r
2272 \r
2273 \r
2274 let COEFS1_EQ_0_IFF_V_IN_AFF = prove(` !v1 v2 v3 v.\r
2275          ~collinear {v1, v2, v3} /\ v IN affine hull {v1, v2, v3} ==>\r
2276   (&0 = coef1 v1 v2 v3 v <=> v IN aff {v2, v3}) `,\r
2277 DAO THEN NHANH (SPEC_ALL COEFS) THEN \r
2278 REWRITE_TAC[AFF_2POINTS_INTERPRET; IN_ELIM_THM] THEN \r
2279 REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THENL [\r
2280 DOWN_TAC THEN DAO THEN PURE_ONCE_REWRITE_TAC[MESON[]` &0 = a /\\r
2281  P a <=> &0 = a /\ P ( &0 ) `] THEN REWRITE_TAC[VECTOR_MUL_LZERO;\r
2282  VECTOR_ADD_LID; REAL_ADD_LID] THEN MESON_TAC[]; \r
2283 STRIP_TAC THEN DOWN_TAC THEN DAO THEN \r
2284 MESON_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID; REAL_ADD_LID]]);;\r
2285 \r
2286 \r
2287 let cayleytr = new_definition ` \r
2288   cayleytr x12 x13 x14 x15 x23 x24 x25 x34 x35 x45 = \r
2289   &2 * x23 * x25 * x34 +\r
2290       &2 * x23 * x24 * x35 +\r
2291       -- &1 * x23 pow 2 * x45 +\r
2292       -- &2 * x15 * x23 * x34 +\r
2293       -- &2 * x15 * x23 * x24 +\r
2294       &2 * x15 * x23 pow 2 +\r
2295       -- &2 * x14 * x23 * x35 +\r
2296       -- &2 * x14 * x23 * x25 +\r
2297       &2 * x14 * x23 pow 2 +\r
2298       &4 * x14 * x15 * x23 +\r
2299       -- &2 * x13 * x25 * x34 +\r
2300       -- &2 * x13 * x24 * x35 +\r
2301       &4 * x13 * x24 * x25 +\r
2302       &2 * x13 * x23 * x45 +\r
2303       -- &2 * x13 * x23 * x25 +\r
2304       -- &2 * x13 * x23 * x24 +\r
2305       &2 * x13 * x15 * x34 +\r
2306       -- &2 * x13 * x15 * x24 +\r
2307       -- &2 * x13 * x15 * x23 +\r
2308       &2 * x13 * x14 * x35 +\r
2309       -- &2 * x13 * x14 * x25 +\r
2310       -- &2 * x13 * x14 * x23 +\r
2311       -- &1 * x13 pow 2 * x45 +\r
2312       &2 * x13 pow 2 * x25 +\r
2313       &2 * x13 pow 2 * x24 +\r
2314       &4 * x12 * x34 * x35 +\r
2315       -- &2 * x12 * x25 * x34 +\r
2316       -- &2 * x12 * x24 * x35 +\r
2317       &2 * x12 * x23 * x45 +\r
2318       -- &2 * x12 * x23 * x35 +\r
2319       -- &2 * x12 * x23 * x34 +\r
2320    -- &2 * x12 * x15 * x34 +\r
2321       &2 * x12 * x15 * x24 +\r
2322       -- &2 * x12 * x15 * x23 +\r
2323       -- &2 * x12 * x14 * x35 +\r
2324       &2 * x12 * x14 * x25 +\r
2325       -- &2 * x12 * x14 * x23 +\r
2326       &2 * x12 * x13 * x45 +\r
2327       -- &2 * x12 * x13 * x35 +\r
2328       -- &2 * x12 * x13 * x34 +\r
2329       -- &2 * x12 * x13 * x25 +\r
2330       -- &2 * x12 * x13 * x24 +\r
2331       &4 * x12 * x13 * x23 +\r
2332       -- &1 * x12 pow 2 * x45 +\r
2333       &2 * x12 pow 2 * x35 +\r
2334       &2 * x12 pow 2 * x34 `;;\r
2335 \r
2336 \r
2337 let LTCTBAN = prove(` cayleyR x12 x13 x14 x15 x23 x24 x25 x34 x35 x45 = \r
2338 ups_x x12 x13 x23 * x45 pow 2 + cayleytr x12 x13 x14 x15 x23 x24 x25 x34 x35 ( &0 )\r
2339 * x45 + cayleyR x12 x13 x14 x15 x23 x24 x25 x34 x35 ( &0 ) `,\r
2340 REWRITE_TAC[ups_x; cayleyR;cayleytr] THEN REAL_ARITH_TAC);;\r
2341 \r
2342 \r
2343 let COEF1_NEG_IFF_V1_IN_AFF_LT = prove(` ! v1 v2 v3 v. ~collinear {v1, v2, v3} /\\r
2344  v IN affine hull {v1, v2, v3}\r
2345   ==> (coef1 v1 v2 v3 v < &0 <=> v IN aff_lt {v2, v3} {v1}) `,\r
2346 DAO THEN NHANH (SPEC_ALL COEFS) THEN REWRITE_TAC[simp_def2; IN_ELIM_THM] THEN \r
2347 MESON_TAC[REAL_ADD_AC; VEC_PER2_3]);;\r
2348 \r
2349 let condA = new_definition `condA (v1:real^3) v2 v3 v4 x12 x13 x14 x23 x24 x34 = \r
2350   ( ~ ( v1 = v2 ) /\ coplanar {v1,v2,v3,v4} /\\r
2351   ( dist ( v1, v2) pow 2 ) = x12 /\\r
2352   dist (v1,v3) pow 2 = x13 /\\r
2353   dist (v1,v4) pow 2 = x14 /\\r
2354   dist (v2,v3) pow 2 = x23 /\ dist (v2,v4) pow 2 = x24 )`;;\r
2355 \r
2356 \r
2357 let det_vec3 = new_definition ` det_vec3 (a:real^3) (b:real^3) (c:real^3) = \r
2358   a$1 * b$2 * c$3 + b$1 * c$2 * a$3 + c$1 * a$2 * b$3 - \r
2359   ( a$1 * c$2 * b$3 + b$1 * a$2 * c$3 + c$1 * b$2 * a$3 ) `;;\r
2360 \r
2361 \r
2362 (* the following lemmas has been proved as follow, but it \r
2363 run after some files that are not conmpatibale here *)\r
2364 \r
2365 let COPLANAR_DET_VEC3_EQ_0 = new_axiom  `!v0 v1 (v2: real^3) v3.\r
2366        coplanar {v0,v1,v2,v3} <=>\r
2367        det_vec3 ( v1 - v0 ) ( v2 - v0 ) ( v3 - v0 ) = &0`;;\r
2368 \r
2369 \r
2370 let NONCOPLANAR_3_BASIS = new_axiom\r
2371  (`!v1 v2 v3 v0 v:real^3.\r
2372     ~coplanar {v0, v1, v2, v3}\r
2373     ==> (?t1 t2 t3.\r
2374              v = t1 % (v1 - v0) + t2 % (v2 - v0) + t3 % (v3 - v0) /\\r
2375              (!ta tb tc.\r
2376                   v = ta % (v1 - v0) + tb % (v2 - v0) + tc % (v3 - v0)\r
2377                 ==> ta = t1 /\ tb = t2 /\ tc = t3))`);;\r
2378 \r
2379 \r
2380 let COPLANAR = new_axiom`2 <= dimindex(:N)\r
2381   ==> !s:real^N->bool. coplanar s <=> ?u v w. s SUBSET affine hull {u,v,w}`;;\r
2382 \r
2383 \r
2384 let COPLANAR_3 = new_axiom `!a b c:real^N. 2 <= dimindex(:N) ==> coplanar {a,b,c}`;;\r
2385 \r
2386 (* \r
2387 needs "Multivariate/determinants.ml";;\r
2388 needs "Multivariate/convex.ml";;\r
2389 \r
2390 (* ------------------------------------------------------------------------- *)\r
2391 (* Flyspeck definitions we use.                                              *)\r
2392 (* ------------------------------------------------------------------------- *)\r
2393 \r
2394 let plane = new_definition\r
2395  `plane x = (?u v w. ~(collinear {u,v,w}) /\ (x = affine hull {u,v,w}))`;;\r
2396 \r
2397 let coplanar = new_definition `coplanar S = (?x. plane x /\ S SUBSET x)`;;\r
2398 \r
2399 \r
2400 \r
2401 let COPLANAR_DET_EQ_0 = prove\r
2402  (`!v0 v1 (v2: real^3) v3.\r
2403        coplanar {v0,v1,v2,v3} <=>\r
2404        det(vector[v1 - v0; v2 - v0; v3 - v0]) = &0`,\r
2405  REPEAT GEN_TAC THEN REWRITE_TAC[DET_EQ_0_RANK; RANK_ROW] THEN\r
2406  REWRITE_TAC[rows; row; LAMBDA_ETA] THEN\r
2407  ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN\r
2408  REWRITE_TAC[GSYM numseg; DIMINDEX_3] THEN\r
2409  CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN\r
2410  SIMP_TAC[IMAGE_CLAUSES; VECTOR_3] THEN EQ_TAC THENL\r
2411   [REWRITE_TAC[coplanar; plane; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN\r
2412    MAP_EVERY X_GEN_TAC\r
2413     [`p:real^3->bool`; `a:real^3`; `b:real^3`; `c:real^3`] THEN\r
2414    DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN\r
2415    FIRST_X_ASSUM SUBST1_TAC THEN\r
2416    W(MP_TAC o PART_MATCH lhand AFFINE_HULL_INSERT_SUBSET_SPAN o\r
2417        rand o lhand o snd) THEN\r
2418    REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN\r
2419    DISCH_THEN(MP_TAC o MATCH_MP SUBSET_TRANS) THEN\r
2420    DISCH_THEN(MP_TAC o ISPEC `\x:real^3. x - a` o MATCH_MP IMAGE_SUBSET) THEN\r
2421    ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN\r
2422    REWRITE_TAC[IMAGE_CLAUSES; GSYM IMAGE_o; o_DEF; VECTOR_ADD_SUB; IMAGE_ID;\r
2423                SIMPLE_IMAGE] THEN\r
2424    REWRITE_TAC[INSERT_SUBSET] THEN STRIP_TAC THEN\r
2425    GEN_REWRITE_TAC LAND_CONV [GSYM DIM_SPAN] THEN MATCH_MP_TAC LET_TRANS THEN\r
2426    EXISTS_TAC `CARD {b - a:real^3,c - a}` THEN\r
2427    CONJ_TAC THENL\r
2428     [MATCH_MP_TAC SPAN_CARD_GE_DIM;\r
2429      SIMP_TAC[CARD_CLAUSES; FINITE_RULES] THEN ARITH_TAC] THEN\r
2430    REWRITE_TAC[FINITE_INSERT; FINITE_RULES] THEN\r
2431    GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_SPAN] THEN\r
2432    MATCH_MP_TAC SPAN_MONO THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN\r
2433    MP_TAC(VECTOR_ARITH `!x y:real^3. x - y = (x - a) - (y - a)`) THEN\r
2434    DISCH_THEN(fun th -> REPEAT CONJ_TAC THEN\r
2435      GEN_REWRITE_TAC LAND_CONV [th]) THEN\r
2436    MATCH_MP_TAC SPAN_SUB THEN ASM_REWRITE_TAC[];\r
2437 \r
2438    DISCH_TAC THEN\r
2439    MP_TAC(ISPECL [`{v1 - v0,v2 - v0,v3 - v0}:real^3->bool`; `2`]\r
2440                  LOWDIM_EXPAND_BASIS) THEN\r
2441    ASM_REWRITE_TAC[ARITH_RULE `n <= 2 <=> n < 3`; DIMINDEX_3; ARITH] THEN\r
2442    DISCH_THEN(X_CHOOSE_THEN `t:real^3->bool`\r
2443     (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN\r
2444    CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN\r
2445    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN\r
2446    MAP_EVERY X_GEN_TAC [`a:real^3`; `b:real^3`] THEN\r
2447    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN\r
2448    REWRITE_TAC[coplanar; plane] THEN\r
2449    EXISTS_TAC `affine hull {v0,v0 + a,v0 + b}:real^3->bool` THEN\r
2450    CONJ_TAC THENL\r
2451     [MAP_EVERY EXISTS_TAC [`v0:real^3`; `v0 + a:real^3`; `v0 + b:real^3`] THEN\r
2452      REWRITE_TAC[COLLINEAR_3; COLLINEAR_LEMMA;\r
2453                  VECTOR_ARITH `--x = vec 0 <=> x = vec 0`;\r
2454                  VECTOR_ARITH `u - (u + a):real^3 = --a`;\r
2455                  VECTOR_ARITH `(u + b) - (u + a):real^3 = b - a`] THEN\r
2456      REWRITE_TAC[DE_MORGAN_THM; VECTOR_SUB_EQ;\r
2457        VECTOR_ARITH `b - a = c % -- a <=> (c - &1) % a + &1 % b = vec 0`] THEN\r
2458      ASM_REWRITE_TAC[] THEN CONJ_TAC THENL\r
2459       [ASM_MESON_TAC[IN_INSERT; INDEPENDENT_NONZERO]; ALL_TAC] THEN\r
2460      DISCH_THEN(X_CHOOSE_TAC `u:real`) THEN\r
2461      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN\r
2462      REWRITE_TAC[DEPENDENT_EXPLICIT] THEN\r
2463      MAP_EVERY EXISTS_TAC [`{a:real^3,b}`;\r
2464                            `\x:real^3. if x = a then u - &1 else &1`] THEN\r
2465      REWRITE_TAC[FINITE_INSERT; FINITE_RULES; SUBSET_REFL] THEN\r
2466      CONJ_TAC THENL\r
2467       [EXISTS_TAC `b:real^3` THEN ASM_REWRITE_TAC[IN_INSERT] THEN\r
2468        REAL_ARITH_TAC;\r
2469        ALL_TAC] THEN\r
2470      SIMP_TAC[VSUM_CLAUSES; FINITE_RULES] THEN\r
2471      ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; VECTOR_ADD_RID];\r
2472      ALL_TAC] THEN\r
2473    W(MP_TAC o PART_MATCH (lhs o rand) AFFINE_HULL_INSERT_SPAN o\r
2474      rand o snd) THEN\r
2475    ANTS_TAC THENL\r
2476     [REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN\r
2477      REWRITE_TAC[VECTOR_ARITH `u = u + a <=> a = vec 0`] THEN\r
2478      ASM_MESON_TAC[INDEPENDENT_NONZERO; IN_INSERT];\r
2479      ALL_TAC] THEN\r
2480    DISCH_THEN SUBST1_TAC THEN\r
2481    ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN\r
2482    REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; IMAGE_ID; VECTOR_ADD_SUB] THEN\r
2483    MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC\r
2484     `IMAGE (\v:real^3. v0 + v) (span{v1 - v0, v2 - v0, v3 - v0})` THEN\r
2485    ASM_SIMP_TAC[IMAGE_SUBSET] THEN\r
2486    REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_IMAGE] THEN CONJ_TAC THENL\r
2487     [EXISTS_TAC `vec 0:real^3` THEN REWRITE_TAC[SPAN_0] THEN VECTOR_ARITH_TAC;\r
2488      REWRITE_TAC[VECTOR_ARITH `v1:real^N = v0 + x <=> x = v1 - v0`] THEN\r
2489      REWRITE_TAC[UNWIND_THM2] THEN REPEAT CONJ_TAC THEN\r
2490      MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_INSERT]]]);;\r
2491 \r
2492 \r
2493 \r
2494 let COPLANAR = prove\r
2495  (`2 <= dimindex(:N)\r
2496   ==> !s:real^N->bool. coplanar s <=> ?u v w. s SUBSET affine hull {u,v,w}`,\r
2497  DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[coplanar; plane] THEN\r
2498  REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN\r
2499  ONCE_REWRITE_TAC[MESON[]\r
2500   `(?x u v w. p x u v w) <=> (?u v w x. p x u v w)`] THEN\r
2501  REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN\r
2502  EQ_TAC THENL [MESON_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN\r
2503  MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`; `w:real^N`] THEN DISCH_TAC THEN\r
2504  SUBGOAL_THEN\r
2505   `s SUBSET {u + x:real^N | x | x IN span {y - u | y IN {v,w}}}`\r
2506  MP_TAC THENL\r
2507   [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP\r
2508     (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN\r
2509    REWRITE_TAC[AFFINE_HULL_INSERT_SUBSET_SPAN];\r
2510    ALL_TAC] THEN\r
2511  ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN\r
2512  DISCH_THEN(MP_TAC o ISPEC `\x:real^N. x - u` o MATCH_MP IMAGE_SUBSET) THEN\r
2513  REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ADD_SUB; IMAGE_ID; SIMPLE_IMAGE] THEN\r
2514  REWRITE_TAC[IMAGE_CLAUSES] THEN\r
2515  MP_TAC(ISPECL [`{v - u:real^N,w - u}`; `2`] LOWDIM_EXPAND_BASIS) THEN\r
2516  ANTS_TAC THENL\r
2517   [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LE_TRANS THEN\r
2518    EXISTS_TAC `CARD{v - u:real^N,w - u}` THEN\r
2519    SIMP_TAC[DIM_LE_CARD; FINITE_INSERT; FINITE_RULES] THEN\r
2520    SIMP_TAC[CARD_CLAUSES; FINITE_RULES] THEN ARITH_TAC;\r
2521    ALL_TAC] THEN\r
2522  DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool`\r
2523   (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN\r
2524  CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN\r
2525  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN\r
2526  MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN\r
2527  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN\r
2528  UNDISCH_TAC `span {v - u, w - u} SUBSET span {a:real^N, b}` THEN\r
2529  REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN\r
2530  DISCH_THEN(ASSUME_TAC o MATCH_MP SUBSET_TRANS) THEN\r
2531  MAP_EVERY EXISTS_TAC [`u:real^N`; `u + a:real^N`; `u + b:real^N`] THEN\r
2532  CONJ_TAC THENL\r
2533   [REWRITE_TAC[COLLINEAR_3; COLLINEAR_LEMMA;\r
2534                VECTOR_ARITH `--x = vec 0 <=> x = vec 0`;\r
2535                VECTOR_ARITH `u - (u + a):real^N = --a`;\r
2536                VECTOR_ARITH `(u + b) - (u + a):real^N = b - a`] THEN\r
2537    REWRITE_TAC[DE_MORGAN_THM; VECTOR_SUB_EQ;\r
2538      VECTOR_ARITH `b - a = c % -- a <=> (c - &1) % a + &1 % b = vec 0`] THEN\r
2539    ASM_REWRITE_TAC[] THEN CONJ_TAC THENL\r
2540     [ASM_MESON_TAC[IN_INSERT; INDEPENDENT_NONZERO]; ALL_TAC] THEN\r
2541    DISCH_THEN(X_CHOOSE_TAC `u:real`) THEN\r
2542    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN\r
2543    REWRITE_TAC[DEPENDENT_EXPLICIT] THEN\r
2544    MAP_EVERY EXISTS_TAC [`{a:real^N,b}`;\r
2545                          `\x:real^N. if x = a then u - &1 else &1`] THEN\r
2546    REWRITE_TAC[FINITE_INSERT; FINITE_RULES; SUBSET_REFL] THEN\r
2547    CONJ_TAC THENL\r
2548     [EXISTS_TAC `b:real^N` THEN ASM_REWRITE_TAC[IN_INSERT] THEN\r
2549      REAL_ARITH_TAC;\r
2550      ALL_TAC] THEN\r
2551    SIMP_TAC[VSUM_CLAUSES; FINITE_RULES] THEN\r
2552    ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; VECTOR_ADD_RID];\r
2553    ALL_TAC] THEN\r
2554  W(MP_TAC o PART_MATCH (lhs o rand) AFFINE_HULL_INSERT_SPAN o rand o snd) THEN\r
2555  ANTS_TAC THENL\r
2556   [REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN\r
2557    REWRITE_TAC[VECTOR_ARITH `u = u + a <=> a = vec 0`] THEN\r
2558    ASM_MESON_TAC[INDEPENDENT_NONZERO; IN_INSERT];\r
2559    ALL_TAC] THEN\r
2560  DISCH_THEN SUBST1_TAC THEN\r
2561  FIRST_ASSUM(MP_TAC o ISPEC `\x:real^N. u + x` o MATCH_MP IMAGE_SUBSET) THEN\r
2562  REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID;\r
2563              ONCE_REWRITE_RULE[VECTOR_ADD_SYM] VECTOR_SUB_ADD] THEN\r
2564  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN\r
2565  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN\r
2566  REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; VECTOR_ADD_SUB] THEN\r
2567  SET_TAC[]);;\r
2568 \r
2569 (* this LEMMA in determinants.ml *)\r
2570 let DET_3 = new_axiom`!A:real^3^3.\r
2571         det(A) = A$1$1 * A$2$2 * A$3$3 +\r
2572                  A$1$2 * A$2$3 * A$3$1 +\r
2573                  A$1$3 * A$2$1 * A$3$2 -\r
2574                  A$1$1 * A$2$3 * A$3$2 -\r
2575                  A$1$2 * A$2$1 * A$3$3 -\r
2576                  A$1$3 * A$2$2 * A$3$1`;;\r
2577 \r
2578 \r
2579 let det_vec3 = new_definition ` det_vec3 (a:real^3) (b:real^3) (c:real^3) = \r
2580   a$1 * b$2 * c$3 + b$1 * c$2 * a$3 + c$1 * a$2 * b$3 - \r
2581   ( a$1 * c$2 * b$3 + b$1 * a$2 * c$3 + c$1 * b$2 * a$3 ) `;;\r
2582 \r
2583 \r
2584 let DET_VEC3_EXPAND = prove\r
2585  (`det (vector [a; b; (c:real^3)] ) = det_vec3 a b c`,\r
2586  REWRITE_TAC[det_vec3; DET_3; VECTOR_3] THEN REAL_ARITH_TAC);;\r
2587 \r
2588 let COPLANAR_DET_VEC3_EQ_0 = prove( `!v0 v1 (v2: real^3) v3.\r
2589        coplanar {v0,v1,v2,v3} <=>\r
2590        det_vec3 ( v1 - v0 ) ( v2 - v0 ) ( v3 - v0 ) = &0`, REWRITE_TAC[COPLANAR_DET_EQ_0; DET_VEC3_EXPAND]);;\r
2591 \r
2592 \r
2593 \r
2594 let COPLANAR_3 = prove\r
2595  (`!a b c:real^N. 2 <= dimindex(:N) ==> coplanar {a,b,c}`,\r
2596  SIMP_TAC[COPLANAR; SUBSET] THEN MESON_TAC[HULL_INC]);;\r
2597 \r
2598 let NONCOPLANAR_4_DISTINCT = prove\r
2599  (`!a b c d:real^N.\r
2600        ~(coplanar{a,b,c,d}) /\ 2 <= dimindex(:N)\r
2601        ==> ~(a = b) /\ ~(a = c) /\ ~(a = d) /\\r
2602            ~(b = c) /\ ~(b = d) /\ ~(c = d)`,\r
2603  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN\r
2604  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM] THEN\r
2605  STRIP_TAC THEN ASM_SIMP_TAC[INSERT_AC; COPLANAR_3]);;\r
2606 \r
2607 \r
2608 \r
2609 let NONCOPLANAR_3_BASIS = prove\r
2610  (`!v1 v2 v3 v0 v:real^3.\r
2611     ~coplanar {v0, v1, v2, v3}\r
2612     ==> (?t1 t2 t3.\r
2613              v = t1 % (v1 - v0) + t2 % (v2 - v0) + t3 % (v3 - v0) /\\r
2614              (!ta tb tc.\r
2615                   v = ta % (v1 - v0) + tb % (v2 - v0) + tc % (v3 - v0)\r
2616                   ==> ta = t1 /\ tb = t2 /\ tc = t3))`,\r
2617  REPEAT STRIP_TAC THEN\r
2618  FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]\r
2619    NONCOPLANAR_4_DISTINCT)) THEN\r
2620  REWRITE_TAC[DIMINDEX_3; ARITH] THEN STRIP_TAC THEN\r
2621  SUBGOAL_THEN `independent {v1 - v0:real^3,v2 - v0,v3 - v0}` ASSUME_TAC THENL\r
2622   [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [COPLANAR_DET_EQ_0]) THEN\r
2623    ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[independent] THEN\r
2624    DISCH_TAC THEN MATCH_MP_TAC DET_DEPENDENT_ROWS THEN\r
2625    REWRITE_TAC[rows; row; LAMBDA_ETA; GSYM IN_NUMSEG; DIMINDEX_3] THEN\r
2626    ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN\r
2627    CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN\r
2628    ASM_REWRITE_TAC[IMAGE_CLAUSES; VECTOR_3];\r
2629    ALL_TAC] THEN\r
2630  MP_TAC(ISPECL [`(:real^3)`; `{v1 - v0:real^3,v2 - v0,v3 - v0}`]\r
2631    CARD_GE_DIM_INDEPENDENT) THEN\r
2632  ASM_REWRITE_TAC[DIM_UNIV; SUBSET_UNIV] THEN ANTS_TAC THENL\r
2633   [SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_RULES] THEN\r
2634    ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DIMINDEX_3; ARITH;\r
2635                    VECTOR_ARITH `x - a:real^N = y - a <=> x = y`];\r
2636    ALL_TAC] THEN\r
2637  REWRITE_TAC[SUBSET; IN_UNIV; SPAN_BREAKDOWN_EQ; SPAN_EMPTY] THEN\r
2638  DISCH_THEN(MP_TAC o SPEC `v:real^3`) THEN\r
2639  MAP_EVERY (fun t -> MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC t)\r
2640            [`t1:real`; `t2:real`; `t3:real`] THEN\r
2641  REWRITE_TAC[IN_SING; VECTOR_ARITH\r
2642    `a - b - c - d:real^N = vec 0 <=> a = b + c + d`] THEN\r
2643  DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[] THEN\r
2644  MAP_EVERY X_GEN_TAC [`ta:real`; `tb:real`; `tc:real`] THEN\r
2645  REWRITE_TAC[VECTOR_ARITH\r
2646   `t1 % x + t2 % y + t3 % z = ta % x + tb % y + tc % z <=>\r
2647    (t1 - ta) % x + (t2 - tb) % y + (t3 - tc) % z = vec 0`] THEN\r
2648  STRIP_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN\r
2649  REWRITE_TAC[DEPENDENT_EXPLICIT; NOT_EXISTS_THM] THEN\r
2650  DISCH_THEN(MP_TAC o SPECL\r
2651   [`{v1 - v0:real^3,v2 - v0,v3 - v0}`;\r
2652    `\v:real^3. if v = v1 - v0 then t1 - ta\r
2653                else if v = v2 - v0 then t2 - tb\r
2654                else t3 - tc`]) THEN\r
2655  SIMP_TAC[FINITE_INSERT; FINITE_RULES; SUBSET_REFL; VSUM_CLAUSES] THEN\r
2656  ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; VECTOR_ADD_RID;\r
2657                  RIGHT_OR_DISTRIB; EXISTS_OR_THM; UNWIND_THM2;\r
2658                    VECTOR_ARITH `x - a:real^N = y - a <=> x = y`] THEN\r
2659  SIMP_TAC[DE_MORGAN_THM; REAL_SUB_0]);;\r
2660 \r
2661 *)\r
2662 \r
2663 \r
2664 \r
2665 \r
2666 \r
2667 \r
2668 let DET_VEC3_AND_DELTA = prove(`!(a:real^3) b c d.\r
2669      &4 * ( det_vec3 (a - d) (b - d) (c - d) ) pow 2 =\r
2670      delta  ( d3 a d pow 2)\r
2671      (d3 b d pow 2)\r
2672      (d3 c d pow 2) (d3 a b pow 2) (d3 a c pow 2) (d3 b c pow 2)   `,\r
2673 SIMP_TAC[d3; dist] THEN \r
2674 REWRITE_TAC[GSYM (MESON[VECTOR_ARITH ` (a :real^N) - b = ( a - x ) - ( b - x ) `]`\r
2675   delta      (norm (a - d) pow 2)     (norm (b - d) pow 2)\r
2676      (norm (c - d) pow 2) (norm ((a - d)  - (b - d )) pow 2) \r
2677 (norm ((a - d)  - ( c - d )) pow 2) (norm ((b - d ) - ( c - d )) pow 2)    =\r
2678    delta   (norm (a - d) pow 2)     (norm (b - d) pow 2)   (norm (c - d) pow 2)\r
2679 (norm (a - b) pow 2) (norm (a - c) pow 2) (norm (b - c) pow 2)    `)] THEN \r
2680 SIMP_TAC[ vector_norm; DOT_POS_LE; SQRT_WORKS] THEN \r
2681 REWRITE_TAC[DOT_3] THEN \r
2682 REWRITE_TAC[MESON[lemma_cm3]`((a:real^3) - d - (b - d))$1 = (a - d)$1 - (b - d)$1 /\\r
2683   (a - d - (b - d))$2 = (a - d)$2 - (b - d)$2 /\\r
2684   (a - d - (b - d))$3 = (a - d)$3 - (b - d)$3 `] THEN \r
2685 REWRITE_TAC[delta; det_vec3] THEN \r
2686 REAL_ARITH_TAC);;\r
2687 \r
2688 \r
2689 \r
2690 let POLFLZY = prove(` !(x1:real^3) x2 x3 x4.\r
2691          let x12 = dist (x1,x2) pow 2 in\r
2692          let x13 = dist (x1,x3) pow 2 in\r
2693          let x14 = dist (x1,x4) pow 2 in\r
2694          let x23 = dist (x2,x3) pow 2 in\r
2695          let x24 = dist (x2,x4) pow 2 in\r
2696          let x34 = dist (x3,x4) pow 2 in\r
2697          coplanar {x1, x2, x3, x4} <=> delta x12 x13 x14 x23 x24 x34 = &0 `,\r
2698 LET_TR THEN REPEAT GEN_TAC THEN MP_TAC (GSYM (SPECL [` x2 :real^3`; \r
2699 ` x3:real^3`;` x4:real^3`; ` x1 :real^3`] DET_VEC3_AND_DELTA)) THEN \r
2700 SIMP_TAC[d3; DIST_SYM] THEN REWRITE_TAC[REAL_ARITH ` &4 * a = &0 <=> a = &0 `]\r
2701 THEN SIMP_TAC[GSYM ( REAL_FIELD ` x = &0 <=> x pow 2 = &0 `);\r
2702 COPLANAR_DET_VEC3_EQ_0]);;\r
2703 \r
2704 \r
2705 let LEMMA15 = POLFLZY;;\r
2706 \r
2707 let muy_delta = new_definition ` muy_delta = delta `;;\r
2708 \r
2709 (* LEMMA29 *)\r
2710 let VCRJIHC = prove(`!(v1:real^3) v2 v3 v4 x34 x12 x13 x14 x23 x24.\r
2711          condA v1 v2 v3 v4 x12 x13 x14 x23 x24 x34\r
2712          ==> muy_delta x12 x13 x14 x23 x24 (dist (v3,v4) pow 2) = &0`,\r
2713 REWRITE_TAC[condA; muy_delta] THEN MP_TAC POLFLZY THEN LET_TR THEN MESON_TAC[]);;\r
2714 \r
2715 \r
2716 let ZERO_NEUTRAL = REAL_ARITH ` ! x. &0 * x = &0 /\ x * &0 = &0 /\ &0 + x = x /\ x + &0 = x /\ x - &0 = x /\\r
2717   -- &0 = &0 `;;\r
2718 \r
2719 let EQUATE_CONEFS_POLINOMIAL_POW2 = prove( `!a b c aa bb cc. ( ! x. \r
2720      a * x pow 2 + b * x + c = aa * x pow 2 + bb * x + cc ) <=>\r
2721      a = aa /\ b = bb /\ c = cc`, REPEAT GEN_TAC THEN EQ_TAC THENL [\r
2722 NHANH (MESON[]` (! (x:real). P x ) ==> P ( &0 ) /\ P ( &1 ) /\ P ( -- &1 )`) THEN \r
2723 REAL_ARITH_TAC THEN REAL_ARITH_TAC; SIMP_TAC[]]);;\r
2724 \r
2725 let GJWYYPS = prove(`!x12 x13 x14 x15 x23 x24 x25 x34 x35 a b c.\r
2726     (! x45.  cayleyR x12 x13 x14 x15 x23 x24 x25 x34 x35 x45 =\r
2727      a  * x45 pow 2 + b * x45 + c )\r
2728      ==> b pow 2 - &4 * a * c =\r
2729          &16 * delta x12 x13 x14 x23 x24 x34 * delta x12 x13 x15 x23 x25 x35`,\r
2730 ONCE_REWRITE_TAC[LTCTBAN] THEN REPEAT GEN_TAC THEN \r
2731 REWRITE_TAC[EQUATE_CONEFS_POLINOMIAL_POW2] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ]\r
2732 THEN SIMP_TAC[] THEN DISCH_TAC THEN REWRITE_TAC[ups_x; cayleytr; cayleyR;\r
2733  delta; ZERO_NEUTRAL] THEN REAL_ARITH_TAC);;\r
2734 \r
2735 let LEMMA51 = GJWYYPS ;;\r
2736 \r
2737 g `!v1 v2 (v:real^3). ~(v1 = v2) ==> (collinear {v, v1, v2} <=> v IN aff {v1, v2})`;;\r
2738 e (REWRITE_TAC[COLLINEAR_EX]);;\r
2739 e (NHANH (MESON[]` a % b + c = vec 0 ==> ( a = &0 \/ ~(a = &0 ))`));;\r
2740 e (KHANANG);;\r
2741 e (NGOAC THEN PURE_ONCE_REWRITE_TAC[MESON[]` P a /\ a = &0 <=> P ( &0 ) \r
2742   /\ a = &0 `]);;\r
2743 e (REWRITE_TAC[REAL_ADD_LID; VECTOR_MUL_LZERO; VECTOR_ADD_LID]);;\r
2744 e (REWRITE_TAC[REAL_ARITH ` a + b= &0 <=> a = -- b `; VECTOR_ARITH` a % x + b % y = vec 0 \r
2745  <=> a % x = ( -- b) % y`]);;\r
2746 e (NHANH (MESON[REAL_ARITH ` a = &0 <=> -- a = &0 `; VECTOR_MUL_LCANCEL]` (b = --c /\ ~(b = &0 /\ c = &0)) /\ b % v1 = --c % v2\r
2747   ==> v1 = v2 `));;\r
2748 e (SIMP_TAC[]);;\r
2749 e (REWRITE_TAC[AFF_2POINTS_INTERPRET; IN_ELIM_THM]);;\r
2750 e (REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC);;\r
2751 e (REWRITE_TAC[VECTOR_ARITH ` a % v + b % v1 + c % v2 = vec 0 <=>\r
2752   a % v = ( -- b) % v1 + ( --c ) % v2 `]);;\r
2753 e (PHA THEN REWRITE_TAC[MESON[CHANGE_SIDE]` a % v = v1  /\\r
2754                ~(a = &0) <=> v = &1 / a % v1 /\ ~( a = &0 ) `]);;\r
2755 e (REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_ARITH `&1 / a * b = b / a`]);;\r
2756 e (REWRITE_TAC[AFF_2POINTS_INTERPRET; IN_ELIM_THM]);;\r
2757 e (MESON_TAC[REAL_FIELD ` ~ ( a = &0 ) /\ a = -- (b + c) ==>\r
2758    ( -- b) / a + ( -- c) / a = &1 `]);;\r
2759 e (STRIP_TAC);;\r
2760 e (EXISTS_TAC ` &1 `);;\r
2761 e (EXISTS_TAC ` -- ta`);;\r
2762 e (EXISTS_TAC ` -- tb`);;\r
2763 e (PHA);;\r
2764 e (ASM_SIMP_TAC[REAL_ARITH` ~(&1 = &0 ) /\ -- ( -- a + -- b ) = a + b `]);;\r
2765 e (CONV_TAC VECTOR_ARITH);;\r
2766 \r
2767 let NOT_TOW_EQ_IMP_COL_EQUAVALENT = top_thm();;\r
2768 \r
2769 \r
2770 let LEMMA30 = prove(`!v1 v2 v3 v4 x12 x13 x14 x23 x24 x34 a b c.\r
2771          condA v1 v2 v3 v4 x12 x13 x14 x23 x24 x34 /\\r
2772          (!x12 x13 x14 x23 x24 x34.\r
2773               muy_delta x12 x13 x14 x23 x24 x34 =\r
2774               a x12 x13 x14 x23 x24 * x34 pow 2 +\r
2775               b x12 x13 x14 x23 x24 * x34 +\r
2776               c x12 x13 x14 x23 x24 )\r
2777          ==> (v3 IN aff {v1, v2} \/ v4 IN aff {v1, v2} <=>\r
2778               b x12 x13 x14 x23 x24 pow 2 -\r
2779               &4 * a x12 x13 x14 x23 x24 * c x12 x13 x14 x23 x24 =\r
2780               &0)`,\r
2781 REWRITE_TAC[muy_delta; DELTA_COEFS; EQUATE_CONEFS_POLINOMIAL_POW2 ] THEN \r
2782 ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN SIMP_TAC[] THEN REPEAT GEN_TAC THEN \r
2783 DISCH_TAC THEN REWRITE_TAC[REAL_ARITH` a - b * -- c * d = a + b * c * d `; \r
2784 AGBWHRD] THEN DOWN_TAC THEN SIMP_TAC[condA; REAL_ENTIRE; \r
2785 GSYM NOT_TOW_EQ_IMP_COL_EQUAVALENT] THEN ONCE_REWRITE_TAC[MESON[PER_SET3]`\r
2786  p {v3, v1, v2} \/ p {v4, v1, v2}  <=> p {v1,v2,v3} \/ p {v1,v2,v4} `] THEN \r
2787 ONCE_REWRITE_TAC[MESON[UPS_X_SYM]` ups_x x12 x23 x13 = &0 \/ \r
2788 ups_x x12 x24 x14 = &0 <=>     ups_x x12 x13 x23 = &0 \/ \r
2789 ups_x x12 x14 x24 = &0 `] THEN MESON_TAC[UPS_X_SYM; PER_SET3; FHFMKIY]);;\r
2790 \r
2791 let EWVIFXW = LEMMA30;;\r
2792 \r
2793 \r
2794 \r
2795 let WITH_COEF1 = prove(` ! (v1:real^3) (v2:real^3) (v3:real^3) (v:real^3).\r
2796  ~ collinear {v1,v2,v3} /\ v IN affine hull {v1, v2, v3} \r
2797   ==> ( &0 < coef1 v1 v2 v3 v <=> v IN aff_gt {v2,v3} {v1} ) /\\r
2798   ( &0 = coef1 v1 v2 v3 v <=> v IN aff {v2,v3} ) /\\r
2799   ( coef1 v1 v2 v3 v < &0 <=> v IN aff_lt {v2,v3} {v1} ) `,\r
2800 SIMP_TAC[COEF1_POS_EQ_V1_IN; COEFS1_EQ_0_IFF_V_IN_AFF; COEF1_NEG_IFF_V1_IN_AFF_LT]);;\r
2801 \r
2802 let PER_COEF1_COEF2 = prove(` ! (v1:real^3) (v2:real^3) (v3:real^3) (v:real^3).\r
2803            v IN affine hull {v1, v2, v3} /\ ~collinear {v1, v2, v3}\r
2804 ==> coef1 v2 v3 v1 v = coef2 v1 v2 v3 v ` ,\r
2805 NHANH (SPEC_ALL COEFS) THEN \r
2806 ONCE_REWRITE_TAC[MESON[PER_SET3]` p {a,b,c} = p {b,c,a} `] THEN \r
2807 NHANH (SPEC_ALL COEFS) THEN MESON_TAC[VEC_PER2_3; REAL_PER3]);;\r
2808 \r
2809 \r
2810 let PER_COEF1_COEF3 = prove(` ! (v1:real^3) (v2:real^3) (v3:real^3) (v:real^3).\r
2811            v IN affine hull {v1, v2, v3} /\ ~collinear {v1, v2, v3}\r
2812 ==> coef1 v3 v1 v2 v = coef3 v1 v2 v3 v `, NHANH (SPEC_ALL COEFS) THEN \r
2813 ONCE_REWRITE_TAC[MESON[PER_SET3]` p {a,b,c} = p {c,a,b} `] THEN \r
2814 NHANH (SPEC_ALL COEFS) THEN MESON_TAC[VEC_PER2_3; REAL_PER3]);;\r
2815 \r
2816 let PER_COEF1 = prove(  ` ! (v1:real^3) (v2:real^3) (v3:real^3) (v:real^3).\r
2817            v IN affine hull {v1, v2, v3} /\ ~collinear {v1, v2, v3}\r
2818 ==> coef1 v3 v1 v2 v = coef3 v1 v2 v3 v /\ coef1 v2 v3 v1 v = coef2 v1 v2 v3 v `,\r
2819 SIMP_TAC[PER_COEF1_COEF2; PER_COEF1_COEF3]);;\r
2820 \r
2821 \r
2822 \r
2823 let LEMMA12 = prove(`! (v1:real^3) (v2:real^3) (v3:real^3) (v:real^3). \r
2824 ~ collinear {v1,v2,v3} /\ v IN affine hull {v1, v2, v3} \r
2825   ==> ( &0 < coef1 v1 v2 v3 v <=> v IN aff_gt {v2,v3} {v1} ) /\\r
2826   ( &0 = coef1 v1 v2 v3 v <=> v IN aff {v2,v3} ) /\\r
2827   ( coef1 v1 v2 v3 v < &0 <=> v IN aff_lt {v2,v3} {v1} ) /\\r
2828    ( &0 < coef2 v1 v2 v3 v <=> v IN aff_gt {v3,v1} {v2} ) /\\r
2829   ( &0 = coef2 v1 v2 v3 v <=> v IN aff {v3,v1} ) /\\r
2830   ( coef2 v1 v2 v3 v < &0 <=> v IN aff_lt {v3,v1} {v2} )/\\r
2831    ( &0 < coef3 v1 v2 v3 v <=> v IN aff_gt {v1,v2} {v3} ) /\\r
2832   ( &0 = coef3 v1 v2 v3 v <=> v IN aff {v1,v2} ) /\\r
2833   ( coef3 v1 v2 v3 v < &0 <=> v IN aff_lt {v1,v2} {v3})`,\r
2834 MP_TAC WITH_COEF1 THEN SIMP_TAC[PER_SET3; GSYM PER_COEF1_COEF3; PER_COEF1]);;\r
2835 \r
2836 let CNXIFFC = LEMMA12;;\r
2837  \r
2838 \r
2839 let NGAY_23_THANG1 = prove(`! (v1:real^3) (v2:real^3) (v3:real^3) (v:real^3). ~collinear {v1, v2, v3} /\ v IN affine hull {v1, v2, v3} ==>\r
2840   ( v IN aff_ge {v2, v3} {v1} <=> &0 <= coef1 v1 v2 v3 v ) /\\r
2841   ( v IN aff_ge {v3,v1} {v2} <=> &0 <= coef2 v1 v2 v3 v ) /\\r
2842   ( v IN aff_ge {v1,v2} {v3} <=> &0 <= coef3 v1 \r
2843 v2 v3 v ) `,\r
2844 REWRITE_TAC[IN_AFF_GE_INTERPRET_TO_AFF_GT_AND_AFF; REAL_ARITH ` &0 <= a\r
2845   <=> &0 < a \/ &0 = a `] THEN SIMP_TAC[CNXIFFC]);;\r
2846 \r
2847 \r
2848 let MYOQCBS = prove(` !(v1:real^3) v2 v3 v.\r
2849          ~collinear {v1, v2, v3} /\ v IN affine hull {v1, v2, v3}\r
2850          ==> (v IN conv {v1, v2, v3} <=>\r
2851               &0 <= coef1 v1 v2 v3 v /\\r
2852               &0 <= coef2 v1 v2 v3 v /\\r
2853               &0 <= coef3 v1 v2 v3 v) /\\r
2854              (v IN conv0 {v1, v2, v3} <=>\r
2855               &0 < coef1 v1 v2 v3 v /\\r
2856               &0 < coef2 v1 v2 v3 v /\\r
2857               &0 < coef3 v1 v2 v3 v) `,\r
2858 SIMP_TAC[IN_CONV3_EQ; IN_CONV03_EQ; NGAY_23_THANG1; CNXIFFC ] THEN MESON_TAC[]);;\r
2859 \r
2860 let LEMMA51 = GJWYYPS;;\r
2861 let LEMMA50 = LTCTBAN;;\r
2862 let muy_v = new_definition ` muy_v (x1: real^N ) (x2:real^N) (x3:real^N) (x4:real^N)\r
2863 (x5:real^N) x45 = \r
2864           (let x12 = dist (x1,x2) pow 2 in\r
2865           let x13 = dist (x1,x3) pow 2 in\r
2866           let x14 = dist (x1,x4) pow 2 in\r
2867           let x15 = dist (x1,x5) pow 2 in\r
2868           let x23 = dist (x2,x3) pow 2 in\r
2869           let x24 = dist (x2,x4) pow 2 in\r
2870           let x25 = dist (x2,x5) pow 2 in\r
2871           let x34 = dist (x3,x4) pow 2 in\r
2872           let x35 = dist (x3,x5) pow 2 in\r
2873           cayleyR x12 x13 x14 x15 x23 x24 x25 x34 x35 x45) `;;\r
2874 \r
2875 let REMOVE_TAC = MATCH_MP_TAC (MESON[]` a ==> b ==> a `);;\r
2876 \r
2877 let ALE = MESON[LTCTBAN]`!x12 x13 x14 x15 x23 x24 x25 x34 x35.\r
2878      (!a b c. (! x.\r
2879           cayleyR x12 x13 x14 x15 x23 x24 x25 x34 x35 x =\r
2880           a * x pow 2 + b * x + c )\r
2881           ==> b pow 2 - &4 * a * c = &0)\r
2882      ==> cayleytr x12 x13 x14 x15 x23 x24 x25 x34 x35 (&0) pow 2 -\r
2883          &4 *\r
2884          ups_x x12 x13 x23 *\r
2885          cayleyR x12 x13 x14 x15 x23 x24 x25 x34 x35 (&0) =\r
2886          &0`;;\r
2887 \r
2888 let DISCRIMINANT_OF_CAY = MESON[LTCTBAN; GJWYYPS]`cayleytr x12 x13 x14 x15 x23 x24 x25 x34 x35 (&0) pow 2 -\r
2889  &4 * ups_x x12 x13 x23 * cayleyR x12 x13 x14 x15 x23 x24 x25 x34 x35 (&0) =\r
2890  &16 * delta x12 x13 x14 x23 x24 x34 * delta x12 x13 x15 x23 x25 x35`;;\r
2891 \r
2892 let NOT_TWO_EQ_IMP_COL_EQUAVALENT = NOT_TOW_EQ_IMP_COL_EQUAVALENT;;\r
2893 \r
2894 let GDLRUZB = prove(` ! (v1:real^3) (v2:real^3) (v3:real^3) (v4:real^3) (v5:real^3) a b c.\r
2895   coplanar {v1, v2, v3, v4} \/ coplanar {v1, v2, v3, v5} <=>\r
2896          (! a b c. (! x. muy_v v1 v2 v3 v4 v5 x = a * x pow 2 + b * x + c )\r
2897  ==> b pow 2 - &4 * a * c = &0) `,REWRITE_TAC[muy_v] THEN LET_TR THEN \r
2898 REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN \r
2899 NHANH (MESON[GJWYYPS]` (!x45. cayleyR x12 x13 x14 x15 x23 x24 x25 x34 x35 x45 =\r
2900                 a * x45 pow 2 + b * x45 + c)\r
2901          ==> b pow 2 - &4 * a * c =\r
2902              &16 *\r
2903              delta x12 x13 x14 x23 x24 x34 *\r
2904              delta x12 x13 x15 x23 x25 x35`) THEN SIMP_TAC[] THEN \r
2905 UNDISCH_TAC ` coplanar {(v1:real^3), v2, v3, v4}\/ coplanar {v1, v2, v3, v5}` THEN \r
2906 MP_TAC LEMMA15 THEN LET_TR THEN REWRITE_TAC[REAL_FIELD` &16 * a * b = &0 \r
2907 <=> a = &0 \/ b = &0 `] THEN SIMP_TAC[]; NHANH (SPEC_ALL ALE) THEN \r
2908 REWRITE_TAC[DISCRIMINANT_OF_CAY ] THEN MP_TAC POLFLZY THEN LET_TR THEN \r
2909 REWRITE_TAC[REAL_FIELD` &16 * a * b = &0 <=> a = &0 \/ b = &0 `] THEN \r
2910 MESON_TAC[]]);;\r
2911 \r
2912 \r
2913 let DET_VECC3_AND_DELTA = prove(` (! d a b c .\r
2914       delta (d3 d a pow 2) (d3 d b pow 2) (d3 d c pow 2) (d3 a b pow 2)\r
2915       (d3 a c pow 2)\r
2916       (d3 b c pow 2) =\r
2917       &4 * det_vec3 (a - d) (b - d) (c - d) pow 2) `, MESON_TAC[D3_SYM; \r
2918 DET_VEC3_AND_DELTA]);;\r
2919 \r
2920 \r
2921 let DELTA_POS_4POINTS = prove(`!x1 x2 x3 (x4:real^3).\r
2922      &0 <=\r
2923      delta (dist (x1,x2) pow 2) (dist (x1,x3) pow 2) (dist (x1,x4) pow 2)\r
2924      (dist (x2,x3) pow 2)\r
2925      (dist (x2,x4) pow 2)\r
2926      (dist (x3,x4) pow 2)`, REWRITE_TAC[GSYM d3] THEN SIMP_TAC[D3_SYM] THEN \r
2927 MP_TAC (DET_VECC3_AND_DELTA) THEN SIMP_TAC[] THEN DISCH_TAC THEN MP_TAC\r
2928  REAL_LE_SQUARE_POW THEN MESON_TAC[REAL_ARITH` &0 <= x <=> &0 <= &4 * x `]);;\r
2929 \r
2930 \r
2931 \r
2932 let DIST_POW2_DOT = \r
2933 prove(` ! a (b:real^N) . dist (a,b) pow 2 = ( a - b ) dot ( a- b) `,\r
2934 SIMP_TAC[dist; vector_norm; DOT_POS_LE; SQRT_WORKS]);;\r
2935 \r
2936 (* this lemma is proved as below, but it take quite a long time to run it *)\r
2937 let CAYLEYR_5POINTS = new_axiom` !x1 x2 x3 x4 (x5 :real^3). \r
2938          let x12 = dist (x1,x2) pow 2 in\r
2939          let x13 = dist (x1,x3) pow 2 in\r
2940          let x14 = dist (x1,x4) pow 2 in\r
2941          let x15 = dist (x1,x5) pow 2 in\r
2942          let x23 = dist (x2,x3) pow 2 in\r
2943          let x24 = dist (x2,x4) pow 2 in\r
2944          let x25 = dist (x2,x5) pow 2 in\r
2945          let x34 = dist (x3,x4) pow 2 in\r
2946          let x35 = dist (x3,x5) pow 2 in\r
2947          let x45 = dist (x4,x5) pow 2 in\r
2948          cayleyR x12 x13 x14 x15 x23 x24 x25 x34 x35 x45 = &0 `;;\r
2949 \r
2950 (* let CAYLEYR_5POINTS = prove(`  !x1 x2 x3 x4 (x5 :real^3). \r
2951          let x12 = dist (x1,x2) pow 2 in\r
2952          let x13 = dist (x1,x3) pow 2 in\r
2953          let x14 = dist (x1,x4) pow 2 in\r
2954          let x15 = dist (x1,x5) pow 2 in\r
2955          let x23 = dist (x2,x3) pow 2 in\r
2956          let x24 = dist (x2,x4) pow 2 in\r
2957          let x25 = dist (x2,x5) pow 2 in\r
2958          let x34 = dist (x3,x4) pow 2 in\r
2959          let x35 = dist (x3,x5) pow 2 in\r
2960          let x45 = dist (x4,x5) pow 2 in\r
2961          cayleyR x12 x13 x14 x15 x23 x24 x25 x34 x35 x45 = &0 `,\r
2962 LET_TR THEN REWRITE_TAC[ DIST_POW2_DOT] THEN REPEAT GEN_TAC THEN \r
2963 REWRITE_TAC[ MESON[VECTOR_ARITH` (a:real^n) - b = a - x - ( b - x ) `]`\r
2964   AA ( (x1 - x5 ) dot ( x1 - x5)) ((x2 - x3) dot (x2 - x3))\r
2965  ((x2 - x4) dot (x2 - x4))\r
2966  ((x2 - x5) dot (x2 - x5))\r
2967  ((x3 - x4) dot (x3 - x4))\r
2968  ((x3 - x5) dot (x3 - x5))\r
2969  ((x4 - x5) dot (x4 - x5)) =\r
2970   AA ( (x1 - x5 ) dot ( x1 - x5)) ((x2 - x1 - ( x3 - x1 )) dot (x2 - x1 - ( x3 - x1 )))\r
2971   ((x2 - x1 - ( x4 - x1 )) dot (x2 - x1 - ( x4 - x1 )))\r
2972   ((x2 - x1 - ( x5 - x1 )) dot (x2 - x1 - ( x5 - x1 )))\r
2973   ((x3 - x1 - ( x4 - x1 )) dot (x3 - x1 - ( x4 - x1 )))\r
2974   ((x3 - x1 - ( x5 - x1 )) dot (x3 - x1 - ( x5 - x1 )))\r
2975     ((x4 - x1 - ( x5 - x1 )) dot (x4 - x1 - ( x5 - x1 ))) ` ] THEN \r
2976 SIMP_TAC[VECTOR_ARITH ` ((x4: real^N) - x1 - (x5 - x1)) = x1 - x5 - ( x1 - x4 ) `] THEN \r
2977 ABBREV_TAC ` x12 = (x1 - ( x2:real^3)) ` THEN \r
2978 ABBREV_TAC ` x13 = (x1 - ( x3:real^3)) ` THEN \r
2979 ABBREV_TAC ` x14 = (x1 - ( x4:real^3)) ` THEN \r
2980 ABBREV_TAC ` x15 = (x1 - ( x5:real^3)) ` THEN \r
2981 REWRITE_TAC[DOT_3] THEN REWRITE_TAC[lemma_cm3; cayleyR] THEN REAL_AROTH_TAC);; *)\r
2982 \r
2983 \r
2984 let UPS_X_POS = MESON[lemma8; UPS_X_SYM; NORM_SUB]` &0 <=\r
2985           ups_x (norm ((x1 : real^3) - x2) pow 2) (norm (x1 - x3) pow 2)\r
2986           (norm (x2 - x3) pow 2) `;;\r
2987 \r
2988 let UPS_X_SYM = MESON[UPS_X_SYM]` !x y z. ups_x x y z = ups_x y x z /\ ups_x x y z = ups_x x z y\r
2989   /\ ups_x x y z = ups_x x z y `;;\r
2990 \r
2991 let LEMMA3 = prove(` !x1 x2 x3 x4 (x5 :real^3). \r
2992                  let x12 = dist (x1,x2) pow 2 in\r
2993          let x13 = dist (x1,x3) pow 2 in\r
2994          let x14 = dist (x1,x4) pow 2 in\r
2995          let x15 = dist (x1,x5) pow 2 in\r
2996          let x23 = dist (x2,x3) pow 2 in\r
2997          let x24 = dist (x2,x4) pow 2 in\r
2998          let x25 = dist (x2,x5) pow 2 in\r
2999          let x34 = dist (x3,x4) pow 2 in\r
3000          let x35 = dist (x3,x5) pow 2 in\r
3001          let x45 = dist (x4,x5) pow 2 in\r
3002          &0 <= ups_x x12 x13 x23 /\\r
3003          &0 <= delta x12 x13 x14 x23 x24 x34 /\\r
3004          cayleyR x12 x13 x14 x15 x23 x24 x25 x34 x35 x45 = &0 `, MP_TAC \r
3005 CAYLEYR_5POINTS THEN LET_TR THEN \r
3006 SIMP_TAC[ dist; UPS_X_POS; DELTA_POS_4POINTS]);;\r
3007 \r
3008 \r
3009 (* LEMMA 3 *)\r
3010 let NUHSVLM = LEMMA3;;\r
3011 \r
3012 let LEMMA52 = prove( `! v1 v2 v3 v4 (v5:real^3).\r
3013   muy_v v1 v2 v3 v4 v5 ( (d3 v4 v5) pow 2 ) = &0 `,\r
3014 REWRITE_TAC[muy_v; d3] THEN MP_TAC LEMMA3 THEN \r
3015 LET_TR THEN SIMP_TAC[]);;\r
3016 \r
3017 let PFDFWWV = LEMMA52;;\r
3018 \r
3019 let PRE_VIET = \r
3020 REAL_ARITH `!x x1 x2. (x - x1) * (x - x2) = x pow 2 - (x1 + x2) * x + x1 * x2 /\\r
3021  a * (x - x1) * (x - x2) = a * x pow 2 + ( -- a * (x1 + x2)) * x + a * x1 * x2 `;;\r
3022 \r
3023 \r
3024 let VIET_THEOREM = prove(`! x1 x2 a b c. (!x. a * x pow 2 + b * x + c = \r
3025 a * (x - x1) * (x - x2)) ==>  -- b = a * ( x1 + x2 ) /\ c = a * x1 * x2 `,\r
3026 REWRITE_TAC[PRE_VIET; REAL_LDISTRIB;REAL_SUB_LDISTRIB;\r
3027 REAL_ARITH ` a - b * c = a + -- b * c `; REAL_ARITH` ( a + b ) + c = \r
3028 a + b + c `] THEN \r
3029 REWRITE_TAC[REAL_MUL_ASSOC; EQUATE_CONEFS_POLINOMIAL_POW2] THEN \r
3030 SIMP_TAC[] THEN REAL_ARITH_TAC);;\r
3031 \r
3032 let ADD_SUB_POW2_EX = REAL_RING ` ( a + b ) pow 2 = a pow 2 + &2 * a * b + b pow 2 /\\r
3033 ( a - b ) pow 2 = a pow 2 - &2 * a * b + b pow 2 `;;\r
3034 \r
3035 let PRESENT_SUB_POW2 = REAL_RING` ! a b. ( a - b ) pow 2 = ( a + b ) pow 2 \r
3036   - &4 * a * b `;;\r
3037 \r
3038 let DIST_ROOT_AND_DISCRIMINANT = prove(` ! a b c x1 x2. ( ! x. a * x pow 2 + b * x + c =\r
3039  a * ( x - x1 ) * ( x - x2 ) )\r
3040   ==> ( a pow 2 ) * ( x1 - x2 ) pow 2 = b pow 2 - &4 * a * c `,\r
3041 NHANH (SPEC_ALL VIET_THEOREM) THEN REWRITE_TAC[PRESENT_SUB_POW2] THEN \r
3042 SIMP_TAC[REAL_ARITH ` -- b = a <=> b = -- a `] THEN REAL_ARITH_TAC);;\r
3043 \r
3044 (* le 33. P 22 MARKED *)\r
3045 \r
3046 let REAL_EQ_TO_LE_LT = REAL_ARITH ` \r
3047   ( a = b <=> ~( a < b \/ b < a ) )`;;\r
3048 \r
3049 let FEBRUARY_13_09 = prove(` &0 < (u - v) dot (&2 % x - (u + v)) <=>\r
3050   &0 < (u - v) dot (x - &1 / &2 % (u + v)) `,\r
3051 ONCE_REWRITE_TAC[MESON[REAL_ARITH ` &0 < a <=> &0 < &2 * a `]` (a <=> &0 < b ) <=>\r
3052   ( a <=> &0 < &2 * b ) `] THEN ONCE_REWRITE_TAC[VECTOR_ARITH ` x * (a dot b) =\r
3053   a dot x % b `] THEN \r
3054 REWRITE_TAC[GSYM VECTOR_SUB_DISTRIBUTE; VECTOR_MUL_ASSOC] THEN \r
3055 REWRITE_TAC[REAL_ARITH ` &2 * &1 / &2 = &1 `; VECTOR_MUL_LID]);;\r
3056 \r
3057 let SUB_DOT_NEG_TO_POS = MESON[VECTOR_ARITH ` ( a - b ) dot x = \r
3058 --  (( b - a ) dot x ) `;  REAL_ARITH ` -- a < &0 <=> &0 < a `]\r
3059 `! a b.  ( a - b ) dot x < &0 <=> &0 < ( b - a ) dot x `;;\r
3060 \r
3061 \r
3062 let LEMMA6 = prove(` !(u:real^3) v. ~(u = v) ==> plane_norm (bis u v) `,\r
3063 REWRITE_TAC[plane_norm; bis] THEN REPEAT STRIP_TAC THEN \r
3064 EXISTS_TAC ` (u: real^3) - v ` THEN \r
3065 EXISTS_TAC ` &1 / &2 % ((u: real^3) + v )` THEN \r
3066 REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM] THEN ASM_SIMP_TAC[VECTOR_SUB_EQ] THEN \r
3067 REWRITE_TAC[REAL_EQ_TO_LE_LT; DIST_LT_HALF_PLANE;FEBRUARY_13_09;\r
3068  SUB_DOT_NEG_TO_POS] THEN SIMP_TAC[VECTOR_ADD_SYM] THEN MESON_TAC[]);;\r
3069 \r
3070 let BXVMKNF = LEMMA6;;\r
3071 \r
3072 \r
3073 let b_coef = BC_DEL_FOR;;\r
3074 let c_coef = b_coef ;;\r
3075 \r
3076 let DELTA_X34_B = prove(` ! x12 x13 x14 x23 x24 x. delta_x34 x12 x13 x14 x23 x24 x =\r
3077   -- &2 * x12 * x + b_coef x12 x13 x14 x23 x24 `, REWRITE_TAC[ delta_x34; b_coef]);;\r
3078 \r
3079 \r
3080 \r
3081 \r
3082 let EQ_POW2_COND = prove(`!a b. &0 <= a /\ &0 <= b ==> (a = b <=> a pow 2 = b pow 2)`,\r
3083 REWRITE_TAC[REAL_ARITH` a = b <=> a <= b /\ b <= a `] THEN SIMP_TAC[POW2_COND]);;\r
3084 \r
3085 \r
3086 let EQ_SQRT_POW2_EQ = prove(` &0 <= a /\ &0 <= b ==> ( a = sqrt b <=> a pow 2 = b ) `,\r
3087 SIMP_TAC[SQRT_WORKS; EQ_POW2_COND]);;\r
3088 \r
3089 \r
3090 let LEMMA33 = prove(` !x34 x12 x13 v1 x14 v3 x23 v2 v4 x24 x34' x34'' a.\r
3091  condA v1 v2 v3 v4 x12 x13 x14 x23 x24 x34 /\\r
3092           (! x. muy_delta x12 x13 x14 x23 x24 x = a * ( x - x34' ) * ( x - x34'')) \r
3093 /\ x34' <= x34'' \r
3094   ==> delta_x34 x12 x13 x14 x23 x24 x34' =\r
3095              sqrt (ups_x x12 x13 x23 * ups_x x12 x14 x24) /\\r
3096              delta_x34 x12 x13 x14 x23 x24 x34'' =\r
3097              --sqrt (ups_x x12 x13 x23 * ups_x x12 x14 x24) `,\r
3098 REWRITE_TAC[muy_delta; DELTA_X34_B; DELTA_COEFS] THEN \r
3099 SIMP_TAC[EQUATE_CONEFS_POLINOMIAL_POW2; PRE_VIET; \r
3100 REAL_ARITH ` -- a = b <=> b = -- a`] THEN \r
3101 SIMP_TAC[REAL_RING `-- &2 * x12 * x34' + -- --x12 * (x34' + x34'') = a <=>\r
3102   -- &2 * x12 * x34'' + -- --x12 * (x34' + x34'') = -- a `] THEN \r
3103 REWRITE_TAC[REAL_ARITH` -- &2 * x12 * x34'' + -- --x12 * (x34' + x34'')\r
3104   = x12 * ( x34' - x34'' ) `; condA] THEN REPEAT STRIP_TAC THEN \r
3105 EXPAND_TAC "x12"  THEN EXPAND_TAC "x13" THEN EXPAND_TAC "x23" THEN \r
3106 EXPAND_TAC "x14" THEN EXPAND_TAC "x24" THEN \r
3107 UNDISCH_TAC ` x34' <= (x34'':real)` THEN \r
3108 ONCE_REWRITE_TAC[REAL_ARITH ` a <= b <=> &0 <= b - a `] THEN \r
3109 ONCE_REWRITE_TAC[ REAL_ARITH ` a * ( b - c ) = -- ( a * ( c - b ) ) `] THEN \r
3110 MP_TAC (GEN_ALL TROI_OI_DAT_HOI) THEN MP_TAC REAL_LE_POW_2 THEN \r
3111 REWRITE_TAC[REAL_ARITH` -- a = -- b <=> a = b `] THEN \r
3112 SIMP_TAC[UPS_X_SYM; REAL_LE_MUL; EQ_SQRT_POW2_EQ ] THEN \r
3113 ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN \r
3114 ONCE_REWRITE_TAC[ REAL_ARITH ` ( a * b ) pow 2 = a pow 2 * b pow 2 `] THEN \r
3115 REWRITE_TAC[PRESENT_SUB_POW2] THEN \r
3116 REWRITE_TAC[REAL_SUB_LDISTRIB; REAL_ARITH ` a pow 2 * b pow 2 = \r
3117 ( -- a * b ) pow 2   /\ a pow 2 * &4 * b = -- a * &4 * -- a * b `] THEN \r
3118 UNDISCH_TAC `b_coef x12 x13 x14 x23 x24 = --a * (x34' + x34'')` THEN \r
3119 UNDISCH_TAC `c_coef x12 x13 x14 x23 x24 = a * x34' * x34''` THEN \r
3120 UNDISCH_TAC `(a: real) = --x12` THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN \r
3121 SIMP_TAC[] THEN SIMP_TAC[REAL_ARITH` -- -- a = a /\ ( -- a * b) pow 2 = \r
3122   ( a * b ) pow 2 /\ ( a * -- b) pow 2 = ( a * b ) pow 2  `; REAL_ADD_SYM;\r
3123  REAL_MUL_SYM] THEN SIMP_TAC[REAL_ADD_SYM; REAL_MUL_SYM] THEN \r
3124 ONCE_REWRITE_TAC[REAL_ARITH ` ( a * b ) pow 2 = ( b * -- a ) pow 2 `] THEN \r
3125 SIMP_TAC[] THEN REPEAT STRIP_TAC THEN EXPAND_TAC "a" THEN \r
3126 REWRITE_TAC[REAL_RING ` a - -- c * b * &4 = a + &4 * c * b `] THEN \r
3127 MESON_TAC[AGBWHRD; UPS_X_SYM]);;\r
3128 \r
3129 let CMUDPKT = LEMMA33;;\r
3130 \r
3131 (* ============= *)\r
3132 \r
3133 \r
3134 let LEMMA_OF_LE20 = prove(` ! x y z: real^3.\r
3135    &2 <= d3 x y /\\r
3136          d3 x y <= #2.52 /\\r
3137          &2 <= d3 x z /\\r
3138          d3 x z <= #2.2 /\\r
3139          &2 <= d3 y z /\\r
3140          d3 y z <= #2.2\r
3141          ==> ~collinear {x, y, z}  `,\r
3142 MP_TAC JVUNDLC THEN \r
3143 SIMP_TAC[] THEN \r
3144 ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN \r
3145 REWRITE_TAC[MESON[]` (! a b c s. P a b c = s ==> Q a b c ) <=> \r
3146   (! a b c . Q a b c ) `] THEN \r
3147 SIMP_TAC[COL_EQ_UPS_0] THEN \r
3148 MATCH_MP_TAC (TAUT` a ==> b ==> a `) THEN \r
3149 REWRITE_TAC[GSYM d3] THEN \r
3150 REWRITE_TAC[REAL_ENTIRE] THEN \r
3151 CONV_TAC REAL_FIELD);;\r
3152 \r
3153 \r
3154 \r
3155 let LT_POW2_EQ_LT = MESON[POW2_COND_LT; REAL_ARITH ` a <= b <=> ~ ( b < a ) `]\r
3156 `&0 < a /\ &0 < b ==> ( a < b <=> a pow 2 < b pow 2 ) `;;\r
3157 \r
3158 \r
3159 \r
3160 \r
3161 let ETA_Y_LT_SQRT2 = prove(`eta_y #2.2 #2.2 #2.52 < sqrt #2`,\r
3162 REWRITE_TAC[eta_y; eta_x; ups_x] THEN LET_TR THEN \r
3163 CONV_TAC REAL_RAT_REDUCE_CONV THEN MP_TAC (REAL_FIELD ` &14641 / &8131< &2 `)\r
3164  THEN MP_TAC (REAL_FIELD ` &0 < &2 /\ &0 < &14641 / &8131 `) THEN \r
3165 NHANH (SPEC_ALL SQRT_POS_LT) THEN REWRITE_TAC[ REAL_ARITH ` #2 = &2 `] THEN \r
3166 SIMP_TAC[REAL_ARITH ` &0 < a ==> &0 <= a `;SQRT_POS_LT; LT_POW2_EQ_LT; SQRT_WORKS]);;\r
3167 \r
3168 let ETA_YY_LT_SQRT2 = MESON[ETA_Y_LT_SQRT2; REAL_ARITH ` #2 = &2 `]`\r
3169   eta_y #2.2 #2.2 #2.52 < sqrt ( &2 ) `;;\r
3170 \r
3171 let THANG_DEU = prove(` &2 <= x ==> &2 pow 2 <= x pow 2 `,\r
3172 NHANH (REAL_ARITH ` &2 <= x ==> &0 <= &2 /\ &0 <= x `) \r
3173 THEN MESON_TAC[POW2_COND]);;\r
3174 \r
3175 let LEMMA19 = BYOWBDF;;\r
3176 \r
3177 MESON[BYOWBDF; REAL_ARITH ` a + b = b + a `]` !a b c a' b' c'.\r
3178          &0 < a /\\r
3179          a <= a' /\\r
3180          &0 < b /\\r
3181          b <= b' /\\r
3182          &0 < c /\\r
3183          c <= c' /\\r
3184          a' pow 2 <= b pow 2 + c pow 2 /\\r
3185          b' pow 2 <= c pow 2 + a pow 2 /\\r
3186          c' pow 2 <= a pow 2 + b pow 2\r
3187          ==> eta_y a b c <= eta_y a' b' c' `;;\r
3188 \r
3189 \r
3190 \r
3191 \r
3192 let LEMMA20 = prove(` ! x y z: real^3.\r
3193    &2 <= d3 x y /\\r
3194          d3 x y <= #2.52 /\\r
3195          &2 <= d3 x z /\\r
3196          d3 x z <= #2.2 /\\r
3197          &2 <= d3 y z /\\r
3198          d3 y z <= #2.2\r
3199          ==> ~collinear {x, y, z} /\ radV {x, y, z} < sqrt (&2)`,\r
3200 REPEAT GEN_TAC THEN \r
3201 NHANH (SPEC_ALL LEMMA_OF_LE20) THEN \r
3202 SIMP_TAC[RADV_FORMULAR] THEN \r
3203 MP_TAC (REAL_ARITH ` #2.2 pow 2 <= &2 pow 2 + &2 pow 2 /\\r
3204   #2.52 pow 2 <=  &2 pow 2 + &2 pow 2 `) THEN \r
3205 IMP_IMP_TAC THEN \r
3206 NHANH THANG_DEU THEN \r
3207 PHA THEN \r
3208 NHANH (MESON[REAL_ARITH `\r
3209   a <= b + c /\ b <= bb /\ c <= cc ==> a <= bb + cc `]`\r
3210   #2.2 pow 2 <= &2 pow 2 + &2 pow 2 /\\r
3211      #2.52 pow 2 <= &2 pow 2 + &2 pow 2 /\\r
3212      a1 /\\r
3213      &2 pow 2 <= d3 x y pow 2 /\\r
3214      a2 /\\r
3215      a3 /\\r
3216      &2 pow 2 <= d3 x z pow 2 /\\r
3217      a4 /\\r
3218      a5 /\\r
3219      &2 pow 2 <= d3 y z pow 2 /\ last\r
3220      ==> #2.2 pow 2 <= d3 x z pow 2 + d3 x y pow 2 /\\r
3221          #2.2 pow 2 <= d3 x y pow 2 + d3 y z pow 2 /\\r
3222   #2.52 pow 2 <= d3 y z pow 2 + d3 x z pow 2 `) THEN \r
3223 MP_TAC (REAL_ARITH`! a b c. a <= b /\ b < c ==> a < c`) THEN \r
3224 MESON_TAC[BYOWBDF; ETA_YY_LT_SQRT2 ; REAL_ARITH ` b + c = c + b /\\r
3225  ( &2 <= a ==> &0 < a) `]);;\r
3226 \r
3227 let BFYVLKP = LEMMA20;;\r
3228 \r
3229 let NGAY23_THANG2_09 = prove(` &2 <= y /\ y <= sqrt (&8) ==>\r
3230   &2 pow 2 <= y * y /\ y * y <= &8 `,\r
3231 REWRITE_TAC[ GSYM REAL_POW_2] THEN DISCH_TAC THEN CONJ_TAC THENL \r
3232 [ASM_MESON_TAC[REAL_ARITH ` &2 <= a ==> &0 <= &2 /\ &0 <= a `;POW2_COND]; \r
3233 ASM_MESON_TAC[ SQRT_WORKS; REAL_ARITH ` &0 <= &8 `;\r
3234   POW2_COND; REAL_ARITH `&2 <= a /\ a <= b ==> &0 <= b /\ &0 <= a `]]);;\r
3235 \r
3236 \r
3237 \r
3238 let ETA_Y_SQRT8_2_251 = prove(` eta_y ( sqrt (&8) ) (&2) #2.51 < #1.453`,\r
3239 REWRITE_TAC[eta_y; eta_x; ups_x; GSYM POW_2] THEN \r
3240 LET_TR THEN \r
3241 REWRITE_TAC[MESON[SQRT_WORKS; REAL_ARITH ` &0 <= &8 `]` sqrt (&8) pow 2 = &8 `] THEN \r
3242 CONV_TAC REAL_RAT_REDUCE_CONV THEN \r
3243 MP_TAC (REAL_FIELD ` &0 < &20160320000 / &9551113999 /\ &0 < #1.453 `) THEN \r
3244 NHANH (SPEC_ALL SQRT_POS_LT) THEN \r
3245 SIMP_TAC[LT_POW2_EQ_LT; REAL_ARITH ` &0 < a ==> &0 <= a `; SQRT_POW_2] THEN \r
3246 DISCH_TAC THEN \r
3247 CONV_TAC REAL_FIELD );;\r
3248 \r
3249 MESON[BYOWBDF; REAL_ARITH ` a + b = b + a `]` !a b c a' b' c'.\r
3250          &0 < a /\\r
3251          a <= a' /\\r
3252          &0 < b /\\r
3253          b <= b' /\\r
3254          &0 < c /\\r
3255          c <= c' /\\r
3256          a' pow 2 <= b pow 2 + c pow 2 /\\r
3257          b' pow 2 <= c pow 2 + a pow 2 /\\r
3258          c' pow 2 <= a pow 2 + b pow 2\r
3259          ==> eta_y a b c <= eta_y a' b' c' `;;\r
3260 \r
3261 \r
3262 (* le 21 *)\r
3263 let LEMMA21 = prove(` ! y. &2 <= y /\ y <= sqrt8 ==> eta_y y (&2) #2.51 < #1.453`,\r
3264 REWRITE_TAC[sqrt8; GSYM POW_2] THEN \r
3265 NHANH (NGAY23_THANG2_09) THEN \r
3266 REWRITE_TAC[sqrt8; GSYM POW_2] THEN \r
3267 NHANH (REAL_ARITH ` &2 pow 2 <= y pow 2 /\ y pow 2 <= &8\r
3268      ==> &2 pow 2 <= #2.51 pow 2 + y pow 2 /\\r
3269          #2.51 pow 2 <= y pow 2 + &2 pow 2 /\\r
3270          &8 <= &2 pow 2 + #2.51 pow 2 `) THEN \r
3271 NHANH (REAL_ARITH ` &2 <= a ==> &0 < a /\ &0 < &2 /\ &0 < #2.51 /\ (! a. a <= a ) `) THEN \r
3272 GEN_TAC THEN \r
3273 MP_TAC (MESON[SQRT_WORKS; REAL_ARITH ` &0 <= &8 `]` sqrt (&8) pow 2 = &8 `) THEN \r
3274 MESON_TAC[REAL_ADD_SYM; BYOWBDF; ETA_Y_SQRT8_2_251;\r
3275   REAL_ARITH ` a <= b /\ b < c ==> a < c `]);;\r
3276 \r
3277 let WDOMZXH = LEMMA21;;\r
3278 \r
3279 \r
3280 \r
3281 \r
3282 let CDEUSDF_CHANGE = CDEUSDF;;\r
3283 \r
3284 \r
3285 let CIRCUMCENTER_FORMULAR = prove(` ! va vb vc.  ~collinear {va, vb, vc}\r
3286  ==> circumcenter {va, vb, vc} =\r
3287   (d3 vb vc pow 2 *\r
3288            (d3 va vc pow 2 + d3 va vb pow 2 - d3 vb vc pow 2)) /\r
3289           (ups_x (d3 vb vc pow 2) (d3 va vc pow 2) (d3 va vb pow 2)) %\r
3290           va +\r
3291           (d3 va vc pow 2 *\r
3292            (d3 vb vc pow 2 + d3 va vb pow 2 - d3 va vc pow 2)) /\r
3293           (ups_x (d3 vb vc pow 2) (d3 va vc pow 2) (d3 va vb pow 2)) %\r
3294           vb +\r
3295           (d3 va vb pow 2 *\r
3296            (d3 vb vc pow 2 + d3 va vc pow 2 - d3 va vb pow 2)) /\r
3297           (ups_x (d3 vb vc pow 2) (d3 va vc pow 2) (d3 va vb pow 2)) %\r
3298           vc `,\r
3299 ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN \r
3300 MP_TAC CDEUSDF_CHANGE THEN LET_TR THEN MESON_TAC[]);;\r
3301 \r
3302 let LE_EX = REAL_ARITH ` &0 <= a <=> a = &0 \/ &0 < a `;;\r
3303 \r
3304 let SUM_UPS_X_1 = prove(`!a b c.\r
3305      &0 < ups_x a b c\r
3306      ==> (c * (b + a - c)) / ups_x a b c +\r
3307          (a * (c + b - a)) / ups_x a b c +\r
3308          (b * (c + a - b)) / ups_x a b c =\r
3309          &1`, REWRITE_TAC[ups_x] THEN CONV_TAC REAL_FIELD);;\r
3310 \r
3311 \r
3312 let LEMMA18 = prove(` !x (y:real^3) z p.\r
3313          d3 x z pow 2 < d3 x y pow 2 + d3 y z pow 2 /\\r
3314          ~collinear {x, y, z} /\\r
3315          p = circumcenter {x, y, z}\r
3316          ==> p IN aff_gt {x, z} {y}  `,\r
3317 SIMP_TAC[CIRCUMCENTER_FORMULAR] THEN \r
3318 REWRITE_TAC[ UPS_X_EQ_ZERO_COND; GSYM d3 ] THEN \r
3319 REPEAT GEN_TAC THEN MP_TAC ZERO_LE_UPS_X  THEN \r
3320 IMP_IMP_TAC THEN REWRITE_TAC[LE_EX] THEN \r
3321 REWRITE_TAC[MESON[]`( a \/ b ) /\ c /\ ~a /\ e <=>\r
3322   b /\ c /\ ~a /\ e `] THEN ONCE_REWRITE_TAC[REAL_ARITH\r
3323  ` a < b + c <=> &0 < b + c - a `] THEN \r
3324 REWRITE_TAC[d3; GSYM UPS_X_EQ_ZERO_COND] THEN \r
3325 ONCE_REWRITE_TAC[VECTOR_ARITH` (a:real^N) + b + c = a + c + b `] THEN \r
3326 NHANH (MESON[TWO_EQ_IMP_COL3; PER_SET3]`~collinear {x, y, z} ==> ~ ( x = z)`) \r
3327 THEN REWRITE_TAC[DIST_NZ; simp_def2; IN_ELIM_THM] THEN \r
3328 STRIP_TAC THEN SIMP_TAC[DIST_SYM] THEN UNDISCH_TAC \r
3329 ` &0 < ups_x (dist (x,y) pow 2)   (dist (x,z) pow 2) \r
3330 (dist ((y:real^3),z) pow 2) ` THEN \r
3331 SIMP_TAC [MESON[UPS_X_SYM]` ups_x x y z = ups_x z y x `] THEN \r
3332 DOWN_TAC THEN \r
3333 ONCE_REWRITE_TAC[MESON[REAL_ARITH `a + b - c = b + a - c `]` ( &0\r
3334   < a + b - c /\ l ==> ll ) <=> ( &0 < b + a - c /\ l ==> ll )`] THEN \r
3335 STRIP_TAC THEN EXISTS_TAC ` (dist ((y:real^3),z) pow 2 *\r
3336       (dist (x,z) pow 2 + dist (x,y) pow 2 - dist (y,z) pow 2)) /\r
3337      ups_x (dist (x,y) pow 2) (dist (x,z) pow 2) (dist (y,z) pow 2) ` THEN \r
3338 EXISTS_TAC `(dist ((x:real^3),y) pow 2 *\r
3339       (dist (y,z) pow 2 + dist (x,z) pow 2 - dist (x,y) pow 2)) /\r
3340      ups_x (dist (x,y) pow 2) (dist (x,z) pow 2) (dist (y,z) pow 2)` THEN \r
3341 EXISTS_TAC `   (dist ((x:real^3),z) pow 2 *\r
3342       (dist (y,z) pow 2 + dist (x,y) pow 2 - dist (x,z) pow 2)) /\r
3343      ups_x (dist (x,y) pow 2) (dist (x,z) pow 2) (dist (y,z) pow 2) ` THEN \r
3344 CONJ_TAC THENL [UNDISCH_TAC `&0 < ups_x (dist (x,y) pow 2)\r
3345    (dist (x,z) pow 2) (dist ((y:real^3),z) pow 2)` THEN \r
3346 REWRITE_TAC[SUM_UPS_X_1]; CONJ_TAC] THENL [DOWN_TAC THEN \r
3347 REWRITE_TAC[MESON[POW_2]` ( a pow 2) * b = ( a * a ) * b `] THEN\r
3348 MESON_TAC[REAL_LT_MUL; REAL_LT_DIV]; SIMP_TAC[]]);;\r
3349 \r
3350 let WSMRDKN = LEMMA18;;\r
3351 let LEMMA19 = BYOWBDF;; \r
3352 \r
3353 \r
3354 \r
3355 MESON[POW2_COND; REAL_ARITH `&2 <= a /\ a <= b ==> &0 <= b /\ &0 <= a `]`\r
3356   &2 <= y /\ y <= b ==> y pow 2 <= b pow 2 `;;\r
3357 \r
3358 \r
3359 let FACTOR_OF_QUADRARTIC = prove(`! a b c x. ~(a = &0) /\ \r
3360 &0 <= b pow 2 - &4 * a * c ==> a * x pow 2 + b * x + c =\r
3361      a *\r
3362      (x - (--b + sqrt (b pow 2 - &4 * a * c)) / (&2 * a)) *\r
3363      (x - (--b - sqrt (b pow 2 - &4 * a * c)) / (&2 * a))`   ,\r
3364 REWRITE_TAC[PRE_VIET] THEN SIMP_TAC[REAL_FIELD ` ~( a = &0 ) ==> \r
3365 -- a * ( ( --b + del) / ( &2 * a ) + ( --b - del) / ( &2 * a )) = b `] THEN \r
3366 REWRITE_TAC[REAL_FIELD ` a / b * a' / b = ( a * a' ) / ( b pow 2 ) `] THEN \r
3367 REWRITE_TAC[REAL_FIELD ` a / b * a' / b = ( a * a' ) / ( b pow 2 ) `; \r
3368   REAL_DIFFSQ; GSYM REAL_POW_2] THEN SIMP_TAC[SQRT_WORKS] THEN \r
3369 SIMP_TAC[REAL_FIELD ` ~ ( a = &0 ) ==> a * (--b pow 2 - \r
3370  (b pow 2 - &4 * a * c)) / (&2 * a) pow 2 = c `]);;\r
3371 \r
3372 \r
3373 let COMPUTE_TO_QUA_POLY = prove(` #2.696 <= x /\ x <= sqrt8  ==> \r
3374 x pow 2  * ( &1 / eta_y x #2.45 #2.45 pow 2 -\r
3375   &1 / eta_y x ( &2 ) #2.51 pow 2 ) = &4331842500 / &363188227801 * x pow 4 +\r
3376      -- &45702201 / &302530802 * x pow 2 +\r
3377      &529046001 / &2520040000 `, REWRITE_TAC[eta_y; eta_x; ups_x] THEN \r
3378 LET_TR THEN \r
3379 CONV_TAC REAL_RAT_REDUCE_CONV THEN \r
3380 NHANH (MESON[REAL_ARITH ` #2.696 <= x /\ x <= sqrt8 ==>\r
3381   &0 <= #2.696 /\ &0 <= x `; REAL_LE_MUL2] ` #2.696 <= x /\ x <= sqrt8 ==>\r
3382    #2.696 * #2.696 <= x * x /\ x * x <= sqrt8 * sqrt8 `) THEN \r
3383 NHANH (MESON[REAL_ARITH ` #2.696 * #2.696 <= x ==> &0 <= #2.696 * #2.696 /\ &0 <= x `; REAL_LE_MUL2] `\r
3384   #2.696 * #2.696 <= x /\ x <= hh ==> (#2.696 * #2.696) * #2.696 * #2.696 <= x * x /\\r
3385   x * x <= hh * hh `) THEN \r
3386 REWRITE_TAC[sqrt8] THEN \r
3387 REWRITE_TAC[REAL_POLY_CONV ` (--(x * x) * x * x - &16 - &3969126001 / &100000000 +\r
3388         &2 * (x * x) * &63001 / &10000 +\r
3389         &2 * (x * x) * &4 +\r
3390         &63001 / &1250) `] THEN \r
3391 REWRITE_TAC[REAL_POLY_CONV `\r
3392   (--(x * x) * x * x - &5764801 / &160000 - &5764801 / &160000 +\r
3393         &2 * (x * x) * &2401 / &400 +\r
3394         &2 * (x * x) * &2401 / &400 +\r
3395         &5764801 / &80000) `] THEN \r
3396 REWRITE_TAC[REAL_ARITH ` x pow 4 = ( x pow 2 ) pow 2 `] THEN \r
3397 MP_TAC (REAL_ARITH ` ~ ( -- &1 = &0 ) /\ &0 <= ( &103001 / &5000 ) pow 2 - &4 * ( -- &1 ) * -- &529046001 / &100000000 `) THEN \r
3398 SIMP_TAC[FACTOR_OF_QUADRARTIC] THEN \r
3399 CONV_TAC REAL_RAT_REDUCE_CONV THEN \r
3400 REWRITE_TAC[REAL_ARITH ` (&252004 / &625) = ( &502 / &25 ) * ( &502 / &25 ) `] THEN \r
3401 REWRITE_TAC[MESON[REAL_ARITH ` &0 <= &502 / &25 /\ x * x = x pow 2 `; POW_2_SQRT]`\r
3402   sqrt ( ( &502 / &25 ) * ( &502 / &25 )) = ( &502 / &25 ) `] THEN \r
3403 CONV_TAC REAL_RAT_REDUCE_CONV THEN \r
3404 REWRITE_TAC[ GSYM POW_2] THEN \r
3405 REWRITE_TAC[REAL_ARITH `  a * x pow 2 + b * x = ( a * x + b ) * x `] THEN \r
3406 REWRITE_TAC[MESON[SQRT_WORKS; REAL_ARITH ` &0 <= &8`]` sqrt (&8) pow 2 = &8 `] THEN \r
3407 NHANH (REAL_FIELD ` (&113569 / &15625 <= x pow 2 /\ x pow 2 <= &8) \r
3408   ==> &0 <= (-- &1 * x pow 2 + &2401 / &100) /\\r
3409   &0 <= (x pow 2 - &2601 / &10000 ) /\\r
3410   &0 <= -- ((x pow 2 - &203401 / &10000) )/\ &0 <= &5764801 / &160000 /\ \r
3411 &0 <= &63001 / &2500`) THEN \r
3412 MP_TAC REAL_LE_POW_2 THEN \r
3413 REWRITE_TAC[REAL_ARITH ` -- &1 * a * b = a * -- b `] THEN \r
3414 REWRITE_TAC[REAL_FIELD ` ( &1 / a ) pow 2  = &1 / ( a pow 2 ) `] THEN \r
3415 MP_TAC REAL_LE_MUL THEN \r
3416 MP_TAC REAL_LE_DIV THEN \r
3417 SIMP_TAC[ SQRT_WORKS] THEN \r
3418 REWRITE_TAC[REAL_SUB_LDISTRIB] THEN \r
3419 REWRITE_TAC[REAL_FIELD ` &1 / ( a / b ) = b / a `] THEN \r
3420 SIMP_TAC[REAL_FIELD ` &113569 / &15625 <= a ==> a * ( b / ( a * c )) = b / c `] THEN \r
3421 REWRITE_TAC[REAL_POLY_CONV ` ((-- &1 * x pow 2 + &2401 / &100) * x pow 2) / (&5764801 / &160000) -\r
3422      ((x pow 2 - &2601 / &10000) * --(x pow 2 - &203401 / &10000)) /\r
3423      (&63001 / &2500) `] THEN \r
3424 REWRITE_TAC[REAL_ARITH ` a pow 4 = a pow 2 pow 2 `]);;\r
3425 \r
3426 REAL_ARITH ` &4650694416 = ( &68196 ) pow 2 `;;\r
3427 REAL_ARITH` &4650694416 / &363188227801 = ( &68196 / &602651 ) pow 2 `;;\r
3428 \r
3429 \r
3430 let PHAN_TICH = prove(  `! x. &4331842500 / &363188227801 *\r
3431      (x pow 2 - &488365801 / &44090000) *\r
3432      (x pow 2 - &2081667 / &1310000) =\r
3433      &4331842500 / &363188227801 * x pow 4 +\r
3434      -- &45702201 / &302530802 * x pow 2 +\r
3435      &529046001 / &2520040000`   , REAL_ARITH_TAC);;\r
3436 \r
3437 let Q_TR = prove(`! x. #2.696 <= x /\ x <= sqrt8 ==>\r
3438   x pow 2 *\r
3439          (&1 / eta_y x #2.45 #2.45 pow 2 - &1 / eta_y x (&2) #2.51 pow 2) <= &0 `, \r
3440 SIMP_TAC[COMPUTE_TO_QUA_POLY; GSYM PHAN_TICH ] THEN \r
3441 NHANH (MESON[REAL_ARITH ` #2.696 <= x /\ x <= hh ==> &0 <= #2.696 /\ &0 <= x`\r
3442   ; REAL_LE_MUL2] ` #2.696 <= x /\ x <= hh ==>\r
3443    #2.696 * #2.696 <= x * x /\ x * x <= hh * hh `) THEN \r
3444 REWRITE_TAC[REAL_ARITH `\r
3445          &4331842500 / &363188227801 * a <= &0 <=> a <= &0 `] THEN \r
3446 CONV_TAC REAL_RAT_REDUCE_CONV THEN \r
3447 REWRITE_TAC[REAL_ARITH ` &0 <=\r
3448          &4331842500 / &363188227801 * a <=> &0 <= a `; sqrt8; GSYM POW_2;\r
3449   MESON[SQRT_WORKS; REAL_ARITH ` &0 <= &8 `]` sqrt (&8) pow 2 = &8 `] THEN \r
3450 NHANH (REAL_ARITH ` &113569 / &15625 <= x pow 2 /\\r
3451      x pow 2 <= &8 ==> x pow 2 - &488365801 / &44090000 <= &0 /\\r
3452   x pow 2 - &2081667 / &1310000 >= &0 `) THEN \r
3453 REWRITE_TAC[ REAL_ARITH ` ( a >= &0 <=> &0 <= a)/\ (a <= &0 <=> &0 <= -- a ) `] THEN \r
3454 REWRITE_TAC[REAL_ARITH ` -- ( a * b ) = -- a * b `] THEN \r
3455 MESON_TAC[REAL_LE_MUL]);;\r
3456 \r
3457 let SQRT8_LT = prove(` sqrt (&8) < &4 * #2.45 `,\r
3458 MP_TAC (REAL_ARITH ` &0 < &8 /\ &0 <  &4 * #2.45`) THEN \r
3459 SIMP_TAC[SQRT_POS_LT; LT_POW2_EQ_LT] THEN \r
3460 SIMP_TAC[REAL_LT_IMP_LE; SQRT_WORKS] THEN REAL_ARITH_TAC);;\r
3461 \r
3462 \r
3463 \r
3464 let SQRT8_POW2 = MESON[SQRT_WORKS; REAL_ARITH ` &0 <= &8 `]` sqrt (&8) pow 2 = &8 `;;\r
3465 \r
3466 \r
3467 let IM_UP_POS = prove(`! x. #2.696 <= x /\ x <= sqrt8 ==>\r
3468 &0 < ups_x (x * x) (#2.45 * #2.45) (#2.45 * #2.45) /\\r
3469 &0 < ups_x (x * x) (&2 * &2) (#2.51 * #2.51) `,\r
3470 REWRITE_TAC[ups_x] THEN \r
3471 REWRITE_TAC[REAL_IDEAL_CONV [` (x:real) pow 2 `]` \r
3472          --(x * x) * x * x -\r
3473          (#2.45 * #2.45) * #2.45 * #2.45 -\r
3474          (#2.45 * #2.45) * #2.45 * #2.45 +\r
3475          &2 * (x * x) * #2.45 * #2.45 +\r
3476          &2 * (x * x) * #2.45 * #2.45 +\r
3477          &2 * (#2.45 * #2.45) * #2.45 * #2.45 `] THEN \r
3478 CONV_TAC REAL_RAT_REDUCE_CONV THEN \r
3479 REWRITE_TAC[REAL_POLY_CONV ` --(x * x) * x * x - &16 - &3969126001 / &100000000 +\r
3480          &2 * (x * x) * &63001 / &10000 +\r
3481          &2 * (x * x) * &4 +\r
3482          &63001 / &1250 `] THEN \r
3483 NHANH (REAL_ARITH` #2.696 <= x /\ x <= s ==> &0 <= #2.696 /\\r
3484   &0 <= x /\ &0 <= s `) THEN \r
3485 ONCE_REWRITE_TAC[MESON[]` a /\ b ==> c <=> b ==> a ==> c `] THEN \r
3486 SIMP_TAC[POW2_COND; sqrt8; SQRT8_POW2] THEN \r
3487 NHANH (REAL_ARITH` #2.696 pow 2 <= x /\ x <= &8 ==> \r
3488   &0 < &2401 / &100 + -- &1 * x /\ &0 < x /\\r
3489   ~ ( -- &1 = &0 ) /\ &0 <= ( &103001 / &5000 ) pow 2 - &4 * -- &1 *\r
3490   -- &529046001 / &100000000 `) THEN \r
3491 SIMP_TAC[REAL_ARITH ` x pow 4 = x pow 2 pow 2 `; FACTOR_OF_QUADRARTIC] THEN \r
3492 CONV_TAC REAL_RAT_REDUCE_CONV THEN \r
3493 REWRITE_TAC[REAL_ARITH ` &252004 / &625 = ( &502 / &25) pow 2 `] THEN \r
3494 REWRITE_TAC[MESON[POW_2_SQRT; REAL_ARITH ` &0 <= &502 / &25 `]` \r
3495   sqrt ((&502 / &25) pow 2) = &502 / &25 `] THEN \r
3496 CONV_TAC REAL_RAT_REDUCE_CONV THEN \r
3497 NHANH (REAL_ARITH ` &113569 / &15625 <= x pow 2 /\ x pow 2 <= &8 ==>\r
3498   &0 < x pow 2 - &2601 / &10000 /\ &0 < -- (x pow 2 - &203401 / &10000) `) THEN \r
3499 REWRITE_TAC[REAL_ARITH ` -- &1 * a * b = a * --b `] THEN \r
3500 SIMP_TAC[REAL_LT_MUL]);;\r
3501 \r
3502 \r
3503 let IMP_ETAY_POS = prove( `! x. #2.696 <= x /\ x <= sqrt8 ==>\r
3504 &0 < eta_y x #2.45 #2.45 /\ &0 < eta_y x (&2) #2.51 `,\r
3505 REWRITE_TAC[eta_y; eta_x] THEN \r
3506 LET_TR THEN \r
3507 NHANH (MESON[REAL_ARITH ` &0 <= #2.696`; REAL_LE_MUL2]`\r
3508   #2.696 <= x ==> #2.696 * #2.696 <= x * x `) THEN \r
3509 NHANH (REAL_ARITH ` #2.696 * #2.696 <= x * x ==>\r
3510   &0 < ((x * x) * (#2.45 * #2.45) * #2.45 * #2.45) /\\r
3511   &0 < ((x * x) * (&2 * &2) * #2.51 * #2.51) `) THEN \r
3512 MESON_TAC[IM_UP_POS; REAL_LT_DIV; SQRT_POS_LT]);;\r
3513 \r
3514 \r
3515 let REAL_LE_RDIV_0 = prove(` ! a b. &0 < b ==> ( &0 <= a / b <=> &0 <= a ) `,\r
3516 REWRITE_TAC[REAL_ARITH ` &0 <= a <=> &0 < a \/ a = &0 `] THEN \r
3517 SIMP_TAC[REAL_LT_RDIV_0] THEN \r
3518 SIMP_TAC[REAL_FIELD `&0 < b ==> ( a / b = &0 <=> a = &0 ) `]);;\r
3519 \r
3520 \r
3521 let NHSJMDH = prove(` ! y. #2.696 <= y /\ y <= sqrt8 ==>\r
3522      eta_y y (&2) (#2.51) <= eta_y y #2.45 (#2.45) `,\r
3523 NHANH (SPEC_ALL Q_TR) THEN \r
3524 ONCE_REWRITE_TAC[MESON[]` a /\ b ==> c <=> a ==> b ==> c `] THEN \r
3525 NHANH (MESON[REAL_ARITH ` &0 <= #2.696`; REAL_LE_MUL2]`\r
3526   #2.696 <= x ==> #2.696 * #2.696 <= x * x `)  THEN \r
3527 REWRITE_TAC[POW_2] THEN \r
3528 NHANH (REAL_ARITH `#2.696 * #2.696 <= y ==> &0 < y `) THEN \r
3529 REWRITE_TAC[REAL_ARITH ` a * b <= &0 <=> &0 <= a * -- b `] THEN \r
3530 SIMP_TAC[REAL_LE_MUL_EQ] THEN \r
3531 ONCE_REWRITE_TAC[MESON[]`( a/\b ) /\ c <=> ( a /\ c ) /\ b `] THEN \r
3532 NHANH (SPEC_ALL IMP_ETAY_POS) THEN \r
3533 NHANH (REAL_ARITH ` &0 < eta_y a b c ==> ~(eta_y a b c = &0 ) `) THEN \r
3534 REWRITE_TAC[GSYM REAL_POSSQ] THEN SIMP_TAC[REAL_FIELD ` &0 < a /\\r
3535  &0 < b ==>  -- (&1 / a - &1 / b) = (a - b) / ( a * b ) `] THEN \r
3536 PHA THEN SIMP_TAC[REAL_LT_MUL; REAL_LE_RDIV_0] THEN \r
3537 REWRITE_TAC[GSYM REAL_DIFFSQ] THEN \r
3538 SIMP_TAC[REAL_LT_ADD; REAL_LE_MUL_EQ] THEN REAL_ARITH_TAC);;\r
3539 \r
3540 \r
3541 \r
3542 \r
3543 \r
3544 \r
3545 \r
3546 \r
3547 \r
3548 \r
3549 \r
3550 \r
3551 \r
3552 \r
3553 \r
3554 \r
3555 \r
3556 \r
3557 (* NEW WORKS *)\r
3558 let SQRT8_LE = MESON[ REAL_ARITH ` &0 <= &8`; SQRT_WORKS]` &0 <= sqrt (&8) `;;\r
3559 \r
3560 let RELATE_POW2 = prove(` ( a = &0 <=> a pow 2 = &0 ) /\\r
3561   ( &0 < a pow 2 <=> &0 < a \/ ~( &0 <= a )) `,\r
3562 MP_TAC (REAL_FIELD ` a = &0 <=> a pow 2 = &0 `) THEN DISCH_TAC THEN \r
3563 CONJ_TAC THENL [ASM_SIMP_TAC[]; MP_TAC REAL_LE_POW_2] THEN \r
3564 MP_TAC (REAL_ARITH `( ! a. &0 < a \/ ~(&0 <= a) \/ a = &0 )`) THEN \r
3565 MP_TAC (REAL_FIELD ` a = &0 <=> a pow 2 = &0 `) THEN \r
3566 REWRITE_TAC[REAL_ARITH ` A <= b <=> A = b \/ A < b `] THEN \r
3567 MESON_TAC[REAL_ARITH ` ~ ( a = &0 /\ ( &0 < a \/ ~( &0 <= a ) )) `]);;\r
3568 \r
3569 let LT_POW2_COND = prove(`!a b. &0 <= a /\ &0 <= b ==> (a < b <=> a pow 2 < b pow 2)`,\r
3570 REPEAT GEN_TAC THEN ASM_CASES_TAC ` a = &0 ` THENL\r
3571 [ASM_SIMP_TAC[REAL_ARITH` &0 pow 2 = &0 `] THEN MESON_TAC[RELATE_POW2]; \r
3572 ASM_SIMP_TAC[REAL_LE_LT]] THEN STRIP_TAC THENL [ASM_MESON_TAC[LT_POW2_EQ_LT];\r
3573 EXPAND_TAC "b"] THEN UNDISCH_TAC `&0 < a ` THEN REWRITE_TAC[REAL_ARITH `\r
3574  &0 pow 2 = &0 /\ (a < &0 <=> ~(&0 <= a))`] THEN MP_TAC REAL_LE_POW_2 THEN \r
3575 MESON_TAC[REAL_LT_IMP_LE]);;\r
3576 \r
3577 \r
3578 let POS_IMP_POW2 = MESON[REAL_LE_TRANS; POW2_COND]` &0 <= a /\ a <= b ==> a pow 2 \r
3579   <= b pow 2 `;;\r
3580 \r
3581 \r
3582 let SQRT8_LE_EQ_8_LESS_POW2 = prove(` sqrt (&8 ) <= a ==> &8 <= a pow 2 `,\r
3583 MP_TAC SQRT8_LE THEN MESON_TAC[SQRT8_POW2; POS_IMP_POW2]);;\r
3584 \r
3585 \r
3586 let MINIMAL_QUADRATIC_POLY =  prove(` \r
3587 ! b c (x:real). ( &4 * c - b pow 2 ) / &4 <= x pow 2 + b * x + c `,\r
3588 ONCE_REWRITE_TAC[REAL_ARITH ` a <= b <=> &0 <= b - a `] THEN \r
3589 REWRITE_TAC[REAL_ARITH ` (x pow 2 + b * x + c) - (&4 * c - b pow 2) / &4\r
3590   = ( x + b / &2 ) pow 2 `; REAL_LE_POW_2]);;\r
3591 \r
3592 let GREATER_THAN_MID_QUADRATIC_PO = prove(` ! b c x x0. -- b / &2 <= x0 /\ x0 <= x ==>\r
3593   x0 pow 2 + b * x0 + c <= x pow 2 + b * x + c `,\r
3594 REWRITE_TAC[REAL_ARITH ` x0 pow 2 + b * x0 + c <= x pow 2 + b * x + c\r
3595   <=> &0 <= ( x - x0 ) * ( x + x0 + b ) `] THEN \r
3596 MESON_TAC[REAL_ARITH ` --b / &2 <= x0 /\ x0 <= x ==>\r
3597   &0 <= x - x0 /\ &0 <= x + x0 + b `; REAL_LE_MUL]);;\r
3598 \r
3599 (* PERMAINENCE *)\r
3600 (* MARCH WORKS *)\r
3601 \r
3602 let SQRT8_TWO_TWO = prove(` sqrt (&8) <= &2 + &2 `,\r
3603 MP_TAC SQRT8_LE THEN NHANH (MESON[REAL_ARITH ` &0 <= &2 + &2 `]\r
3604 `&0 <= sqrt (&8) ==> &0 <= &2 + &2 `) THEN SIMP_TAC[POW2_COND] THEN \r
3605 SIMP_TAC[REAL_ARITH ` &0 <= &8 `; SQRT_WORKS] THEN REAL_ARITH_TAC);;\r
3606 \r
3607 \r
3608 let A_POS_DELTA = prove(` &0 < delta (#3.2 pow 2 ) (sqrt8 pow 2 ) (&2 pow 2) (sqrt8 pow 2) \r
3609 (&2 pow 2) (&2 pow 2) `, REWRITE_TAC[delta; sqrt8; SQRT8_POW2] THEN REAL_ARITH_TAC);;\r
3610 \r
3611 (* le 35. p 22 *)\r
3612 let THADGSB = new_axiom` !M13 m12 m14 M24 m34 m23 v1 v2 v3 v4.\r
3613          (!x. x IN {M13, m12, m14, M24, m34, m23} ==> &0 <= x) /\\r
3614          M13 < m12 + m23 /\\r
3615          M13 < m14 + m34 /\\r
3616          M24 < m12 + m14 /\\r
3617          M24 < m23 + m34 /\\r
3618          &0 <\r
3619          delta (M13 pow 2) (m12 pow 2) (m14 pow 2) (M24 pow 2) (m34 pow 2)\r
3620          (m23 pow 2) /\\r
3621          CARD {v1, v2, v3, v4} = 4 /\ \r
3622    m12 <= d3 v1 v2 /\\r
3623          m23 <= d3 v2 v3 /\\r
3624          m34 <= d3 v3 v4 /\\r
3625          m14 <= d3 v1 v4 /\\r
3626          d3 v1 v3 <= M13 /\\r
3627          d3 v2 v4 <= M24 ==> conv {v1,v3} INTER conv {v2,v4} = {} `;;\r
3628 \r
3629 let MET_LAM_ROI = prove(` #3.2 < sqrt8 + &2 /\ #3.2 < &2 + &2 /\ sqrt8 < sqrt8 + &2 /\\r
3630 sqrt8 < &2 + &2 `,\r
3631 REWRITE_TAC[sqrt8; REAL_ARITH ` a < sqrt (&8) + b <=> a - b < sqrt (&8) `] THEN \r
3632 REWRITE_TAC[REAL_ARITH ` sqrt (&8) - &2 < sqrt (&8) `] THEN \r
3633 CONV_TAC REAL_RAT_REDUCE_CONV THEN MP_TAC SQRT8_LE  THEN \r
3634 MP_TAC (REAL_ARITH` &0 <= &6 / &5 /\ &0 <= &4 `) THEN \r
3635 SIMP_TAC[LT_POW2_COND ] THEN SIMP_TAC[LT_POW2_COND; SQRT8_POW2 ] THEN \r
3636 REAL_ARITH_TAC);;\r
3637 \r
3638 \r
3639 let PROVE_POS_THINGS = prove(` ! x. x IN {#3.2 , sqrt8, &2 , sqrt8, &2, &2 } ==> &0 <= x `,\r
3640 REWRITE_TAC[SET_RULE `( !x. x IN {a,b,c,d,s,e} ==> p x ) <=>\r
3641   p a /\ p b /\ p c /\ p d /\ p s /\ p e `;sqrt8;  SQRT8_LE] THEN REAL_ARITH_TAC);;\r
3642 \r
3643 \r
3644 \r
3645 let IMP_GT_THAN_TWO = prove(` ! v1 v2 w1 (w2:real^3).\r
3646            CARD {v1, w1,v2, w2} = 4 /\\r
3647            packing {v1, w1,v2, w2}\r
3648 ==>       &2 <= d3 w1 v2 /\\r
3649          &2 <= d3 v2 w2 /\\r
3650          &2 <= d3 v1 w2  `,\r
3651 REWRITE_TAC[CARD4; packing; GSYM d3; sqrt8] THEN SET_TAC[]);;\r
3652 \r
3653 (*       THADGSB         *)\r
3654 \r
3655 let JGYWWBX = prove(` ~ (?v1 v2 w1 (w2:real^3).\r
3656            CARD {v1, v2, w1, w2} = 4 /\\r
3657            packing {v1, v2, w1, w2} /\\r
3658            dist (v1,w1) >= sqrt8 /\\r
3659            dist (v1,v2) <= #3.2 /\\r
3660            dist (w1,w2) <= sqrt8 /\\r
3661            ~(conv {v1, v2} INTER conv {w1, w2} = {}))`,\r
3662 MP_TAC (MESON[ REAL_ARITH ` &0 <= &8 /\ &0 <= &2 /\ &0 <= #3.2 `;\r
3663    SQRT_WORKS]` &0 <= sqrt (&8) /\ &0 <= &2 /\ &0 <= #3.2`) THEN \r
3664 MP_TAC MET_LAM_ROI THEN \r
3665 REWRITE_TAC[MESON[]` CARD s = 4 /\ b /\ c <=> ( CARD s = 4 /\ b ) /\ c `] THEN \r
3666 ONCE_REWRITE_TAC[SET_RULE ` {v1, v2, w1, w2} = {v1,w1,v2,w2} `] THEN \r
3667 NHANH (SPEC_ALL IMP_GT_THAN_TWO ) THEN MP_TAC PROVE_POS_THINGS THEN \r
3668 MP_TAC A_POS_DELTA THEN REWRITE_TAC[GSYM d3; REAL_ARITH ` a >= b <=> b <= a `]\r
3669  THEN IMP_IMP_TAC THEN DISCH_TAC THEN NGOAC THEN \r
3670 MATCH_MP_TAC (MESON[]` (! v1 v2 w1 w2. P v1 v2 w1 w2 ==> Q v1 v2 w1 w2)\r
3671   ==> ~(? v1 v2 w1 w2. P v1 v2 w1 w2 /\ ~( Q v1 v2 w1 w2)) `) THEN \r
3672 REPEAT GEN_TAC THEN FIRST_X_ASSUM MP_TAC  THEN ABBREV_TAC `M13 = #3.2 ` THEN \r
3673 PHA THEN REWRITE_TAC[sqrt8] THEN MP_TAC (SPECL [`M13:real`; `sqrt8`; `&2`;`sqrt8`\r
3674 ;`&2 `; `&2`;  `v1:real^3` ; `w1:real^3`; `v2:real^3`; `w2:real^3`] THADGSB) THEN \r
3675 SIMP_TAC[D3_SYM; sqrt8]);;\r
3676 \r
3677 let LEMMA37 = JGYWWBX;;\r
3678 \r
3679 \r
3680 let LEMMA_FOR_PAHFWSI = prove(`! v1 v2 v3 v4. CARD {v1, v2, v3, v4} = 4 /\\r
3681          packing {v1, v2, v3, v4} /\\r
3682          dist (v1,v3) <= #3.2 /\\r
3683          #2.51 <= dist (v1,v2) /\\r
3684          dist (v2,v4) <= #2.51\r
3685 ==>     (!x. x IN {#3.2, #2.51, &2, #2.51, &2, &2} ==> &0 <= x) /\\r
3686          #3.2 < #2.51 + &2 /\\r
3687          #3.2 < &2 + &2 /\\r
3688          #2.51 < #2.51 + &2 /\\r
3689          #2.51 < &2 + &2 /\\r
3690          &0 <\r
3691          delta (#3.2 pow 2) (#2.51 pow 2) (&2 pow 2) (#2.51 pow 2) (&2 pow 2)\r
3692          (&2 pow 2) /\\r
3693          CARD {v1, v2, v3, v4} = 4 /\\r
3694          #2.51 <= d3 v1 v2 /\\r
3695          &2 <= d3 v2 v3 /\\r
3696          &2 <= d3 v3 v4 /\\r
3697          &2 <= d3 v1 v4 /\\r
3698          d3 v1 v3 <= #3.2 /\\r
3699          d3 v2 v4 <= #2.51 `,\r
3700 REWRITE_TAC[SET_RULE ` (!x. x IN {a,b,c,d,e,f} ==> P x ) <=>\r
3701   P a /\ P b /\ P c /\ P d /\ P e /\ P f `; REAL_ARITH ` \r
3702   &0 <= #2.51 /\\r
3703           &0 <= &2 /\\r
3704           &0 <= &2 /\\r
3705           &0 <= #3.2 /\\r
3706           &0 <= &2 /\\r
3707           &0 <= #2.51 /\ #2.51 < &2 + #2.51 /\\r
3708          #2.51 < &2 + &2 /\\r
3709          #3.2 < &2 + &2 /\\r
3710          #3.2 < #2.51 + &2 /\ #3.2 < &2 + #2.51 /\\r
3711          #2.51 < #2.51 + &2  `] THEN SIMP_TAC[GSYM d3] THEN \r
3712 REWRITE_TAC[CARD4; packing; delta; d3] THEN CONV_TAC REAL_RAT_REDUCE_CONV\r
3713 THEN SET_TAC[]);;\r
3714 \r
3715 let PAHFWSI = prove(` !(v1:real^3) v2 v3 v4.\r
3716          CARD {v1, v2, v3, v4} = 4 /\\r
3717          packing {v1, v2, v3, v4} /\\r
3718          dist (v1,v3) <= #3.2 /\\r
3719          #2.51 <= dist (v1,v2) /\\r
3720          dist (v2,v4) <= #2.51\r
3721          ==> conv {v1, v3} INTER conv {v2, v4} = {} `, REPEAT GEN_TAC THEN \r
3722 MP_TAC (SPECL [` #3.2 `; `#2.51`;` &2 `; ` #2.51 `;` &2 `; `&2`] THADGSB) THEN \r
3723 NHANH (SPEC_ALL LEMMA_FOR_PAHFWSI ) THEN SIMP_TAC[]);;\r
3724 let LEMMA38 = PAHFWSI;;\r
3725 \r
3726 let LEMMA_OF_39 = prove(` ! (v1:real^3) v2 w1 w2.\r
3727          CARD {v1, v2, w1, w2} = 4 /\\r
3728          packing {v1, v2, w1, w2} /\\r
3729          dist (w1,w2) <= #2.51 /\\r
3730          dist (v1,v2) <= #3.07\r
3731 ==> (!x. x IN {#2.51, &2, &2, #3.07, &2, &2} ==> &0 <= x) /\\r
3732      #2.51 < &2 + &2 /\\r
3733      #2.51 < &2 + &2 /\\r
3734      #3.07 < &2 + &2 /\\r
3735      #3.07 < &2 + &2 /\\r
3736      &0 <\r
3737      delta (#2.51 pow 2) (&2 pow 2) (&2 pow 2) (#3.07 pow 2) (&2 pow 2)\r
3738      (&2 pow 2) /\\r
3739      CARD {w1, v1, w2, v2} = 4 /\\r
3740      &2 <= d3 w1 v1 /\\r
3741      &2 <= d3 v1 w2 /\\r
3742      &2 <= d3 w2 v2 /\\r
3743      &2 <= d3 w1 v2 /\\r
3744      d3 w1 w2 <= #2.51 /\\r
3745      d3 v1 v2 <= #3.07 `,\r
3746 REWRITE_TAC[SET_RULE ` (!x. x IN {a,b,c,d,e,f} ==> P x ) <=>\r
3747   P a /\ P b /\ P c /\ P d /\ P e /\ P f `; delta; GSYM d3] THEN CONV_TAC \r
3748 REAL_RAT_REDUCE_CONV THEN REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL \r
3749 [ASM_MESON_TAC[SET_RULE ` {v1, v2, w1, w2} = {w1, v1, w2, v2}`];DOWN_TAC]\r
3750  THEN REWRITE_TAC[CARD4; packing; d3] THEN SET_TAC[]);;\r
3751 \r
3752 \r
3753 let UVGVIXB = prove(` ! (v1:real^3) v2 w1 w2.\r
3754          CARD {v1, v2, w1, w2} = 4 /\\r
3755          packing {v1, v2, w1, w2} /\\r
3756          dist (w1,w2) <= #2.51 /\\r
3757          dist (v1,v2) <= #3.07\r
3758          ==> conv {w1, w2} INTER conv {v1, v2} = {}`, NHANH (SPEC_ALL LEMMA_OF_39)\r
3759  THEN SIMP_TAC[ SPECL [ ` #2.51 `; `&2 `; `&2 `; `#3.07 `; `&2 `; ` &2 `; \r
3760 ` w1:real^3 `; ` v1:real^3`;` w2:real^3`; `v2:real^3 `] THADGSB ]);;\r
3761 \r
3762 let LEMMA39 = UVGVIXB;;\r
3763 \r
3764 let LEMMA_OF_LEMMA40 = prove(`! v1 v2 w1 (w2:real^3).  CARD {v1, v2, w1, w2} = 4 /\\r
3765          packing {v1, v2, w1, w2} /\\r
3766          dist (v1,v2) <= #3.2 /\\r
3767          dist (w1,w2) <= #2.51 /\\r
3768          #2.2 <= dist (v1,w1)\r
3769 ==> (!x. x IN {#3.2, #2.2, &2, #2.51, &2, &2} ==> &0 <= x) /\\r
3770      #3.2 < #2.2 + &2 /\\r
3771      #3.2 < &2 + &2 /\\r
3772      #2.51 < #2.2 + &2 /\\r
3773      #2.51 < &2 + &2 /\\r
3774      &0 <\r
3775      delta (#3.2 pow 2) (#2.2 pow 2) (&2 pow 2) (#2.51 pow 2) (&2 pow 2)\r
3776      (&2 pow 2) /\\r
3777      CARD {v1, w1, v2, w2} = 4 /\\r
3778      #2.2 <= d3 v1 w1 /\\r
3779      &2 <= d3 w1 v2 /\\r
3780      &2 <= d3 v2 w2 /\\r
3781      &2 <= d3 v1 w2 /\\r
3782      d3 v1 v2 <= #3.2 /\\r
3783      d3 w1 w2 <= #2.51 `,\r
3784 REWRITE_TAC[SET_RULE ` (! x. x IN {a,b,c,d,e,f} ==> P x ) <=>\r
3785   P a /\ P b /\ P c /\ P d /\ P e /\ P f `; delta] THEN \r
3786 CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[SET_RULE ` \r
3787 {v1, v2, w1, w2} = {v1, w1, v2, w2} `; packing] THEN \r
3788 SIMP_TAC[CARD4; GSYM d3] THEN SET_TAC[]);;\r
3789 \r
3790 let PJFAYXI = prove(`! (v1:real^3) v2 w1 w2.\r
3791  CARD {v1, v2, w1, w2} = 4 /\  packing {v1, v2, w1, w2} /\\r
3792          dist (v1,v2) <= #3.2 /\\r
3793          dist (w1,w2) <= #2.51 /\\r
3794          #2.2 <= dist (v1,w1)\r
3795          ==> conv {v1, v2} INTER conv {w1, w2} = {}`,\r
3796 NHANH (SPEC_ALL LEMMA_OF_LEMMA40) THEN SIMP_TAC[ \r
3797 SPECL [ ` #3.2 `; `#2.2 `; `&2 `; `#2.51 `; `&2 `; ` &2 `;\r
3798  ` v1:real^3 `; ` w1:real^3`;` v2:real^3`; `w2:real^3 `] THADGSB ]);;\r
3799 \r
3800 let LEMMA40 = PJFAYXI;;\r
3801 \r
3802 \r
3803 \r
3804 let LEOF41 = prove(\r
3805 `#3.114467 < x ==> delta (#2.51 pow 2) (&2 pow 2) (&2 pow 2) (&2 pow 2)\r
3806  (&2 pow 2) (x pow 2) < &0`,\r
3807 NHANH (MESON[REAL_ARITH ` #3.114467 < x ==> &0 < #3.114467 /\ &0 < x `;\r
3808   LT_POW2_EQ_LT]` #3.114467 < x ==> ( #3.114467 ) pow 2 < x pow 2 `) THEN \r
3809 REWRITE_TAC[delta] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN \r
3810 REWRITE_TAC[ REAL_POLY_CONV ` -- &126002 / &625 - &4 * &4 * x pow 2 - &4 * &4 * x pow 2 +\r
3811      &63001 / &10000 *     x pow 2 *\r
3812      (-- &63001 / &10000 + &4 + &4 + &4 + &4 - x pow 2) +\r
3813      &4 * &4 * (&23001 / &10000 + &4 + &0 + x pow 2) +\r
3814      &4 * &4 * (&63001 / &10000 + -- &4 + &4 + x pow 2) `] THEN \r
3815 REWRITE_TAC[REAL_ARITH ` a pow 4 = a pow 2 pow 2 `] THEN \r
3816 REWRITE_TAC[REAL_ARITH ` a * x pow 2 + b * x = ( a * x + b ) * x `] THEN \r
3817 NHANH (REAL_ARITH `&9699904694089 / &1000000000000 < x pow 2\r
3818      ==> -- &63001 / &10000 * x pow 2 + &6111033999 / &100000000 < &0` ) THEN \r
3819 NHANH (REAL_ARITH `&9699904694089 / &1000000000000 < x ==> &0 < x `) THEN \r
3820 REWRITE_TAC[REAL_ARITH ` a < &0 <=> &0 < -- a `;\r
3821   REAL_ARITH ` -- ( a * b ) = -- a * b `] THEN MESON_TAC[REAL_LT_MUL]);;\r
3822 \r
3823 \r
3824 let LEMMA41 = prove(`! v1 v2 v3 (v4:real^3).\r
3825  CARD {v1,v2,v3,v4} = 4 /\ \r
3826  d3 v1 v2 = #2.51 /\\r
3827          d3 v1 v3 = &2 /\\r
3828          d3 v1 v4 = &2 /\\r
3829          d3 v2 v3 = &2 /\\r
3830          d3 v2 v4 = &2\r
3831          ==> d3 v3 v4 <= #3.114467 `,\r
3832 REPEAT GEN_TAC THEN MP_TAC LEMMA3 THEN LET_TR THEN \r
3833 REWRITE_TAC[REAL_ARITH ` x <= #3.114467 <=> ~ (#3.114467 < x ) `] THEN \r
3834 REWRITE_TAC[REAL_ARITH ` x <= #3.114467 <=> ~ (#3.114467 < x ) `;\r
3835    MESON[]` a ==> ~ b <=> a /\ b ==> F `] THEN PHA THEN \r
3836 NHANH (SPEC_ALL (prove(`! (v1:real^3) v2 v3 v4. d3 v1 v2 = #2.51 /\\r
3837 d3 v1 v3 = &2 /\ d3 v1 v4 = &2 /\ d3 v2 v3 = &2 /\ d3 v2 v4 = &2 /\ \r
3838 #3.114467 < d3 v3 v4 ==> delta (dist (v1,v2) pow 2) (dist (v1,v3) pow 2) \r
3839 (dist (v1,v4) pow 2) (dist (v2,v3) pow 2) (dist (v2,v4) pow 2)\r
3840  (dist (v3,v4) pow 2) < &0 `, SIMP_TAC[d3] THEN MESON_TAC[LEOF41]))) THEN \r
3841 REWRITE_TAC[REAL_ARITH ` a < &0 <=> ~( &0 <= a ) `; d3] THEN MESON_TAC[]);;\r
3842 \r
3843 let YXWIPMH = LEMMA41;;\r
3844 \r
3845 let LEMMA_OF_L42 = prove(`sqrt8 <= d3 v2 v4 /\ #3.488 <= x\r
3846  ==> -- &1 * x pow 2 * d3 v2 v4 pow 2 +\r
3847      -- &1 * x pow 4 +\r
3848      &103001 / &5000 * x pow 2 +\r
3849      -- &529046001 / &100000000 <\r
3850      &0`,\r
3851 MP_TAC SQRT8_LE THEN \r
3852 IMP_IMP_TAC THEN \r
3853 NHANH (MESON[REAL_ARITH ` &0 <= a /\ a <= b /\ #3.488 <= x ==> &0 <= b /\\r
3854   &0 <= #3.488 /\ &0 <= x `; POW2_COND]`\r
3855   &0 <= a /\ a <= b /\ #3.488 <= x ==> a pow 2 <= b pow 2 /\\r
3856   #3.488 pow 2 <= x pow 2 `) THEN \r
3857 REWRITE_TAC[SQRT8_POW2; sqrt8] THEN \r
3858 NHANH (MESON[REAL_ARITH ` &0 <= a /\ a <= b /\ #3.488 <= x ==> &0 <= b /\\r
3859   &0 <= #3.488 /\ &0 <= x `; POW2_COND]`\r
3860   &0 <= a /\ a <= b /\ #3.488 <= x ==> a pow 2 <= b pow 2 /\\r
3861   #3.488 pow 2 <= x pow 2 `) THEN \r
3862 REWRITE_TAC[SQRT8_POW2] THEN \r
3863 NHANH (MESON[REAL_ARITH ` &0 <= &8 /\ &0 <= #3.488 pow 2 `; REAL_LE_MUL2]` &8 <= a /\\r
3864  #3.488 pow 2 <= b ==> &8 * #3.488 pow 2 <= a * b `) THEN \r
3865 REWRITE_TAC[REAL_ARITH` a pow 4 = a pow 2 pow 2 `] THEN \r
3866 NHANH (MESON[REAL_ARITH ` #3.488 pow 2 <= x ==> &0 <= #3.488 pow 2 /\\r
3867   &0 <= x `; POW2_COND]` #3.488 pow 2 <= x ==> #3.488 pow 2 pow 2 <= x pow 2 `) THEN \r
3868 REWRITE_TAC[REAL_ARITH ` a + -- &1 * x pow 2 + b * x + c =\r
3869   a + -- &1 * ( x pow 2 + -- b * x + -- c ) `] THEN \r
3870 NHANH (prove(` #3.488 pow 2 <= x pow 2 ==>\r
3871   #3.488 pow 2 pow 2 +\r
3872       --(&103001 / &5000) * #3.488 pow 2 +\r
3873       --(-- &529046001 / &100000000) <= x pow 2 pow 2 +\r
3874       --(&103001 / &5000) * x pow 2 +\r
3875       --(-- &529046001 / &100000000) `,\r
3876 MP_TAC (REAL_ARITH ` -- (  --(&103001 / &5000))  / &2 <= #3.488 pow 2 `) THEN \r
3877 MESON_TAC[GREATER_THAN_MID_QUADRATIC_PO ])) THEN \r
3878 REAL_ARITH_TAC);;\r
3879 \r
3880 \r
3881 \r
3882 let LEMMA_IN_LEMMA42_P25 = prove(` ! v1 v2 v3 v4 x. \r
3883             d3 v1 v2 = #2.51 /\\r
3884             d3 v1 v4 = #2.51 /\\r
3885             d3 v2 v3 = &2 /\\r
3886             d3 v3 v4 = &2 /\\r
3887             sqrt8 <= d3 v2 v4 /\\r
3888             #3.488 <= x\r
3889 ==>   delta (d3 v1 v2 pow 2) ( x pow 2) (d3 v1 v4 pow 2)\r
3890       (d3 v2 v3 pow 2)\r
3891       (d3 v2 v4 pow 2)\r
3892       (d3 v3 v4 pow 2) < &0 `,\r
3893 SIMP_TAC[] THEN \r
3894 NHANH (MESON[REAL_ARITH` #3.488 <= x ==> &0 <= #3.488 /\ &0 <= x `; POW2_COND]`\r
3895   #3.488 <= x ==> (#3.488 pow 2 <= x pow 2 ) `) THEN \r
3896 REWRITE_TAC[delta] THEN \r
3897 CONV_TAC REAL_RAT_REDUCE_CONV THEN \r
3898 REWRITE_TAC[REAL_POLY_CONV `--(&63001 / &10000 * x pow 2 * &4) -\r
3899          &63001 / &10000 * &63001 / &10000 * d3 v2 v4 pow 2 -\r
3900          x pow 2 * &63001 / &2500 -\r
3901          &4 * d3 v2 v4 pow 2 * &4 +\r
3902          &63001 / &10000 *\r
3903          &4 *\r
3904          (-- &63001 / &10000 +\r
3905           x pow 2 +\r
3906           &63001 / &10000 +\r
3907           &4 +\r
3908           d3 v2 v4 pow 2 - &4) +\r
3909          x pow 2 *\r
3910          d3 v2 v4 pow 2 *\r
3911          (&63001 / &10000 - x pow 2 +\r
3912           &63001 / &10000 +\r
3913           &4 - d3 v2 v4 pow 2 +\r
3914           &4) +\r
3915          &63001 / &10000 *\r
3916          &4 *\r
3917          (&63001 / &10000 +\r
3918           x pow 2 - &63001 / &10000 - &4 +\r
3919           d3 v2 v4 pow 2 +\r
3920           &4) `] THEN \r
3921 REWRITE_TAC[REAL_IDEAL_CONV [` y pow 2 `] `-- &1 * x pow 4 * y pow 2 +\r
3922          -- &1 * x pow 2 * y pow 4 +\r
3923          &103001 / &5000 * x pow 2 * y pow 2 +\r
3924          -- &529046001 / &100000000 * y pow 2 `] THEN \r
3925 REWRITE_TAC[MESON[]` a/\ #3.488 <= x /\ c <=> (a/\ #3.488 <= x )/\ c`] THEN \r
3926 NHANH (LEMMA_OF_L42) THEN \r
3927 REWRITE_TAC[sqrt8] THEN \r
3928 NHANH (SQRT8_LE_EQ_8_LESS_POW2) THEN \r
3929 REPEAT GEN_TAC THEN \r
3930 STRIP_TAC THEN \r
3931 UNDISCH_TAC ` &8 <= d3 v2 v4 pow 2 ` THEN \r
3932 UNDISCH_TAC ` -- &1 * x pow 2 * d3 v2 v4 pow 2 +\r
3933       -- &1 * x pow 4 +\r
3934       &103001 / &5000 * x pow 2 +\r
3935       -- &529046001 / &100000000 <\r
3936       &0 ` THEN \r
3937 ABBREV_TAC ` xx = (-- &1 * x pow 2 * d3 v2 v4 pow 2 +\r
3938       -- &1 * x pow 4 +\r
3939       &103001 / &5000 * x pow 2 +\r
3940       -- &529046001 / &100000000)` THEN \r
3941 NHANH (REAL_ARITH ` &8 <= a ==> &0 < a `) THEN \r
3942 REWRITE_TAC[REAL_ARITH ` ( a * b < &0 <=> &0 < ( -- a ) * b )/\\r
3943   ( a < &0 <=> &0 < -- a )`] THEN \r
3944 SIMP_TAC[REAL_LT_MUL]);;\r
3945 \r
3946 let PAATDXJ =prove(` ! v1 v2 v3 (v4:real^3).\r
3947          CARD {v1,v2,v3,v4} = 4 /\ \r
3948          d3 v1 v2 = #2.51 /\\r
3949          d3 v1 v4 = #2.51 /\\r
3950          d3 v2 v3 = &2 /\\r
3951          d3 v3 v4 = &2 /\\r
3952          sqrt8 <= d3 v2 v4\r
3953          ==> d3 v1 v3 < #3.488 `,\r
3954 MP_TAC LEMMA3 THEN LET_TR THEN REWRITE_TAC[REAL_ARITH ` a < b <=> ~ ( b <= a )`]\r
3955 THEN REWRITE_TAC[MESON[]` a ==> ~ b <=> ~( a /\b)`] THEN \r
3956 PHA THEN NHANH (SPEC_ALL LEMMA_IN_LEMMA42_P25) THEN \r
3957 REWRITE_TAC[REAL_ARITH` a < b <=> ~(b <= a ) `] THEN SIMP_TAC[d3]);;\r
3958 \r
3959 \r
3960 (* the following lemma are in Multivariate/convex.ml *)\r
3961 \r
3962 \r
3963 let CONVEX_FINITE = new_axiom `!s:real^N->bool.\r
3964         FINITE s\r
3965         ==> (convex s <=>\r
3966                 !u. (!x. x IN s ==> &0 <= u x) /\\r
3967                     sum s u = &1\r
3968                     ==> vsum s (\x. u(x) % x) IN s)`;;\r
3969 \r
3970 let CONVEX_BALL = new_axiom `!x:real^N e. convex( normball x e) `;;\r
3971 \r
3972 let CONVEX_HULL_FINITE = new_axiom `\r
3973   !s. FINITE s\r
3974        ==> convex hull s =\r
3975                 {y:real^N | ?u. (!x. x IN s ==> &0 <= u x) /\\r
3976                                 sum s u = &1 /\\r
3977                                 vsum s (\x. u(x) % x) = y} `;;\r
3978 \r
3979 let CONVEX_HULL4 = \r
3980 MATCH_MP CONVEX_HULL_FINITE (MESON[ FINITE_RULES]` FINITE {(v1:real^N),v2,v3,v4} `);;\r
3981 \r
3982 \r
3983 \r
3984 let CONVEX_EXPLICIT = new_axiom `!s:real^N->bool.\r
3985         convex s <=>\r
3986         !t u. FINITE t /\ t SUBSET s /\ (!x. x IN t ==> &0 <= u x) /\\r
3987               sum t u = &1\r
3988               ==> vsum t (\x. u(x) % x) IN s`;;\r
3989 \r
3990 let CONVEX_HULL_FINITE_STEP = new_axiom\r
3991 `((?u. (!x. x IN {} ==> &0 <= u x) /\\r
3992          sum {} u = w /\\r
3993          vsum {} (\x. u(x) % x) = y) <=> w = &0 /\ y = vec 0) /\\r
3994    (FINITE(s:real^N->bool)\r
3995     ==> ((?u. (!x. x IN (a INSERT s) ==> &0 <= u x) /\\r
3996               sum (a INSERT s) u = w /\\r
3997               vsum (a INSERT s) (\x. u(x) % x) = y) <=>\r
3998          ?v. &0 <= v /\\r
3999              ?u. (!x. x IN s ==> &0 <= u x) /\\r
4000               sum s u = w - v /\\r
4001               vsum s (\x. u(x) % x) = y - v % a))`;;\r
4002 \r
4003 let CONVEX_HULL_4_EQUIV = prove(` ! v1 v2 v3 (v4:real^N).\r
4004   conv {v1,v2,v3,v4} = { x | ? a b c d. \r
4005   &0 <= a /\\r
4006           &0 <= b /\\r
4007           &0 <= c /\\r
4008           &0 <= d /\\r
4009           a + b + c + d = &1 /\\r
4010           a % v1 + b % v2 + c % v3 + d % v4 = x } `,\r
4011 REWRITE_TAC[conv; FUN_EQ_THM; affsign; lin_combo; UNION_EMPTY; \r
4012  IN_ELIM_THM; sgn_ge] THEN \r
4013 REWRITE_TAC[MESON[]` x = vsum aa bb /\ a /\ b <=>\r
4014   a /\ b /\ vsum aa bb = x `] THEN \r
4015 ONCE_REWRITE_TAC[SET_RULE ` a s ==> b <=> s IN a ==> b `] THEN \r
4016  SIMP_TAC[CONVEX_HULL_FINITE_STEP; FINITE_INSERT; FINITE_RULES] THEN\r
4017  REWRITE_TAC[REAL_ARITH `x - y = z:real <=> x = y + z`;\r
4018              VECTOR_ARITH `x - y = z:real^N <=> x = y + z`] THEN\r
4019  REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID] THEN MESON_TAC[IN]);;\r
4020 \r
4021 \r
4022 let TXDIACY = prove(`! (a:real^3) b c d (v0: real^3) r.\r
4023  {a, b, c, d} SUBSET normball v0 r\r
4024          ==> convex hull {a, b, c, d} SUBSET normball v0 r `,\r
4025 REPEAT GEN_TAC THEN MP_TAC (MESON[CONVEX_BALL]` convex (normball (v0:real^3) r)`) THEN \r
4026 NHANH (MESON[FINITE6] ` {a, b, c, d} SUBSET s ==> FINITE {(a:real^3),b,c,d} `) THEN \r
4027 REWRITE_TAC[CONVEX_HULL4; CONVEX_EXPLICIT] THEN \r
4028 IMP_IMP_TAC THEN \r
4029 REWRITE_TAC[SET_RULE ` {a | P a } SUBSET b <=> (! a. P a ==> a IN b)`] THEN \r
4030 REWRITE_TAC[MESON[]` (! y. ( ? u. P u y ) ==> Q y ) <=>\r
4031   (! y u. P u y ==> Q y ) `] THEN \r
4032 REWRITE_TAC[MESON[]`(!y u. P u /\ Q u /\ R u = y ==> Z y) <=> \r
4033   (!u. P u /\ Q u ==> Z (R u)) `] THEN MESON_TAC[]);;\r
4034 let LEMMA14 = TXDIACY;;\r
4035 \r
4036 \r
4037 let ECSEVNC = prove(`?t1 t2 t3 t4.\r
4038      !v1 v2 v3 v4 (v: real^3).\r
4039          ~coplanar {v1, v2, v3, v4}\r
4040          ==> t1 v1 v2 v3 v4 v +\r
4041              t2 v1 v2 v3 v4 v +\r
4042              t3 v1 v2 v3 v4 v +\r
4043              t4 v1 v2 v3 v4 v =\r
4044              &1 /\\r
4045              v =\r
4046              t1 v1 v2 v3 v4 v % v1 +\r
4047              t2 v1 v2 v3 v4 v % v2 +\r
4048              t3 v1 v2 v3 v4 v % v3 +\r
4049              t4 v1 v2 v3 v4 v % v4 /\\r
4050              (!ta tb tc td.\r
4051                   v = ta % v1 + tb % v2 + tc % v3 + td % v4 /\\r
4052                   ta + tb + tc + td = &1\r
4053                   ==> ta = t1 v1 v2 v3 v4 v /\\r
4054                       tb = t2 v1 v2 v3 v4 v /\\r
4055                       tc = t3 v1 v2 v3 v4 v /\\r
4056                       td = t4 v1 v2 v3 v4 v) `,\r
4057 REWRITE_TAC[GSYM SKOLEM_THM; RIGHT_EXISTS_IMP_THM] THEN REPEAT \r
4058 GEN_TAC THEN NHANH (SPEC_ALL (prove(`!v1 v2 v3 v0 v:real^3.\r
4059     ~coplanar {v0, v1, v2, v3} ==> (?t1 t2 t3. v - v0 = t1 % (v1 - v0)\r
4060  + t2 % (v2 - v0) + t3 % (v3 - v0) /\ (!ta tb tc. v - v0 = ta % (v1 - v0)\r
4061  + tb % (v2 - v0) + tc % (v3 - v0)   ==> ta = t1 /\\r
4062  tb = t2 /\ tc = t3))`, SIMP_TAC[NONCOPLANAR_3_BASIS]))) THEN \r
4063 STRIP_TAC THEN EXISTS_TAC ` &1 - t1 - t2 - t3 ` THEN \r
4064 EXISTS_TAC ` t1:real ` THEN EXISTS_TAC ` t2:real ` THEN \r
4065 EXISTS_TAC ` t3:real ` THEN CONJ_TAC THENL [REAL_ARITH_TAC;\r
4066  CONJ_TAC] THENL [UNDISCH_TAC ` (v:real^3) - v1 = t1 % (v2 - v1) + \r
4067 t2 % (v3 - v1) + t3 % (v4 - v1)` THEN \r
4068 CONV_TAC VECTOR_ARITH; REPEAT GEN_TAC] THEN \r
4069 REWRITE_TAC[MESON[]` a /\ b ==> c <=> b ==> a ==> c `;\r
4070   REAL_ARITH ` ta + tb + tc + td = &1 <=> ta = &1 - tb - tc - td `] THEN \r
4071 SIMP_TAC[] THEN REWRITE_TAC[VECTOR_ARITH `   v = (&1 - tb - tc - td) % v1\r
4072  + tb % v2 + tc % v3 + td % v4 <=>  v - v1 = tb % ( v2 - v1 ) + \r
4073 tc % ( v3 - v1 ) + td % ( v4 - v1 ) `] THEN ASM_MESON_TAC[]);;\r
4074 \r
4075 let LEMMA76 = ECSEVNC;;\r
4076 \r
4077 let COEFS_4 = new_specification ["COEF4_1"; "COEF4_2"; "COEF4_3"; "COEF4_4"] ECSEVNC ;;\r
4078 \r
4079 \r
4080 \r
4081 \r
4082 \r
4083 let COEF_1_EQ_ZERO = prove(` ! v1 v2 v3 v4 (v:real^3).\r
4084   ~ coplanar {v1,v2,v3,v4} ==>\r
4085   ( COEF4_1 v1 v2 v3 v4 v = &0 <=> v IN aff {v2,v3,v4} ) `,\r
4086 REWRITE_TAC[aff; AFFINE_HULL_3; IN_ELIM_THM] THEN \r
4087 NHANH (SPEC_ALL COEFS_4) THEN \r
4088 REPEAT GEN_TAC THEN STRIP_TAC THEN \r
4089 ONCE_REWRITE_TAC[REAL_ARITH` u + v + w = &0 + u + v + w `] THEN \r
4090 ONCE_REWRITE_TAC[VECTOR_ARITH` u + v + w = &0 % v1 + u + v + w `] THEN \r
4091 ASM_MESON_TAC[]);;\r
4092 \r
4093 \r
4094 let EQ_IMP_COPLANAR = prove(`! a b c (d:real^3). ( a = b \/ a = c \/ a = d )\r
4095  ==> coplanar {a,b,c,d} `,\r
4096 REPEAT STRIP_TAC THENL [\r
4097 ASM_SIMP_TAC[SET_RULE ` a INSERT ( a INSERT s ) = a INSERT s `] THEN \r
4098 MP_TAC (DIMINDEX_3) THEN MESON_TAC[COPLANAR_3;  ARITH_RULE` a = 3 ==> 2 <= a `];\r
4099 ONCE_REWRITE_TAC[SET_RULE` {a,b,v,c} = {a,v,b,c} `] THEN \r
4100 ASM_SIMP_TAC[SET_RULE ` a INSERT ( a INSERT s ) = a INSERT s `] THEN \r
4101 MP_TAC (DIMINDEX_3) THEN MESON_TAC[COPLANAR_3;  ARITH_RULE` a = 3 ==> 2 <= a `];\r
4102 ONCE_REWRITE_TAC[SET_RULE` {a,b,v,c} = {a,c,v,b} `] THEN \r
4103 ASM_SIMP_TAC[SET_RULE ` a INSERT ( a INSERT s ) = a INSERT s `] THEN \r
4104 MP_TAC (DIMINDEX_3) THEN MESON_TAC[COPLANAR_3;  ARITH_RULE` a = 3 ==> 2 <= a `]]);;\r
4105 \r
4106 \r
4107 \r
4108 \r
4109 \r
4110 let AFFINE_HULL_FINITE_STEP_GEN = prove\r
4111  (`!P:real^N->real->bool.\r
4112        ((?u. (!x. x IN {} ==> P x (u x)) /\\r
4113              sum {} u = w /\ vsum {} (\x. u(x) % x) = y) <=>\r
4114         w = &0 /\ y = vec 0) /\\r
4115        (FINITE(s:real^N->bool) /\\r
4116         (!y. a IN s /\ P a y ==> P a (y / &2)) /\\r
4117         (!x y. a IN s /\ P a x /\ P a y ==> P a (x + y))\r
4118         ==> ((?u. (!x. x IN (a INSERT s) ==> P x (u x)) /\\r
4119                   sum (a INSERT s) u = w /\\r
4120                   vsum (a INSERT s) (\x. u(x) % x) = y) <=>\r
4121              ?v u. P a v /\ (!x. x IN s ==> P x (u x)) /\\r
4122                    sum s u = w - v /\\r
4123                    vsum s (\x. u(x) % x) = y - v % a))`,\r
4124  GEN_TAC THEN SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; NOT_IN_EMPTY] THEN\r
4125  CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN\r
4126  ASM_CASES_TAC `(a:real^N) IN s` THEN ASM_REWRITE_TAC[] THENL\r
4127   [ASM_SIMP_TAC[SET_RULE `a IN s ==> a INSERT s = s`] THEN EQ_TAC THEN\r
4128    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL\r
4129     [X_GEN_TAC `u:real^N->real` THEN STRIP_TAC THEN\r
4130      EXISTS_TAC `(u:real^N->real) a / &2` THEN\r
4131      EXISTS_TAC `\x:real^N. if x = a then u x / &2 else u x`;\r
4132      MAP_EVERY X_GEN_TAC [`v:real`; `u:real^N->real`] THEN\r
4133      STRIP_TAC THEN\r
4134      EXISTS_TAC `\x:real^N. if x = a then u x + v else u x`] THEN\r
4135    ASM_SIMP_TAC[] THEN (CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN\r
4136    ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN\r
4137    ASM_SIMP_TAC[VSUM_CASES; SUM_CASES] THEN\r
4138    ASM_SIMP_TAC[GSYM DELETE; SUM_DELETE; VSUM_DELETE] THEN\r
4139    ASM_SIMP_TAC[SET_RULE `a IN s ==> {x | x IN s /\ x = a} = {a}`] THEN\r
4140    REWRITE_TAC[SUM_SING; VSUM_SING] THEN\r
4141    (CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]);\r
4142    EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL\r
4143     [X_GEN_TAC `u:real^N->real` THEN STRIP_TAC THEN\r
4144      EXISTS_TAC `(u:real^N->real) a` THEN\r
4145      EXISTS_TAC `u:real^N->real` THEN ASM_SIMP_TAC[IN_INSERT] THEN\r
4146      REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM)) THEN\r
4147      CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC];\r
4148      MAP_EVERY X_GEN_TAC [`v:real`; `u:real^N->real`] THEN\r
4149      STRIP_TAC THEN\r
4150      EXISTS_TAC `\x:real^N. if x = a then v:real else u x` THEN\r
4151      ASM_SIMP_TAC[IN_INSERT] THEN CONJ_TAC THENL\r
4152       [ASM_MESON_TAC[]; ALL_TAC] THEN\r
4153      ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN\r
4154      ASM_SIMP_TAC[VSUM_CASES; SUM_CASES] THEN\r
4155      ASM_SIMP_TAC[GSYM DELETE; SUM_DELETE; VSUM_DELETE] THEN\r
4156      ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> {x | x IN s /\ x = a} = {}`] THEN\r
4157      ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> s DELETE a = s`] THEN\r
4158      REWRITE_TAC[SUM_CLAUSES; VSUM_CLAUSES] THEN\r
4159      CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]]]);;\r
4160 \r
4161 \r
4162 \r
4163 let THEOREM_RE_AFF_LT31 = prove\r
4164  (`!v1 v2 v3 vv x:real^N.\r
4165        ~(v1 = vv) /\ ~(v2 = vv) /\ ~(v3 = vv)\r
4166        ==> ((?f. f vv < &0 /\\r
4167                  sum {v1, v2, v3, vv} f = &1 /\\r
4168                  x = vsum {v1, v2, v3, vv} (\v. f v % v)) <=>\r
4169             {x | ?a b c t.\r
4170                      a + b + c + t = &1 /\\r
4171                      x = a % v1 + b % v2 + c % v3 + t % vv /\\r
4172                      t < &0}\r
4173             x)`,\r
4174  REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN\r
4175  EXISTS_TAC\r
4176   `?f. (!x:real^N. x IN {v1, v2, v3, vv} ==> vv = x ==> f x < &0) /\\r
4177        sum {v1, v2, v3, vv} f = &1 /\\r
4178        vsum {v1, v2, v3, vv} (\v. f v % v) = x` THEN\r
4179  CONJ_TAC THENL\r
4180   [ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[];\r
4181    SIMP_TAC[AFFINE_HULL_FINITE_STEP_GEN;\r
4182             REAL_ARITH `x < &0 /\ y < &0 ==> x + y < &0`;\r
4183             REAL_ARITH `x < &0 ==> x / &2 < &0`;\r
4184             FINITE_INSERT; CONJUNCT1 FINITE_RULES; RIGHT_EXISTS_AND_THM] THEN\r
4185    ASM_REWRITE_TAC[IN_ELIM_THM;\r
4186                    REAL_ARITH `x - y:real = z <=> x = y + z`;\r
4187                    VECTOR_ARITH `x - y:real^N = z <=> x = y + z`] THEN\r
4188    REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID] THEN MESON_TAC[]]);;\r
4189 \r
4190 let AFF_LT31 = prove(` ! v1 v2 v3 (vv: real^N). ~ (vv IN {v1,v2,v3} ) ==>\r
4191 aff_lt {v1,v2,v3} {vv} = \r
4192    { x| ? a b c t. t < &0 /\ a + b + c + t = &1 /\\r
4193            x = a % v1 + b % v2 + c % v3 + t % vv } `,\r
4194 REWRITE_TAC[IN_SET3; DE_MORGAN_THM; aff_lt_def;FUN_EQ_THM; \r
4195  affsign; lin_combo; sgn_lt] THEN \r
4196 REWRITE_TAC[SET_RULE` {v1, v2, v3} UNION {vv} = {v1, v2, v3, vv}`] THEN \r
4197 REWRITE_TAC[SET_RULE` a /\ (!w. {vv} w ==> f w < &0) /\ b\r
4198   <=> f vv < &0 /\ b /\ a `] THEN \r
4199 SIMP_TAC[THEOREM_RE_AFF_LT31; IN_ELIM_THM] THEN SET_TAC[]);;\r
4200 \r
4201 let AFF_LT21 = prove(`! a b (v0:real^N). ~ ( a = v0 ) /\ ~( b = v0 ) ==>\r
4202 aff_lt {a,b} {v0} =\r
4203           {x | ? ta tb t.\r
4204                    ta + tb + t = &1 /\\r
4205                    t < &0 /\\r
4206                    x = ta % a + tb % b + t % v0} `,\r
4207 REWRITE_TAC[SET_RULE` ~(a = v0) /\ ~(b = v0) <=>\r
4208   ~ ( v0 IN {a,b} ) `] THEN \r
4209 ONCE_REWRITE_TAC[SET_RULE` {a,b} = {a,b,b} `] THEN SIMP_TAC[AFF_LT31] THEN \r
4210 SIMP_TAC[AFF_LT31; FUN_EQ_THM; IN_ELIM_THM] THEN \r
4211 REWRITE_TAC[VECTOR_ARITH` a % b + c % b + x = ( a + c ) % b + x `] THEN \r
4212 MESON_TAC[REAL_ARITH` a + b + c = ( a + b ) + c `;\r
4213 VECTOR_ARITH ` a % v = ( a + &0 ) % v `; REAL_ARITH `\r
4214    a + b = a + &0 + b `]);;\r
4215 \r
4216 \r
4217 let INSET3 = SET_RULE` a IN {a,b,c} /\ b IN {a,b,c} /\ c IN {a,b,c} `;;\r
4218 \r
4219 \r
4220 \r
4221 \r
4222 \r
4223 \r
4224 let AFF_GT33 = prove(`! (v1:real^N) v2 v3 w1 w2 w3.\r
4225      {v1, v2, v3} INTER {w1, w2, w3} = {}\r
4226      ==> aff_gt {v1, v2, v3} {w1, w2, w3} =\r
4227          {x | ?a1 a2 a3 b1 b2 b3.\r
4228                   &0 < b1 /\\r
4229                   &0 < b2 /\\r
4230                   &0 < b3 /\\r
4231                   a1 + a2 + a3 + b1 + b2 + b3 = &1 /\\r
4232                   x =\r
4233                   a1 % v1 + a2 % v2 + a3 % v3 + b1 % w1 + b2 % w2 + b3 % w3}`,\r
4234 REWRITE_TAC[aff_gt_def; FUN_EQ_THM; affsign; lin_combo; sgn_gt] THEN \r
4235 REPEAT STRIP_TAC THEN \r
4236 MATCH_MP_TAC EQ_TRANS  THEN \r
4237 REWRITE_TAC[SET_RULE ` ( a INSERT b ) UNION c =\r
4238    b UNION ( a INSERT c ) /\ {} UNION b = b `] THEN \r
4239 EXISTS_TAC ` (? f. x = vsum {v3, v2, v1, w1, w2, w3} (\v. f v % v) /\\r
4240            (!(w:real^N). w IN {v3,v2,v1, w1, w2, w3} ==> w IN {w1,w2,w3} ==>  &0 < f w) /\\r
4241            sum {v3, v2, v1, w1, w2, w3} f = &1 ) ` THEN \r
4242 REWRITE_TAC[SET_RULE` (!x. ({v1, v2, v3} INTER {w1, w2, w3}) x <=> {} x)\r
4243   <=> {v1, v2, v3} INTER {w1, w2, w3} = {} `] THEN \r
4244 CONJ_TAC THENL [ \r
4245 FIRST_X_ASSUM MP_TAC THEN \r
4246 REWRITE_TAC[SET_RULE` (!x. ({v1, v2, v3} INTER {w1, w2, w3}) x <=> {} x)\r
4247   <=> {v1, v2, v3} INTER {w1, w2, w3} = {} `] THEN \r
4248 MESON_TAC[SET_RULE` {v1, v2, v3} INTER {w1, w2, w3} = {} ==>\r
4249   ( (!w. {w1, w2, w3} w ==> &0 < f w) <=>\r
4250   (!w. w IN {v3, v2, v1, w1, w2, w3}\r
4251                 ==> w IN {w1, w2, w3}\r
4252                 ==> &0 < f w) ) `];\r
4253 REWRITE_TAC[MESON[]` a /\ (!z. P z ) /\ aa = &1 <=>\r
4254   (!z. P z ) /\ aa = &1 /\ a `]] THEN \r
4255 ONCE_REWRITE_TAC[MESON[]` a = vsum b c <=> vsum b c = a `] THEN \r
4256  SIMP_TAC[AFFINE_HULL_FINITE_STEP_GEN;FINITE_INSERT; CONJUNCT1 FINITE_RULES;\r
4257             RIGHT_EXISTS_AND_THM;\r
4258             REAL_ARITH `&0 < x /\ &0 < y ==> &0 < x + y`;\r
4259             REAL_ARITH `&0 < x  ==> &0 < x / &2 `] THEN \r
4260 FIRST_X_ASSUM MP_TAC THEN \r
4261 REWRITE_TAC[SET_RULE` (!x. ({v1, v2, v3} INTER {w1, w2, w3}) x <=> {} x)\r
4262   <=> {v1, v2, v3} INTER {w1, w2, w3} = {} `; SET_RULE` ( a INSERT s ) INTER ss = {} <=>\r
4263 ~ ( a IN ss ) /\ s INTER ss = {} `] THEN \r
4264 SIMP_TAC[INSET3] THEN \r
4265 SIMP_TAC[INSET3; REAL_ARITH` a - b = c <=> a = b + c `;\r
4266   VECTOR_ARITH` a:real^N - b = c <=> a = b + c `] THEN \r
4267 REWRITE_TAC[ GSYM  RIGHT_EXISTS_AND_THM; ZERO_NEUTRAL; \r
4268  IN_ELIM_THM; VECTOR_ARITH ` a + vec 0 = a `] THEN \r
4269 DISCH_TAC THEN \r
4270 MESON_TAC[REAL_ARITH` a + b + c + d = c + b + a + d `;\r
4271   VECTOR_ARITH` ( a:real^N ) + b + c + d = c + b + a + d `]);;\r
4272 \r
4273 \r
4274 g `! (v1:real^N) v2 v3 w1 w2 w3.\r
4275      {v1, v2, v3} INTER {w1, w2, w3} = {}\r
4276      ==> aff_ge {v1, v2, v3} {w1, w2, w3} =\r
4277          {x | ?a1 a2 a3 b1 b2 b3.\r
4278                   &0 <= b1 /\\r
4279                   &0 <= b2 /\\r
4280                   &0 <= b3 /\\r
4281                   a1 + a2 + a3 + b1 + b2 + b3 = &1 /\\r
4282                   x =\r
4283                   a1 % v1 + a2 % v2 + a3 % v3 + b1 % w1 + b2 % w2 + b3 % w3}`;;\r
4284 e (REWRITE_TAC[aff_gt_def; aff_ge_def; FUN_EQ_THM; affsign; lin_combo; sgn_gt; sgn_ge]);;\r
4285 e (REPEAT STRIP_TAC);;\r
4286 e (MATCH_MP_TAC EQ_TRANS );;\r
4287 e (REWRITE_TAC[SET_RULE ` ( a INSERT b ) UNION c =\r
4288    b UNION ( a INSERT c ) /\ {} UNION b = b `]);;\r
4289 e (EXISTS_TAC ` (? f. x = vsum {v3, v2, v1, w1, w2, w3} (\v. f v % v) /\\r
4290            (!(w:real^N). w IN {v3,v2,v1, w1, w2, w3} ==> w IN {w1,w2,w3} ==>  &0 <= f w) /\\r
4291            sum {v3, v2, v1, w1, w2, w3} f = &1 ) `);;\r
4292 e (CONJ_TAC);;\r
4293 e (FIRST_X_ASSUM MP_TAC);;\r
4294 e (REWRITE_TAC[SET_RULE` (!x. ({v1, v2, v3} INTER {w1, w2, w3}) x <=> {} x)\r
4295   <=> {v1, v2, v3} INTER {w1, w2, w3} = {} `]);;\r
4296 e (MESON_TAC[SET_RULE` {v1, v2, v3} INTER {w1, w2, w3} = {} ==>\r
4297   ( (!w. {w1, w2, w3} w ==> &0 <= f w) <=>\r
4298   (!w. w IN {v3, v2, v1, w1, w2, w3}\r
4299                 ==> w IN {w1, w2, w3}\r
4300                 ==> &0 <= f w) ) `]);;\r
4301 e (REWRITE_TAC[MESON[]` a /\ (!z. P z ) /\ aa = &1 <=>\r
4302   (!z. P z ) /\ aa = &1 /\ a `]);;\r
4303 e (ONCE_REWRITE_TAC[MESON[]` a = vsum b c <=> vsum b c = a `]);;\r
4304 e ( SIMP_TAC[AFFINE_HULL_FINITE_STEP_GEN;FINITE_INSERT; CONJUNCT1 FINITE_RULES;\r
4305             RIGHT_EXISTS_AND_THM;\r
4306             REAL_ARITH `&0 <= x /\ &0 <= y ==> &0 <= x + y`;\r
4307             REAL_ARITH `&0 <= x  ==> &0 <= x / &2 `]);;\r
4308 e (FIRST_X_ASSUM MP_TAC);;\r
4309 e (REWRITE_TAC[SET_RULE` (!x. ({v1, v2, v3} INTER {w1, w2, w3}) x <=> {} x)\r
4310   <=> {v1, v2, v3} INTER {w1, w2, w3} = {} `; SET_RULE` ( a INSERT s ) INTER ss = {} <=>\r
4311 ~ ( a IN ss ) /\ s INTER ss = {} `]);;\r
4312 e (SIMP_TAC[INSET3]);;\r
4313 e (SIMP_TAC[INSET3; REAL_ARITH` a - b = c <=> a = b + c `;\r
4314   VECTOR_ARITH` a:real^N - b = c <=> a = b + c `]);;\r
4315 e (REWRITE_TAC[ GSYM  RIGHT_EXISTS_AND_THM; ZERO_NEUTRAL; \r
4316  IN_ELIM_THM; VECTOR_ARITH ` a + vec 0 = a `]);;\r
4317 e (DISCH_TAC);;\r
4318 e (MESON_TAC[REAL_ARITH` a + b + c + d = c + b + a + d `;\r
4319   VECTOR_ARITH` ( a:real^N ) + b + c + d = c + b + a + d `]);;\r
4320 let AFF_GE33 = top_thm();;\r
4321 \r
4322 \r
4323 let AFF_GE_12 = prove(`!v0 (a:real^N) b.\r
4324      ~(v0 = a \/ v0 = b)\r
4325      ==> aff_ge {v0} {a, b} =\r
4326          {x | ?tv ta tb.\r
4327                   &0 <= ta /\\r
4328                   &0 <= tb /\\r
4329                   tv + ta + tb = &1 /\\r
4330                   x = tv % v0 + ta % a + tb % b}`,\r
4331 REWRITE_TAC[SET_RULE ` ~(v0 = a \/ v0 = b) <=> {v0} INTER {a,b} = {} `] THEN \r
4332 ONCE_REWRITE_TAC[SET_RULE` {a} = {a,a} `] THEN \r
4333 ONCE_REWRITE_TAC[SET_RULE` {a,a} = {a,a,a} `] THEN \r
4334 ONCE_REWRITE_TAC[SET_RULE` {a,b,b,b} = {a,b,b} `] THEN \r
4335 SIMP_TAC[AFF_GE33] THEN REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM] THEN \r
4336 REPEAT STRIP_TAC THEN \r
4337 REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; VECTOR_ARITH` a % v + \r
4338   b % v + y = ( a + b ) % v + y `] THEN GONTONG THEN EQ_TAC THENL [\r
4339 MESON_TAC[REAL_ARITH` a1 + a2 + a3 + b1 + b2 + b3 =\r
4340   ( a1 + a2 + a3 ) + b1 + b2 + b3 `; REAL_ARITH ` &0 <= a \r
4341 /\ &0 <= b ==> &0 <= a + b `];STRIP_TAC] THEN EXISTS_TAC` tv: real ` \r
4342 THEN EXISTS_TAC` &0 ` THEN EXISTS_TAC` &0` THEN EXISTS_TAC` ta :real `\r
4343  THEN EXISTS_TAC` &0` THEN EXISTS_TAC` tb:real ` THEN \r
4344 ASM_SIMP_TAC[REAL_ARITH ` a <= a `; ZERO_NEUTRAL]);;\r
4345 \r
4346 \r
4347 let INSET3 = SET_RULE` a IN {a, b, c} /\ b IN {a, b, c} /\ c IN {a, b, c}\r
4348  /\ {a, b, c} a /\ {a, b, c} b /\ {a, b, c} c `;;\r
4349 \r
4350 \r
4351 \r
4352 let AFF_LE_LT33 = prove(`! (v1:real^N) v2 v3 w1 w2 w3.\r
4353      {v1, v2, v3} INTER {w1, w2, w3} = {}\r
4354      ==> aff_le {v1, v2, v3} {w1, w2, w3} =\r
4355          {x | ?a1 a2 a3 b1 b2 b3.\r
4356                   b1 <= &0 /\\r
4357                   b2 <= &0  /\\r
4358                   b3 <= &0  /\\r
4359                   a1 + a2 + a3 + b1 + b2 + b3 = &1 /\\r
4360                   x =\r
4361                   a1 % v1 + a2 % v2 + a3 % v3 + b1 % w1 + b2 % w2 + b3 % w3} /\\r
4362    aff_lt {v1, v2, v3} {w1, w2, w3} =\r
4363          {x | ?a1 a2 a3 b1 b2 b3.\r
4364                   b1 < &0 /\\r
4365                   b2 < &0  /\\r
4366                   b3 < &0  /\\r
4367                   a1 + a2 + a3 + b1 + b2 + b3 = &1 /\\r
4368                   x =\r
4369                   a1 % v1 + a2 % v2 + a3 % v3 + b1 % w1 + b2 % w2 + b3 % w3} `,\r
4370 REWRITE_TAC[IN_ELIM_THM; aff_le_def; FUN_EQ_THM; aff_lt_def; \r
4371  affsign; lin_combo; sgn_lt; sgn_le] THEN \r
4372 REWRITE_TAC[SET_RULE` {v1, v2, v3} UNION {w1, w2, w3} = \r
4373   {v1,v2,v3,w1,w2,w3} `] THEN \r
4374 ONCE_REWRITE_TAC[SET_RULE` {w1, w2, w3} w ==> P w <=>\r
4375   w IN {v1,v2,v3,w1,w2,w3} ==> {w1,w2,w3} w ==> P w `] THEN \r
4376 REWRITE_TAC[MESON[]` a = vsum aa bb /\\r
4377   (! w. P w ) /\ b <=> (! w. P w ) /\ b /\ vsum aa bb = a `] THEN \r
4378  SIMP_TAC[AFFINE_HULL_FINITE_STEP_GEN;\r
4379             REAL_ARITH `( x < &0 /\ y < &0 ==> x + y < &0) /\ ( x <= &0 /\ y <= &0 ==> x + y <= &0)`;\r
4380             REAL_ARITH ` (x < &0 ==> x / &2 < &0 ) /\ (x <= &0 ==> x / &2 <= &0 )`;\r
4381             FINITE_INSERT; CONJUNCT1 FINITE_RULES\r
4382 ; RIGHT_EXISTS_AND_THM]  THEN \r
4383 SIMP_TAC[ GSYM RIGHT_EXISTS_AND_THM; SET_RULE ` \r
4384   (!x. ({v1, v2, v3} INTER s ) x <=> {} x) <=>\r
4385   ~ ( s v1 ) /\ ~ ( s v2 ) /\ ~ ( s v3 ) `; INSET3] THEN \r
4386 REWRITE_TAC[REAL_ARITH` a - b = c <=> a = b + c`; REAL_ARITH `\r
4387   a + &0 = a `; VECTOR_ARITH` (a:real^N) - b = c <=> a = b + c`;\r
4388   VECTOR_ARITH` a + vec 0 = a `] THEN \r
4389 MESON_TAC[]);;\r
4390 \r
4391 \r
4392 \r
4393 \r
4394 let AFF_GES_LTS = prove(` ! a b c (v0 :real^N). \r
4395  ~ ( a = v0 ) /\ ~( b = v0 ) /\ ~( c = v0 ) ==>\r
4396 aff_gt {a, b} {v0} =\r
4397           {x | ?ta tb t.\r
4398                    ta + tb + t = &1 /\ &0 < t /\ x = ta % a + tb % b + t % v0} /\\r
4399 aff_ge {a, b} {v0} =\r
4400           {x | ?ta tb t.\r
4401                    ta + tb + t = &1 /\\r
4402                    &0 <= t /\\r
4403                    x = ta % a + tb % b + t % v0} /\\r
4404 aff_lt {a,b,c} {v0} = \r
4405    { x| ? ta tb tc t. t < &0 /\ ta + tb + tc + t = &1 /\\r
4406            x = ta % a + tb % b + tc % c + t % v0 }  /\\r
4407 aff_gt {a,b,c} {v0} =  \r
4408    { x| ? ta tb tc t. &0 < t /\ ta + tb + tc + t = &1 /\\r
4409      x = ta % a + tb % b + tc % c + t % v0 } `, \r
4410 ONCE_REWRITE_TAC[SET_RULE` {a} = {a,a,a} `] THEN \r
4411 ONCE_REWRITE_TAC[SET_RULE` {a,b,b,b} = {a,b,b} `] THEN \r
4412 ONCE_REWRITE_TAC[SET_RULE` {a,b,c,c} = {a,b,c} `] THEN \r
4413 NHANH (SET_RULE` ~(a = v0) /\ ~(b = v0) /\ ~(c = v0) ==>\r
4414   {a,b,b} INTER {v0,v0,v0} = {} /\ {a,b,c} INTER {v0,v0,v0} = {} `) THEN \r
4415 SIMP_TAC[AFF_LE_LT33; AFF_GE33; AFF_GT33] THEN \r
4416 REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; VECTOR_ARITH` a % x + b % x + y\r
4417   = ( a + b ) % x + y `] THEN \r
4418 REWRITE_TAC[REAL_ARITH` (a + b ) + c = a + b + c `] THEN \r
4419 REPEAT STRIP_TAC THENL [\r
4420 REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM] THEN GEN_TAC THEN \r
4421 EQ_TAC THENL [MESON_TAC[REAL_ARITH ` &0 < a /\ &0 < b ==> &0 < a + b `;\r
4422   REAL_ARITH ` a + b + c + d = a + ( b + c ) + d `]; \r
4423 MESON_TAC[REAL_ARITH ` a + b + c = a + b / &2 + b / &2 + c / &3 +\r
4424   c / &3 + c / &3 `; REAL_ARITH` &0 < a <=> &0 < a / &3 `;\r
4425   REAL_ARITH` a = a / &2 + a / &2 /\ b = b / &3 + b / &3 + b / &3 /\ b =\r
4426  ( b / &3 + b / &3 ) + b / &3  `]];\r
4427 REPEAT STRIP_TAC THEN \r
4428 REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM] THEN GEN_TAC THEN \r
4429 EQ_TAC THENL [\r
4430 MESON_TAC[REAL_ARITH ` ( &0 < a /\ &0 < b ==> &0 < a + b ) /\ ( &0 <= a /\ &0 <= b ==> &0 <= a + b )  `;\r
4431   REAL_ARITH ` a + b + c + d = a + ( b + c ) + d `] ; \r
4432 MESON_TAC[REAL_ARITH ` a + b + c = a + b / &2 + b / &2 + c / &3 +\r
4433   c / &3 + c / &3 `; REAL_ARITH` ( &0 < a <=> &0 < a / &3) /\ ( &0 <= a <=> &0 <= a / &3) `;\r
4434   REAL_ARITH` a = a / &2 + a / &2 /\ b = b / &3 + b / &3 + b / &3 /\ b = ( b / &3 + b / &3 ) + b / &3  `]];\r
4435 REPEAT STRIP_TAC THEN \r
4436 REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM] THEN GEN_TAC THEN \r
4437 EQ_TAC THENL [MESON_TAC[REAL_ARITH ` ( &0 < a /\ &0 < b ==> &0 < a + b ) \r
4438 /\ ( &0 <= a /\ &0 <= b ==> &0 <= a + b )  `; REAL_ARITH ` ( a < &0 /\ b < &0 \r
4439 ==> a + b < &0 )`; REAL_ARITH ` a + b + c + d = a + ( b + c ) + d `]; STRIP_TAC] THEN \r
4440 EXISTS_TAC `ta :real` THEN \r
4441 EXISTS_TAC `tb :real` THEN \r
4442 EXISTS_TAC `tc :real` THEN \r
4443 REPEAT (EXISTS_TAC ` t / &3 `) THEN \r
4444 ASM_MESON_TAC[REAL_ARITH` a < &0 <=> a / &3 < &0 `;\r
4445   REAL_ARITH ` a = a / &3 + a / &3 + a / &3 `];\r
4446 REPEAT STRIP_TAC THEN \r
4447 REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM] THEN GEN_TAC THEN \r
4448 EQ_TAC THENL [MESON_TAC[REAL_ARITH ` ( &0 < a /\ &0 < b ==> &0 < a + b ) /\ ( &0 <= a /\ &0 <= b\r
4449  ==> &0 <= a + b )  `; REAL_ARITH ` ( a < &0 /\ b < &0 ==> a + b < &0 )`;\r
4450   REAL_ARITH ` a + b + c + d = a + ( b + c ) + d `]; STRIP_TAC] THEN \r
4451 EXISTS_TAC `ta :real` THEN \r
4452 EXISTS_TAC `tb :real` THEN \r
4453 EXISTS_TAC `tc :real` THEN \r
4454 REPEAT (EXISTS_TAC ` t / &3 `) THEN \r
4455 ASM_MESON_TAC[REAL_ARITH ` a = a / &3 + a / &3 + a / &3 `;\r
4456   REAL_ARITH ` &0 < a <=> &0 < a / &3 `]]);;\r
4457 \r
4458 \r
4459 let AFF_GES_GTS = prove(` ! a b c (v0:real^N).\r
4460 ~(a = v0) /\ ~(b = v0) /\ ~(c = v0)\r
4461      ==> aff_gt {a, b} {v0} =\r
4462                {x | ?ta tb t.\r
4463                         ta + tb + t = &1 /\\r
4464                         &0 < t /\\r
4465                         x = ta % a + tb % b + t % v0} /\\r
4466                aff_ge {a, b} {v0} =\r
4467                {x | ?ta tb t.\r
4468                         ta + tb + t = &1 /\\r
4469                         &0 <= t /\\r
4470                         x = ta % a + tb % b + t % v0} /\\r
4471                aff_lt {a, b, c} {v0} =\r
4472                {x | ?ta tb tc t.\r
4473                         t < &0 /\\r
4474                         ta + tb + tc + t = &1 /\\r
4475                         x = ta % a + tb % b + tc % c + t % v0} /\\r
4476                aff_gt {a, b, c} {v0} =\r
4477                {x | ?ta tb tc t.\r
4478                         &0 < t /\\r
4479                         ta + tb + tc + t = &1 /\\r
4480                         x = ta % a + tb % b + tc % c + t % v0} /\\r
4481          aff_ge {a, b, c} {v0} =\r
4482          {x | ?ta tb tc t.\r
4483                   &0 <= t /\\r
4484                   ta + tb + tc + t = &1 /\\r
4485                   x = ta % a + tb % b + tc % c + t % v0} `,\r
4486 REPEAT GEN_TAC THEN \r
4487 REWRITE_TAC[MESON[]` (a ==> a1 /\ a2 /\ a3 /\ a4 /\ a5) <=>\r
4488   ( a ==> a1 /\ a2 /\ a3 /\a4 ) /\ ( a ==> a5) `] THEN \r
4489 REWRITE_TAC[AFF_GES_LTS] THEN \r
4490 NHANH (SET_RULE` ~(a = v0) /\ ~(b = v0) /\ ~(c = v0) \r
4491   ==> {a,b,c} INTER {v0,v0,v0} = {} `) THEN \r
4492 ONCE_REWRITE_TAC[SET_RULE` {v} = {v,v,v} `] THEN \r
4493 ONCE_REWRITE_TAC[SET_RULE` {a, b, c, c, c} = {a,b,c} `] THEN \r
4494 SIMP_TAC[AFF_GE33] THEN \r
4495 REPEAT STRIP_TAC THEN \r
4496 REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM; GSYM VECTOR_ADD_RDISTRIB] THEN \r
4497 GEN_TAC THEN EQ_TAC THENL [ \r
4498 MESON_TAC[REAL_ARITH` &0 <= a /\ &0 <= b ==> &0 <= a + b `]; \r
4499 STRIP_TAC THEN \r
4500 EXISTS_TAC ` ta :real` THEN \r
4501 EXISTS_TAC ` tb :real` THEN \r
4502 EXISTS_TAC ` tc :real` THEN \r
4503 REPEAT ( EXISTS_TAC ` t / &3 `) THEN \r
4504 ASM_MESON_TAC[REAL_ARITH` a = a / &3 + a / &3 + a / &3 `;\r
4505   REAL_ARITH` &0 <= a <=> &0 <= a / &3 `]]);;\r
4506 \r
4507 \r
4508 let COEF_1_POS_NEG = prove(` ! v1 v2 v3 v4 (v:real^3).\r
4509   ~ coplanar {v1,v2,v3,v4} ==>\r
4510   ( COEF4_1 v1 v2 v3 v4 v > &0 <=> v IN aff_gt {v2,v3,v4} {v1} ) /\\r
4511 ( COEF4_1 v1 v2 v3 v4 v < &0 <=> v IN aff_lt {v2,v3, v4} {v1} ) `,\r
4512 NHANH (MESON[EQ_IMP_COPLANAR]`~coplanar {v1, v2, v3, v4} ==>\r
4513   ~ ( v2 = v1 ) /\ ~ ((v3:real^3) = v1 ) /\ ~ (v4 = v1 ) `) THEN \r
4514 SIMP_TAC[AFF_GES_LTS] THEN NHANH (SPEC_ALL COEFS_4) THEN \r
4515 REWRITE_TAC[IN_ELIM_THM; REAL_ARITH ` a > b <=> b < a `] THEN\r
4516 REPEAT GEN_TAC THEN STRIP_TAC THEN \r
4517 ONCE_REWRITE_TAC[REAL_ARITH ` a + b + c + t = t + a + b + c `] THEN \r
4518 ONCE_REWRITE_TAC[VECTOR_ARITH ` (a:real^N) + b + c + t = t + a + b + c `] THEN \r
4519 ASM_MESON_TAC[]);;\r
4520 \r
4521 \r
4522 let ALL_ABOUT_COEF_1 = prove(` ! v1 v2 v3 v4 (v:real^3).\r
4523   ~ coplanar {v1,v2,v3,v4} ==>\r
4524   ( COEF4_1 v1 v2 v3 v4 v < &0 <=> v IN aff_lt {v2,v3, v4} {v1} ) /\\r
4525   ( COEF4_1 v1 v2 v3 v4 v = &0 <=> v IN aff {v2,v3,v4} ) /\\r
4526   ( COEF4_1 v1 v2 v3 v4 v > &0 <=> v IN aff_gt {v2,v3,v4} {v1} )`,\r
4527 SIMP_TAC[COEF_1_EQ_ZERO ; COEF_1_POS_NEG ]);;\r
4528 \r
4529 let PER_COEF1_WITH_COEF2 = prove(`! v1 v2 v3 v4 (v:real^3).\r
4530  ~coplanar {v1, v2, v3, v4} ==>\r
4531    COEF4_2 v1 v2 v3 v4 v = COEF4_1 v2 v3 v4 v1 v `,\r
4532 NHANH (SPEC_ALL COEFS_4) THEN \r
4533 REPEAT GEN_TAC THEN STRIP_TAC THEN \r
4534 MP_TAC (SPECL [` v2:real^3 `; `v3:real^3`; `v4:real^3`; ` v1:real^3`;\r
4535  `v:real^3 `] COEFS_4) THEN \r
4536 UNDISCH_TAC ` ~coplanar {v1, v2, v3, (v4:real^3)}` THEN \r
4537 IMP_IMP_TAC THEN \r
4538 REWRITE_TAC[MESON[SET_RULE` {v1, v2, v3, v4} = {v2, v3, v4, v1}`]`\r
4539   ~coplanar {v1, v2, v3, v4} /\\r
4540  (~coplanar {v2, v3, v4, v1} ==> l ) <=> ~coplanar {v1, v2, v3, v4}\r
4541   /\ l `] THEN \r
4542 ONCE_REWRITE_TAC[GSYM (REAL_ARITH` a + b + c + d = b + c + d + a `)] THEN \r
4543 ONCE_REWRITE_TAC[GSYM (VECTOR_ARITH` (a:real^N) + b + c + d = b + c + d + a `)] THEN \r
4544 ASM_MESON_TAC[]);;\r
4545 \r
4546 let PER_COEF1_WITH_COEF3 = prove(`! v1 v2 v3 v4 (v:real^3).\r
4547  ~coplanar {v1, v2, v3, v4} ==>\r
4548    COEF4_3 v1 v2 v3 v4 v = COEF4_1 v3 v4 v1 v2 v `,\r
4549 NHANH (SPEC_ALL COEFS_4) THEN \r
4550 REPEAT GEN_TAC THEN STRIP_TAC THEN \r
4551 MP_TAC (SPECL [`v3:real^3`; `v4:real^3`; ` v1:real^3`; ` v2:real^3`;\r
4552  `v:real^3 `] COEFS_4) THEN \r
4553 UNDISCH_TAC ` ~coplanar {v1, v2, v3, (v4:real^3)}` THEN \r
4554 IMP_IMP_TAC THEN \r
4555 REWRITE_TAC[MESON[SET_RULE` {v1, v2, v3, v4} = {v3, v4, v1, v2}`]`\r
4556   ~coplanar {v1, v2, v3, v4} /\\r
4557  (~coplanar {v3, v4, v1, v2} ==> l ) <=> ~coplanar {v1, v2, v3, v4}\r
4558   /\ l `] THEN \r
4559 ONCE_REWRITE_TAC[GSYM (REAL_ARITH` a + b + c + d = c + d + a + b`)] THEN \r
4560 ONCE_REWRITE_TAC[GSYM (VECTOR_ARITH` (a:real^N) + b + c + d = c + d + a + b`)]\r
4561  THEN ASM_MESON_TAC[]);;\r
4562 \r
4563 let PER_COEF1_WITH_COEF4 = prove(`! v1 v2 v3 v4 (v:real^3).\r
4564  ~coplanar {v1, v2, v3, v4} ==>\r
4565    COEF4_4 v1 v2 v3 v4 v = COEF4_1 v4 v1 v2 v3 v `,\r
4566 NHANH (SPEC_ALL COEFS_4) THEN \r
4567 REPEAT GEN_TAC THEN \r
4568 ONCE_REWRITE_TAC[SET_RULE` {v1, v2, v3, v4} = {v4,v1, v2, v3}`] THEN \r
4569 NHANH (SPEC_ALL COEFS_4) THEN \r
4570 MESON_TAC[REAL_ARITH` ta + tb + tc + td = td + ta + tb + tc`;\r
4571   VECTOR_ARITH` ta + tb + tc + td = td + ta + tb + (tc:real^N)`]);;\r
4572 \r
4573 let ALL_ABOUT_COEF_2 = prove(` ! v1 v2 v3 v4 (v:real^3).\r
4574   ~ coplanar {v1,v2,v3,v4} ==>\r
4575   ( COEF4_2 v1 v2 v3 v4 v < &0 <=> v IN aff_lt {v1,v3, v4} {v2} ) /\\r
4576   ( COEF4_2 v1 v2 v3 v4 v = &0 <=> v IN aff {v1,v3,v4} ) /\\r
4577   ( COEF4_2 v1 v2 v3 v4 v > &0 <=> v IN aff_gt {v1,v3,v4} {v2} )`,\r
4578 SIMP_TAC[PER_COEF1_WITH_COEF2] THEN MP_TAC ALL_ABOUT_COEF_1 THEN \r
4579 MESON_TAC[SET_RULE` {v1, v2, v3, v4} = {v2, v3, v4, v1}`;\r
4580 SET_RULE` {v1, v2, v3} = {v2, v3,v1}`]);;\r
4581 \r
4582 \r
4583 \r
4584 \r
4585 let ALL_ABOUT_COEF_3 = prove(` ! v1 v2 v3 v4 (v:real^3).\r
4586   ~ coplanar {v1,v2,v3,v4} ==>\r
4587   ( COEF4_3 v1 v2 v3 v4 v < &0 <=> v IN aff_lt {v2,v1, v4} {v3} ) /\\r
4588   ( COEF4_3 v1 v2 v3 v4 v = &0 <=> v IN aff {v2,v1,v4} ) /\\r
4589   ( COEF4_3 v1 v2 v3 v4 v > &0 <=> v IN aff_gt {v2,v1,v4} {v3} ) `,\r
4590 SIMP_TAC[PER_COEF1_WITH_COEF3] THEN \r
4591 ONCE_REWRITE_TAC[SET_RULE` {v2, v1, v4} = {v4,v1,v2} `] THEN \r
4592 ONCE_REWRITE_TAC[SET_RULE` {v1, v4, v3, v2} = {v3,v4,v1,v2} `] THEN \r
4593 SIMP_TAC[ALL_ABOUT_COEF_1]);;\r
4594 \r
4595 let SRGTIHY = prove(` ! v1 v2 v3 v4 (v:real^3).\r
4596   ~ coplanar {v1,v2,v3,v4} ==>\r
4597   ( COEF4_1 v1 v2 v3 v4 v < &0 <=> v IN aff_lt {v2,v3, v4} {v1} ) /\\r
4598   ( COEF4_1 v1 v2 v3 v4 v = &0 <=> v IN aff {v2,v3,v4} ) /\\r
4599   ( COEF4_1 v1 v2 v3 v4 v > &0 <=> v IN aff_gt {v2,v3,v4} {v1} ) /\\r
4600   ( COEF4_2 v1 v2 v3 v4 v < &0 <=> v IN aff_lt {v1,v3, v4} {v2} ) /\\r
4601   ( COEF4_2 v1 v2 v3 v4 v = &0 <=> v IN aff {v1,v3,v4} ) /\\r
4602   ( COEF4_2 v1 v2 v3 v4 v > &0 <=> v IN aff_gt {v1,v3,v4} {v2} ) /\  \r
4603   ( COEF4_3 v1 v2 v3 v4 v < &0 <=> v IN aff_lt {v2,v1, v4} {v3} ) /\\r
4604   ( COEF4_3 v1 v2 v3 v4 v = &0 <=> v IN aff {v2,v1,v4} ) /\\r
4605   ( COEF4_3 v1 v2 v3 v4 v > &0 <=> v IN aff_gt {v2,v1,v4} {v3} )/\  \r
4606   ( COEF4_4 v1 v2 v3 v4 v < &0 <=> v IN aff_lt {v2,v1, v3} {v4} ) /\\r
4607   ( COEF4_4 v1 v2 v3 v4 v = &0 <=> v IN aff {v2,v1,v3} ) /\\r
4608   ( COEF4_4 v1 v2 v3 v4 v > &0 <=> v IN aff_gt {v2,v1,v3} {v4} )`,\r
4609 SIMP_TAC[ALL_ABOUT_COEF_1; ALL_ABOUT_COEF_2; ALL_ABOUT_COEF_3;\r
4610   PER_COEF1_WITH_COEF4] THEN \r
4611 ONCE_REWRITE_TAC[SET_RULE` {v2, v1, v3} = {v1,v2,v3}`] THEN \r
4612 ONCE_REWRITE_TAC[SET_RULE` {v1, v3, v2, v4} = {v4,v1,v2,v3}`] THEN \r
4613 SIMP_TAC[ALL_ABOUT_COEF_1]);;\r
4614 let LEMMA77 = SRGTIHY;;\r
4615 \r
4616 \r
4617  let CONV0_4 = prove\r
4618   (`conv0 {v1, v2, v3, v4} =\r
4619          {x:real^N | ?a b c d.\r
4620          &0 < a /\\r
4621          &0 < b /\\r
4622          &0 < c /\\r
4623          &0 < d /\\r
4624          a + b + c + d = &1 /\\r
4625          a % v1 + b % v2 + c % v3 + d % v4 = x}`,\r
4626    REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN\r
4627    REWRITE_TAC[conv0; affsign; sgn_gt; lin_combo; UNION_EMPTY] THEN\r
4628    MATCH_MP_TAC EQ_TRANS THEN\r
4629    EXISTS_TAC\r
4630     `?f. (!w:real^N. w IN {v1, v2, v3, v4} ==> &0 < f w) /\\r
4631          sum {v1, v2, v3, v4} f = &1 /\\r
4632          vsum {v1, v2, v3, v4} (\v. f v % v) = y` THEN\r
4633    CONJ_TAC THENL [REWRITE_TAC[IN] THEN MESON_TAC[]; ALL_TAC] THEN\r
4634    SIMP_TAC[AFFINE_HULL_FINITE_STEP_GEN;\r
4635             REAL_ARITH `&0 < x /\ &0 < y ==> &0 < x + y`;\r
4636             REAL_ARITH `&0 < x ==> &0 < x / &2`;\r
4637             FINITE_INSERT; CONJUNCT1 FINITE_RULES; RIGHT_EXISTS_AND_THM] THEN\r
4638    ASM_REWRITE_TAC[IN_ELIM_THM;\r
4639                    REAL_ARITH `x - y:real = z <=> x = y + z`;\r
4640                    VECTOR_ARITH `x - y:real^N = z <=> x = y + z`] THEN\r
4641    REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID] THEN MESON_TAC[]);;\r
4642 \r
4643 (* ======================= *)\r
4644 (* LEMMA 81 *)\r
4645 (* ======================= *)\r
4646 \r
4647 let ARIKWRQ = prove(`! v1 v2 v3 (v4:real^3).\r
4648   let s = {v1,v2,v3,v4} in\r
4649   CARD s = 4 /\ ~ coplanar s ==>\r
4650   conv s = aff_ge ( s DIFF {v1} ) {v1} INTER \r
4651   aff_ge ( s DIFF {v2} ) {v2} INTER \r
4652   aff_ge ( s DIFF {v3} ) {v3} INTER \r
4653   aff_ge ( s DIFF {v4} ) {v4} `, LET_TR THEN \r
4654 SIMP_TAC[CARD4; SET_RULE ` ~(v1 IN {v2, v3, v4}) /\ ~(v2 = v3 \/ v3 = v4 \/ v4 = v2)\r
4655   ==> {v1, v2, v3, v4} DIFF {v1} = {v2,v3,v4} /\\r
4656   {v1, v2, v3, v4} DIFF {v2} = {v3,v4,v1} /\\r
4657   {v1, v2, v3, v4} DIFF {v3} = {v4,v1,v2} /\\r
4658   {v1, v2, v3, v4} DIFF {v4} = {v1,v2,v3} `] THEN \r
4659 REWRITE_TAC[CARD4; IN_SET3;DE_MORGAN_THM] THEN \r
4660 SIMP_TAC[AFF_GES_GTS] THEN \r
4661 REWRITE_TAC[CONVEX_HULL_4_EQUIV] THEN \r
4662 REPEAT STRIP_TAC THEN \r
4663 REWRITE_TAC[SET_RULE ` a = b <=> (! x. x IN a <=> x IN b ) `;\r
4664   IN_INTER; IN_ELIM_THM] THEN \r
4665 GEN_TAC THEN EQ_TAC THENL [\r
4666 ASM_MESON_TAC[REAL_ARITH` a + b + c + d = d + a + b + c `;\r
4667   VECTOR_ARITH` (a:real^N) + b + c + d = d + a + b + c `];\r
4668 FIRST_X_ASSUM MP_TAC ] THEN\r
4669 NHANH (SPEC ` x: real^3` (GEN ` v:real^3` (SPEC_ALL COEFS_4))) THEN \r
4670 ABBREV_TAC ` aa = COEF4_1 v1 v2 v3 v4 x ` THEN \r
4671 ABBREV_TAC ` bb = COEF4_2 v1 v2 v3 v4 x ` THEN \r
4672 ABBREV_TAC ` cc = COEF4_3 v1 v2 v3 v4 x ` THEN \r
4673 ABBREV_TAC ` dd = COEF4_4 v1 v2 v3 v4 x ` THEN \r
4674 REWRITE_TAC[MESON[]` a ==> b ==> c <=> a /\ b ==> c `] THEN PHA THEN \r
4675 NHANH (MESON[REAL_ARITH` a + b + c + d = d + a + b + c `;\r
4676   VECTOR_ARITH` (a:real^N) + b + c + d = d + a + b + c `]`\r
4677 aa + bb + cc + dd = &1 /\\r
4678  x = aa % v1 + bb % v2 + cc % v3 + dd % v4 /\\r
4679  (!ta tb tc td.\r
4680       x = ta % v1 + tb % v2 + tc % v3 + td % v4 /\ ta + tb + tc + td = &1\r
4681       ==> ta = aa /\ tb = bb /\ tc = cc /\ td = dd) /\\r
4682  (?ta tb tc t.\r
4683       &0 <= t /\\r
4684       ta + tb + tc + t = &1 /\\r
4685       x = ta % v2 + tb % v3 + tc % v4 + t % v1) /\\r
4686  (?ta tb tc t.\r
4687       &0 <= t /\\r
4688       ta + tb + tc + t = &1 /\\r
4689       x = ta % v3 + tb % v4 + tc % v1 + t % v2) /\\r
4690  (?ta tb tc t.\r
4691       &0 <= t /\\r
4692       ta + tb + tc + t = &1 /\\r
4693       x = ta % v4 + tb % v1 + tc % v2 + t % v3) /\\r
4694  (?ta tb tc t.\r
4695       &0 <= t /\\r
4696       ta + tb + tc + t = &1 /\\r
4697       x = ta % v1 + tb % v2 + tc % v3 + t % v4)\r
4698  ==> &0 <= aa /\ &0 <= bb /\ &0 <= cc /\ &0 <= dd`) THEN \r
4699 MATCH_MP_TAC (MESON[]` ( a1 /\ a2 /\ a3 ==> l) ==>\r
4700   aa /\ ( a1 /\ a2 /\ a4 ) /\ a3 ==> l `) THEN MESON_TAC[]);;\r
4701 \r
4702 \r
4703 \r
4704 \r
4705 \r
4706 (* ================ *)\r
4707 (* LEMMA 82 *)\r
4708 (* ================= *)\r
4709 \r
4710 \r
4711 \r
4712 \r
4713 let MXHKOXR = prove(`! v1 v2 v3 (v4:real^3). let s = {v1,v2,v3,v4} in\r
4714   CARD s = 4 /\ ~ coplanar s ==>\r
4715   conv0 s = aff_gt ( s DIFF {v1} ) {v1} INTER \r
4716   aff_gt ( s DIFF {v2} ) {v2} INTER \r
4717   aff_gt ( s DIFF {v3} ) {v3} INTER \r
4718   aff_gt ( s DIFF {v4} ) {v4} `, LET_TR THEN \r
4719 SIMP_TAC[CARD4; SET_RULE ` ~(v1 IN {v2, v3, v4}) /\ ~(v2 = v3 \/ v3 = v4 \/ v4 = v2)\r
4720   ==> {v1, v2, v3, v4} DIFF {v1} = {v2,v3,v4} /\\r
4721   {v1, v2, v3, v4} DIFF {v2} = {v3,v4,v1} /\\r
4722   {v1, v2, v3, v4} DIFF {v3} = {v4,v1,v2} /\\r
4723   {v1, v2, v3, v4} DIFF {v4} = {v1,v2,v3} `] THEN \r
4724 REWRITE_TAC[CARD4; IN_SET3;DE_MORGAN_THM] THEN \r
4725 SIMP_TAC[AFF_GES_GTS; CONV0_4 ] THEN \r
4726 REPEAT STRIP_TAC THEN \r
4727 REWRITE_TAC[SET_RULE ` a = b <=> (! x. x IN a <=> x IN b ) `;\r
4728   IN_INTER; IN_ELIM_THM] THEN \r
4729 GEN_TAC THEN EQ_TAC THENL [\r
4730 ASM_MESON_TAC[REAL_ARITH` a + b + c + d = d + a + b + c `;\r
4731   VECTOR_ARITH` (a:real^N) + b + c + d = d + a + b + c `];\r
4732 FIRST_X_ASSUM MP_TAC ] THEN\r
4733 NHANH (SPEC ` x: real^3` (GEN ` v:real^3` (SPEC_ALL COEFS_4))) THEN \r
4734 ABBREV_TAC ` aa = COEF4_1 v1 v2 v3 v4 x ` THEN \r
4735 ABBREV_TAC ` bb = COEF4_2 v1 v2 v3 v4 x ` THEN \r
4736 ABBREV_TAC ` cc = COEF4_3 v1 v2 v3 v4 x ` THEN \r
4737 ABBREV_TAC ` dd = COEF4_4 v1 v2 v3 v4 x ` THEN \r
4738 REWRITE_TAC[MESON[]` a ==> b ==> c <=> a /\ b ==> c `] THEN PHA THEN \r
4739 NHANH (MESON[REAL_ARITH` a + b + c + d = d + a + b + c `;\r
4740   VECTOR_ARITH` (a:real^N) + b + c + d = d + a + b + c `]`\r
4741 aa + bb + cc + dd = &1 /\\r
4742  x = aa % v1 + bb % v2 + cc % v3 + dd % v4 /\\r
4743  (!ta tb tc td.\r
4744       x = ta % v1 + tb % v2 + tc % v3 + td % v4 /\ ta + tb + tc + td = &1\r
4745       ==> ta = aa /\ tb = bb /\ tc = cc /\ td = dd) /\\r
4746  (?ta tb tc t.\r
4747       &0 < t /\\r
4748       ta + tb + tc + t = &1 /\\r
4749       x = ta % v2 + tb % v3 + tc % v4 + t % v1) /\\r
4750  (?ta tb tc t.\r
4751       &0 < t /\\r
4752       ta + tb + tc + t = &1 /\\r
4753       x = ta % v3 + tb % v4 + tc % v1 + t % v2) /\\r
4754  (?ta tb tc t.\r
4755       &0 < t /\\r
4756       ta + tb + tc + t = &1 /\\r
4757       x = ta % v4 + tb % v1 + tc % v2 + t % v3) /\\r
4758  (?ta tb tc t.\r
4759       &0 < t /\\r
4760       ta + tb + tc + t = &1 /\\r
4761       x = ta % v1 + tb % v2 + tc % v3 + t % v4)\r
4762 ==> &0 < aa /\ &0 < bb /\ &0 < cc /\ &0 < dd `) THEN \r
4763 MATCH_MP_TAC (MESON[]` ( a1 /\ a2 /\ a3 ==> l) ==>\r
4764   aa /\ ( a1 /\ a2 /\ a4 ) /\ a3 ==> l `) THEN MESON_TAC[]);;\r
4765 \r
4766 \r
4767  let CONV0_4 = prove\r
4768   (`conv0 {v1, v2, v3, v4} =\r
4769          {x:real^N | ?a b c d.\r
4770          &0 < a /\\r
4771          &0 < b /\\r
4772          &0 < c /\\r
4773          &0 < d /\\r
4774          a + b + c + d = &1 /\\r
4775          a % v1 + b % v2 + c % v3 + d % v4 = x}`,\r
4776    REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN\r
4777    REWRITE_TAC[conv0; affsign; sgn_gt; lin_combo; UNION_EMPTY] THEN\r
4778    MATCH_MP_TAC EQ_TRANS THEN\r
4779    EXISTS_TAC\r
4780     `?f. (!w:real^N. w IN {v1, v2, v3, v4} ==> &0 < f w) /\\r
4781          sum {v1, v2, v3, v4} f = &1 /\\r
4782          vsum {v1, v2, v3, v4} (\v. f v % v) = y` THEN\r
4783    CONJ_TAC THENL [REWRITE_TAC[IN] THEN MESON_TAC[]; ALL_TAC] THEN\r
4784    SIMP_TAC[AFFINE_HULL_FINITE_STEP_GEN;\r
4785             REAL_ARITH `&0 < x /\ &0 < y ==> &0 < x + y`;\r
4786             REAL_ARITH `&0 < x ==> &0 < x / &2`;\r
4787             FINITE_INSERT; CONJUNCT1 FINITE_RULES; RIGHT_EXISTS_AND_THM] THEN\r
4788    ASM_REWRITE_TAC[IN_ELIM_THM;\r
4789                    REAL_ARITH `x - y:real = z <=> x = y + z`;\r
4790                    VECTOR_ARITH `x - y:real^N = z <=> x = y + z`] THEN\r
4791    REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID] THEN MESON_TAC[]);;\r
4792 \r
4793 \r
4794 let CONV0_4POINTS = CONV0_4;;\r
4795 \r
4796 \r
4797 \r
4798 (* ================== *)\r
4799 (* LEMMA 78 *)\r
4800 \r
4801 (* ================== *)\r
4802 \r
4803 \r
4804 let ZRFMKPY = prove(` ! v1 v2 v3 v4 (v:real^3).\r
4805   ~coplanar {v1, v2, v3, v4}\r
4806          ==> (v IN conv {v1, v2, v3, v4} <=>\r
4807               &0 <= COEF4_1 v1 v2 v3 v4 v /\\r
4808               &0 <= COEF4_2 v1 v2 v3 v4 v /\\r
4809               &0 <= COEF4_3 v1 v2 v3 v4 v /\\r
4810               &0 <= COEF4_4 v1 v2 v3 v4 v) /\\r
4811              (v IN conv0 {v1, v2, v3, v4} <=>\r
4812               &0 < COEF4_1 v1 v2 v3 v4 v /\\r
4813               &0 < COEF4_2 v1 v2 v3 v4 v /\\r
4814               &0 < COEF4_3 v1 v2 v3 v4 v /\\r
4815               &0 < COEF4_4 v1 v2 v3 v4 v) `,\r
4816 NHANH (SPEC_ALL COEFS_4) THEN REWRITE_TAC[CONVEX_HULL_4_EQUIV; \r
4817 CONV0_4POINTS; IN_ELIM_THM] THEN MESON_TAC[]);;\r
4818 \r
4819 let LEMMA78 = ZRFMKPY;;\r
4820 \r
4821 \r
4822 \r
4823 (* APRIL WORKS *)\r
4824 (* =========== *)\r
4825 (* NGUYEN QUANG TRUONG *)\r
4826 let IMP_TAC = IMP_IMP_TAC;;\r
4827 \r
4828 \r
4829 \r
4830 let QUAANG_TRUOONN = prove(` ! v0 v1 v2 v3 (v4:real^N).\r
4831    CARD {v0, v1, v2, v3, v4} = 5 /\\r
4832          (?x. ~(x = v0) /\ x IN cone v0 {v1, v3} INTER cone v0 {v2, v4})\r
4833          ==> ~(conv {v1, v3} INTER cone v0 {v2, v4} = {})`,\r
4834 REWRITE_TAC[CONV_SET2; cone; CARD5; SET_RULE ` a INTER b = {} <=> \r
4835   ~ (? x. a x /\ b x ) `; GSYM aff_ge_def; IN; IN_INTER] THEN \r
4836 NHANH (SET_RULE ` ~{v1, v2, v3, v4} v0 ==>\r
4837   ~ ( v0 = v1 \/ v0 = v3 ) /\ ~ ( v0 = v2 \/ v0 = v4 ) `) THEN \r
4838 ONCE_REWRITE_TAC[MESON[]` a /\ b ==> c <=> a ==> b ==> c `] THEN \r
4839 SIMP_TAC[AFF_GE_12] THEN REWRITE_TAC[DE_MORGAN_THM] THEN \r
4840 REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN \r
4841 UNDISCH_TAC ` (x:real^N) = tv % v0 + ta % v1 + tb % v3` THEN \r
4842 UNDISCH_TAC ` (x:real^N) = tv' % v0 + ta' % v2 + tb' % v4` THEN \r
4843 REWRITE_TAC[MESON[]` x = a \r
4844  ==> x = (b:real^N) ==> c <=> x = a /\ a = b ==> c `] THEN \r
4845 REWRITE_TAC[VECTOR_ARITH` a % v + d = b % v + e <=>\r
4846   ( a - b ) % v + d = e `] THEN \r
4847 ASM_CASES_TAC ` &0 < ta + tb ` THENL [DOWN_TAC THEN \r
4848 REWRITE_TAC[MESON[VECTOR_MUL_LCANCEL; REAL_FIELD ` &0 < a ==> ~ ( &1 / a = &0 )`]`\r
4849   &0 < ta + tb /\ aaa /\\r
4850  aa = ta % v1 + tb % v3 <=> &0 < ta + tb /\ aaa /\\r
4851   &1 / ( ta + tb ) % aa = &1 / ( ta + tb ) % ( ta % v1 + tb % v3) `] THEN \r
4852 REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_ARITH `\r
4853   &1 / a * b = b / a `] THEN STRIP_TAC THEN DOWN_TAC THEN \r
4854 NHANH (MESON[REAL_LE_RDIV_0]`&0 <= ta /\ &0 <= tb /\ a1 /\ &0 <= ta' /\\r
4855  &0 <= tb' /\ a2 /\\r
4856  &0 < ta + tb /\ a3 ==> &0 <= ta / (ta + tb) /\ &0 <= tb / (ta + tb) /\\r
4857   &0 <= ta' / (ta + tb) /\ &0 <= tb' / (ta + tb) `) THEN ASM_MESON_TAC[\r
4858 REAL_FIELD` tv + ta + tb = &1 /\ tv' + ta' + tb' = &1 /\\r
4859   &0 < ta + tb ==> (tv' - tv) / (ta + tb) + ta' / (ta + tb) +\r
4860   tb' / (ta + tb) = &1 /\ ta / ( ta + tb ) + tb / ( ta + tb ) = &1`];\r
4861 DOWN_TAC THEN \r
4862 NHANH (MESON[REAL_ARITH` &0 <= a /\ &0 <= b /\ ~( &0 < a + b ) \r
4863 ==> a = &0 /\ b = &0 `]`&0 <= ta /\ &0 <= tb /\a1/\a2 /\a3/\a4 /\\r
4864  ~(&0 < ta + tb) /\ a5 ==> ta = &0 /\ tb = &0`) THEN \r
4865 PURE_ONCE_REWRITE_TAC[MESON[]` P ta tb /\ ta = &0 /\ tb = &0 \r
4866   <=> P ( &0 ) ( &0 ) /\ ta = &0 /\ tb = &0 `] THEN \r
4867 REWRITE_TAC[ZERO_NEUTRAL; VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN \r
4868 REWRITE_TAC[VECTOR_ARITH` (tv' - tv) % v + a = vec 0 <=> tv' % v + a\r
4869   = tv % v `; MESON[]` a = b /\ b = c <=> a = c /\ b = c `] THEN \r
4870 MESON_TAC[VECTOR_ARITH ` &1 % v = v `]]);;\r
4871 \r
4872 (* le 80. p 51 *)\r
4873 (* ================ *)\r
4874 \r
4875 let JVDAFRS = prove(` ! v0 v1 v2 v3 (v4:real^N).\r
4876    CARD {v0, v1, v2, v3, v4} = 5 /\\r
4877          (?x. ~(x = v0) /\ x IN cone v0 {v1, v3} INTER cone v0 {v2, v4})\r
4878          ==> ~(conv {v1, v3} INTER cone v0 {v2, v4} = {} /\\r
4879                conv {v2, v4} INTER cone v0 {v1, v3} = {})`, MESON_TAC[QUAANG_TRUOONN]);;\r
4880 \r
4881 (* LEMMA 22 *)\r
4882 (* =========================== *)\r
4883 \r
4884 let SQRT8_POS = MESON[REAL_ARITH ` &0 < &8 `; SQRT_POS_LT]` &0 < sqrt (&8) `;;\r
4885 \r
4886 let SQRT8_LT_4_45 = prove(` sqrt8 < #4.45 `,\r
4887 SIMP_TAC[sqrt8; REAL_ARITH ` &0 < #4.45 `; MESON[REAL_ARITH ` &0 < &8 `; \r
4888 SQRT_POS_LT]` &0 < sqrt (&8) `; LT_POW2_EQ_LT; SQRT8_POW2] THEN REAL_ARITH_TAC);;\r
4889 \r
4890 \r
4891 let PROVE_NOT_COLLINEAR = prove(` ! v0 v1 (v2:real^3).\r
4892          &2 <= d3 v0 v1 /\\r
4893          d3 v0 v1 <= #2.51 /\\r
4894          #2.45 <= d3 v1 v2 /\\r
4895          d3 v1 v2 <= #2.51 /\\r
4896          #2.77 <= d3 v0 v2 /\\r
4897          d3 v0 v2 <= sqrt8\r
4898          ==> ~ collinear {v0, v1, v2}`,\r
4899 REWRITE_TAC[COLLINEAR_AS_IN_CONV2; MID_COND; d3; LENGTH_EQ_EX; DE_MORGAN_THM] THEN \r
4900 SIMP_TAC[DIST_SYM] THEN \r
4901 REPEAT GEN_TAC THEN \r
4902 ABBREV_TAC ` a = dist(v0,v1:real^3)` THEN \r
4903 ABBREV_TAC ` b = dist(v0,v2:real^3)` THEN \r
4904 ABBREV_TAC ` c = dist(v1,v2:real^3)` THEN \r
4905 MP_TAC SQRT8_LT_4_45  THEN \r
4906 REAL_ARITH_TAC);;\r
4907 \r
4908 \r
4909 \r
4910 let BPOW8APOW2CPOW2 = prove(`&2 <= a /\\r
4911  a <= #2.51 /\\r
4912  #2.45 <= c /\\r
4913  c <= #2.51 /\\r
4914  #2.77 <= b /\\r
4915  b <= sqrt8\r
4916 ==> b pow 2 <= &8 /\ a pow 2 <= #2.51 pow 2 /\ c pow 2 <= #2.51 pow 2 `,\r
4917 REWRITE_TAC[MESON[]` a1 /\ a2 /\a3 /\a4 /\a5 /\a6 ==> l <=>\r
4918   a1 /\a3 /\a5 ==> a2 /\a4 /\a6 ==> l `] THEN \r
4919 NHANH (REAL_ARITH`&2 <= a /\ #2.45 <= c /\ #2.77 <= b ==>\r
4920  &0 < a /\ &0 < b /\ &0 < c /\ &0 < #2.51 `) THEN \r
4921 SIMP_TAC[sqrt8; POW2_COND_LT; SQRT8_POS; SQRT8_POW2]);;\r
4922 \r
4923 \r
4924 let IMP_PRE_LE_19 = prove(`&2 <= a /\\r
4925  a <= #2.51 /\\r
4926  #2.45 <= c /\\r
4927  c <= #2.51 /\\r
4928  #2.77 <= b /\\r
4929  b <= sqrt8\r
4930  ==> &0 < &2 /\\r
4931      &2 <= a /\\r
4932      &0 < #2.77 /\\r
4933      #2.77 <= b /\\r
4934      &0 < #2.45 /\\r
4935      #2.45 <= c /\\r
4936      a pow 2 <= #2.77 pow 2 + #2.45 pow 2 /\\r
4937      b pow 2 <= &2 pow 2 + #2.45 pow 2 /\\r
4938      c pow 2 <= &2 pow 2 + #2.77 pow 2 `,\r
4939 CONV_TAC REAL_RAT_REDUCE_CONV THEN NHANH (BPOW8APOW2CPOW2 ) THEN REAL_ARITH_TAC);;\r
4940 \r
4941 \r
4942 \r
4943 let ZEDIDCF = prove(` ! v0 v1 (v2:real^3).\r
4944          &2 <= d3 v0 v1 /\\r
4945          d3 v0 v1 <= #2.51 /\\r
4946          #2.45 <= d3 v1 v2 /\\r
4947          d3 v1 v2 <= #2.51 /\\r
4948          #2.77 <= d3 v0 v2 /\\r
4949          d3 v0 v2 <= sqrt8\r
4950          ==> sqrt2 < radV {v0, v1, v2}`,\r
4951 NHANH (SPEC_ALL PROVE_NOT_COLLINEAR) THEN \r
4952 SIMP_TAC[RADV_FORMULAR] THEN REPEAT GEN_TAC THEN \r
4953 SIMP_TAC[d3; DIST_SYM] THEN \r
4954 ABBREV_TAC ` a = dist(v0,v1:real^3)` THEN \r
4955 ABBREV_TAC ` b = dist(v0,v2:real^3)` THEN \r
4956 ABBREV_TAC ` c = dist(v1,v2:real^3)` THEN \r
4957 NHANH (IMP_PRE_LE_19 ) THEN NHANH (SPEC_ALL BYOWBDF) THEN \r
4958 SIMP_TAC[ETA_Y_SYYM] THEN STRIP_TAC THEN \r
4959 UNDISCH_TAC ` eta_y #2.77 #2.45 (&2) <= eta_y a b c ` THEN \r
4960 ABBREV_TAC ` l = eta_y a b c ` THEN \r
4961 REWRITE_TAC[eta_y; eta_x; ups_x; sqrt2] THEN LET_TR THEN \r
4962 CONV_TAC REAL_RAT_REDUCE_CONV THEN \r
4963 MP_TAC (prove(`  sqrt (&2) < sqrt (&93993025 / &46231104) `,\r
4964 SIMP_TAC[SQRT_WORKS; REAL_ARITH ` &0 <= &2 /\\r
4965   &0 <= &93993025 / &46231104 `; LT_POW2_COND] THEN REAL_ARITH_TAC)) \r
4966 THEN REAL_ARITH_TAC);;\r
4967 \r
4968 \r
4969 (* ==================== *)\r
4970 \r
4971 let condC = new_definition ` condC M13 m12 m14 M24 m34 (m23:real) =\r
4972   ((! x. x IN {M13, m12, m14, M24, m34, m23 } ==> &0 <= x ) /\\r
4973   M13 <= m12 + m23 /\\r
4974   M13 <= m14 + m34 /\ \r
4975   M24 < m12 + m14 /\\r
4976   M24 < m23 + m34 /\ \r
4977   &0 <= delta (M13 pow 2) (m12 pow 2) (m14 pow 2) (M24 pow 2) (m34 pow 2 )\r
4978    (m23 pow 2 ) )`;;\r
4979 \r
4980 \r
4981 let CXWOCGN = new_axiom` !M13 m12 m14 M24 m34 m23 (v1:real^3) v2 v3 v4.\r
4982          condC M13 m12 m14 M24 m34 m23 /\\r
4983   CARD {v1,v2,v3,v4} = 4 /\\r
4984   m12 <= d3 v1 v2 /\ \r
4985   m23 <= d3 v2 v3 /\\r
4986   m34 <= d3 v3 v4 /\ \r
4987   m14 <= d3 v1 v4 /\ \r
4988   d3 v1 v3 < M13 /\\r
4989   d3 v2 v4 <= M24 ==>\r
4990   conv {v1,v3} INTER conv {v2,v4} = {} `;;\r
4991 SPECL [` sqrt (&8 ) `; ` &2 `; ` &2 `; ` sqrt (&8) `; ` &2 `;\r
4992   ` &2 `; ` u :real^3 `; ` w : real^3 `; ` v :real^3 `; ` u + v - ( w:real^3 )`] CXWOCGN;;\r
4993 \r
4994 \r
4995 g ` a < sqrt (&8) ==> ~ ( &2 <= &1 / &2 * a ) `;;\r
4996 e (ASM_CASES_TAC ` &0 <= a `);;\r
4997 e (UNDISCH_TAC `&0 <= a `);;\r
4998 e (SIMP_TAC[REAL_LT_IMP_LE; SQRT8_POS; LT_POW2_COND; REAL_ARITH `\r
4999   &2 <= &1 / &2 * a <=> &4 <= a `; REAL_ARITH` &0 <= &4 `;\r
5000   POW2_COND; SQRT8_POW2]);;\r
5001 e (REAL_ARITH_TAC);;\r
5002 e (FIRST_X_ASSUM MP_TAC);;\r
5003 e (REAL_ARITH_TAC);;\r
5004 let LT_SQ8_IMP_LT2 = top_thm();;\r
5005 \r
5006 \r
5007 \r
5008 let LE_FOR_LEMMA36 = prove(`(CARD {u, v, w} = 3 /\ packing {u, v, w} /\ dist (u,v) < sqrt8) /\\r
5009        ~(dist (u,v) / &2 < dist (w,&1 / &2 % (u + v))) ==>\r
5010   condC (sqrt (&8)) (&2) (&2) (sqrt (&8)) (&2) (&2) /\\r
5011      CARD {u, w, v, u + v - w} = 4 /\\r
5012      &2 <= d3 u w /\\r
5013      &2 <= d3 w v /\\r
5014      &2 <= d3 v (u + v - w) /\\r
5015      &2 <= d3 u (u + v - w) /\\r
5016      d3 u v < sqrt (&8) /\\r
5017      d3 w (u + v - w) <= sqrt (&8) `,\r
5018 REWRITE_TAC[condC; delta; SQRT8_POW2] THEN \r
5019 REWRITE_TAC[SET_RULE ` (! x. x IN ( a INSERT b ) ==> p x ) <=>\r
5020   p a /\ (! x. x IN b  ==> p x ) `; NOT_IN_EMPTY] THEN \r
5021 CONV_TAC REAL_RAT_REDUCE_CONV THEN \r
5022 SIMP_TAC[SQRT8_POS; REAL_LT_IMP_LE; d3; sqrt8; packing] THEN \r
5023 SIMP_TAC[REAL_LT_IMP_LE; SQRT8_POS; LT_POW2_COND;\r
5024   REAL_ARITH ` &0 <= &4 `; POW2_COND; SQRT8_POW2] THEN \r
5025 CONV_TAC REAL_RAT_REDUCE_CONV THEN \r
5026 REWRITE_TAC[NORM_ARITH` dist (v,u + v - w) = dist (u,w) /\\r
5027   dist (u,u + v - w) = dist (v,w) /\ \r
5028   dist (w,u + v - w) = &2 * dist (w,&1 / &2 % (u + v)) `] THEN \r
5029 STRIP_TAC THEN CONJ_TAC THENL [\r
5030 UNDISCH_TAC `CARD {(u:real^3), v, w} = 3` THEN \r
5031 REWRITE_TAC[CARD3; CARD4; IN_SET3] THEN \r
5032 REWRITE_TAC[DE_MORGAN_THM] THEN DAO THEN \r
5033 STRIP_TAC THEN CONJ_TAC THENL [\r
5034 NHANH (NORM_ARITH`u + v - w = w ==> dist (w,u) = &1 / &2 *  dist (u,v) `) THEN \r
5035 UNDISCH_TAC `dist ((u:real^3),v) < sqrt (&8)` THEN \r
5036  NHANH (LT_SQ8_IMP_LT2 ) THEN DOWN_TAC THEN SET_TAC[];  \r
5037 REWRITE_TAC[VECTOR_ARITH ` ((v:real^N) = u + v - w <=> u = w )`;\r
5038   VECTOR_ARITH ` ((u:real^N) = u + v - w <=> v = w ) `] THEN ASM_MESON_TAC[]]; \r
5039 DAO THEN CONJ_TAC THENL [REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN \r
5040 REAL_ARITH_TAC;DOWN_TAC THEN REWRITE_TAC[CARD3] THEN SET_TAC[]]]);;\r
5041 let MIDDLE_POINT_IN_CONV2 = prove(` &1 / &2 % ( u + v ) IN conv {u,v} `,\r
5042 REWRITE_TAC[CONV_SET2; IN_ELIM_THM; VECTOR_ADD_LDISTRIB] THEN \r
5043 MESON_TAC[REAL_ARITH ` &0 <= &1 / &2 `; REAL_ARITH` &1 / &2 + &1 / &2 = &1 `]);;\r
5044 \r
5045 let INTER_DISJONT_EX = \r
5046 SET_RULE ` ( a INTER b = {} ) <=> (! x. ~ (x IN a /\ x IN b )) `;;\r
5047 \r
5048 \r
5049 (* LEMMA36 *)\r
5050 \r
5051 (* ================== *)\r
5052 let ZZSBSIO = prove(` ! (u:real^3) v w. CARD {u,v,w} = 3 /\ packing {u,v,w} /\\r
5053   dist (u,v) < sqrt8 ==>  dist (u,v) / &2 < dist (w, &1 / &2 % ( u + v )) `,\r
5054 REWRITE_TAC[MESON[]` a ==> b <=> ~ ( a /\ ~ b ) `] THEN \r
5055 NHANH (LE_FOR_LEMMA36) THEN \r
5056 NHANH (SPEC_ALL CXWOCGN) THEN \r
5057 REPEAT STRIP_TAC THEN \r
5058 FIRST_X_ASSUM MP_TAC THEN \r
5059 REWRITE_TAC[INTER_DISJONT_EX] THEN \r
5060 MESON_TAC[MIDDLE_POINT_IN_CONV2 ; VECTOR_ARITH ` \r
5061   u + v = w + u + v - (w:real^N) `]);;\r
5062 \r
5063 \r
5064 \r
5065 \r
5066 MATCH_MP (SPEC_ALL AFFINE_HULL_FINITE) (MESON[FINITE_RULES] ` FINITE {(a:real^N),b,c} `) ;;\r
5067 \r
5068 \r
5069 \r
5070 let PLANE_IMP_AFFINE = prove(`plane (p:real^N -> bool ) ==> affine p `, \r
5071 MESON_TAC[plane; AFFINE_AFFINE_HULL]);;\r
5072 \r
5073 \r
5074 let AFFINE = new_axiom `!V:real^N->bool.\r
5075      affine V <=>\r
5076          !(s:real^N->bool) (u:real^N->real).\r
5077              FINITE s /\ ~(s = {}) /\ s SUBSET V /\ sum s u = &1\r
5078              ==> vsum s (\x. u x % x) IN V`;;\r
5079 \r
5080 \r
5081 let PLANE_IMP_AFFINE = prove(` plane (p:real^N -> bool ) ==> affine p `,\r
5082 REWRITE_TAC[plane; AFFINE_HULL_3; affine; FUN_EQ_THM; IN_ELIM_THM] THEN \r
5083 STRIP_TAC THEN ASM_SIMP_TAC[IN] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN \r
5084 SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN \r
5085 REWRITE_TAC[VECTOR_ARITH` (( a:real^N) + b + c ) + a' + b' + c'\r
5086   = ( a + a' ) + ( b + b') + c + c' `] THEN EXISTS_TAC ` u' * u'' + v' * u''' ` THEN \r
5087 EXISTS_TAC ` (u' * v'' + v' * v''')` THEN EXISTS_TAC ` (u' * w' + v' * w'')` THEN \r
5088 ASM_SIMP_TAC[prove(` u' + v' = &1 /\\r
5089   u''' + v''' + w'' = &1 /\\r
5090   u'' + v'' + w' = &1 ==>\r
5091   (u' * u'' + v' * u''') + (u' * v'' + v' * v''') + u' * w' + v' * w'' = &1 `,\r
5092 SIMP_TAC[REAL_ARITH` a + b = &1 <=> a = &1 - b `] THEN REAL_ARITH_TAC);\r
5093   GSYM VECTOR_ADD_RDISTRIB]);;\r
5094 \r
5095 \r
5096 \r
5097 \r
5098 let IMP_AFFINE_HULL_SUBSET = prove(` FINITE a /\ a SUBSET s /\ \r
5099 ~( a = {} )/\ affine s  ==> ( affine hull a ) SUBSET s `,\r
5100 SIMP_TAC[AFFINE_HULL_FINITE; SUBSET; IN_ELIM_THM] THEN \r
5101 REWRITE_TAC[ GSYM SUBSET] THEN MESON_TAC[AFFINE]);;\r
5102 \r
5103 \r
5104 \r
5105 let SET_EQ_EX = SET_RULE `a = b <=> (! x. x IN a <=> x IN b ) `;;\r
5106 let SET_EQ_TO_SUBSET = SET_RULE ` a = b <=>  a SUBSET b /\ b SUBSET a `;;\r
5107 \r
5108 \r
5109 \r
5110 \r
5111 let OTHORGONAL_QUATER_FOR = prove(` delta x12 ( x12 + x23 ) ( x12 + x24 )  x23 x24 x34 =\r
5112   x12 * ups_x x23 x24 x34 `, REWRITE_TAC[delta; ups_x] THEN REAL_ARITH_TAC);;\r
5113 \r
5114 \r
5115 let ORTHOGONAL_CROSS_PRODUCT = prove(` u dot ( cross u v ) = &0 /\\r
5116   v dot ( cross u v ) = &0 `,\r
5117 REWRITE_TAC[cross; triple_of_real3; real3_of_triple; mk_vec3] THEN\r
5118 LET_TR THEN REWRITE_TAC[DOT_3; VECTOR_3] THEN REAL_ARITH_TAC);;\r
5119 \r
5120 \r
5121 \r
5122 let PITHAGOR_CROSS = prove(` dist (a + cross (b - a) (c - a),b) pow 2 = \r
5123 dist (b,a) pow 2 +  norm ( cross (b - a) (c - a) ) pow 2 `,\r
5124 REWRITE_TAC[vector_norm; dist] THEN\r
5125 SIMP_TAC[DOT_POS_LE; SQRT_WORKS] THEN \r
5126 REWRITE_TAC[VECTOR_ARITH` ((a:real^N) + b) - c = b - (c - a ) `] THEN \r
5127 ABBREV_TAC ` ab = ( b - (a:real^3)) ` THEN \r
5128 ABBREV_TAC ` ac = ( c - (a:real^3)) ` THEN \r
5129 REWRITE_TAC[DOT_LSUB; DOT_RSUB] THEN \r
5130 SIMP_TAC[ORTHOGONAL_CROSS_PRODUCT; DOT_SYM] THEN \r
5131 REAL_ARITH_TAC);;\r
5132 \r
5133 \r
5134 let PITHAGOR_NORM = prove(` a dot b = &0 ==> dist (a,b) pow 2 = norm a pow 2 +\r
5135   norm b pow 2 `,\r
5136 SIMP_TAC[dist; vector_norm; DOT_POS_LE; SQRT_WORKS] THEN \r
5137 SIMP_TAC[DOT_LSUB; DOT_RSUB; DOT_SYM] THEN REAL_ARITH_TAC);;\r
5138 \r
5139 \r
5140 \r
5141 \r
5142 \r
5143 \r
5144 \r
5145 \r
5146 \r
5147 prove(` dist ( cross a b, a ) pow 2  = norm (cross a b) pow 2 + \r
5148   norm a pow 2 /\dist ( cross a b, b ) pow 2  = norm (cross a b) pow 2 + \r
5149   norm b pow 2 `, \r
5150 SIMP_TAC[DOT_SYM;ORTHOGONAL_CROSS_PRODUCT ; PITHAGOR_NORM; DIST_SYM]);;\r
5151 \r
5152 \r
5153 \r
5154 \r
5155 \r
5156 \r
5157 \r
5158 \r
5159 let VEC3_EQ_EX= prove(`! a (b:real^3). a = b <=> a$1 = b$1 /\ a$2 = b$2 /\ a$3 = b$3 `,\r
5160 SIMP_TAC[CART_EQ; DIMINDEX_3] THEN \r
5161 REWRITE_TAC[ARITH_RULE`1 <= i /\ i <= 3 <=>\r
5162   i = 1 \/ i = 2 \/ i = 3 `] THEN MESON_TAC[]);;\r
5163 \r
5164 \r
5165 g ` cross (b - a) (c - d) = cross (a - b) (d - c )`;;\r
5166 e (REWRITE_TAC[cross; triple_of_real3; real3_of_triple; mk_vec3]);;\r
5167 e (LET_TR);;\r
5168 e (REWRITE_TAC[lemma_cm3 ]);;\r
5169 e (REWRITE_TAC[VEC3_EQ_EX]);;\r
5170 e (REWRITE_TAC[VEC3_EQ_EX; VECTOR_3]);;\r
5171 e (REAL_ARITH_TAC);;\r
5172 let CROSS_CONVERT = top_thm();;\r
5173 \r
5174 \r
5175 \r
5176 g ` &4 * norm (cross (b - a) (c - a)) pow 2 =\r
5177   ups_x (dist (a,b) pow 2) (dist (a,c) pow 2) (dist (b,c) pow 2)`;;\r
5178 e (REWRITE_TAC[MESON[\r
5179 prove(` dist(b,c) pow 2 = (a - c - (a - b)) dot (a - c - (a - b)) `,\r
5180 SIMP_TAC[dist; vector_norm; DOT_POS_LE; SQRT_WORKS] THEN \r
5181 MESON_TAC[VECTOR_ARITH` b - (c:real^N) = (a - c) - ( a - b) `])]`\r
5182   ups_x  aa bb (dist (b,c) pow 2 ) = \r
5183   ups_x aa bb (( a - c - (a - b)) dot (a - c - (a - b))) `]);;\r
5184 e (ONCE_REWRITE_TAC[CROSS_CONVERT]);;\r
5185 e (SIMP_TAC[ups_x;DIST_SYM; dist; vector_norm; DOT_POS_LE; SQRT_WORKS]);;\r
5186 e (REWRITE_TAC[cross; triple_of_real3; real3_of_triple; mk_vec3]);;\r
5187 e (LET_TR);;\r
5188 e (REWRITE_TAC[DOT_3; VECTOR_3]);;\r
5189 e (ABBREV_TAC ` ab = a - (b:real^3) `);;\r
5190 e (ABBREV_TAC ` cc = a - (c:real^3) `);;\r
5191 e (REWRITE_TAC[lemma_cm3 ] THEN REAL_ARITH_TAC);;\r
5192 \r
5193 let NORM_CROSS_PRODUCT_UPS_X = top_thm();;\r
5194 \r
5195 \r
5196 g ` ! u v (w:real^3). ~ collinear {a,b,c} ==> ~ coplanar {\r
5197   a + cross (b - a ) ( c - a ),a,b,c} `;;\r
5198 e (MP_TAC POLFLZY);;\r
5199 e (LET_TR);;\r
5200 e (SIMP_TAC[]);;\r
5201 e (DISCH_TAC);;\r
5202 e (REWRITE_TAC[NORM_ARITH` dist (a + b ,a) = norm (b ) `]);;\r
5203 e (REWRITE_TAC[NORM_ARITH`dist (a + c,b) =\r
5204   dist ( c, b - a ) `]);;\r
5205 e (SIMP_TAC[prove(` dist ( cross a b, a ) pow 2  = norm (cross a b) pow 2 + \r
5206   norm a pow 2 /\dist ( cross a b, b ) pow 2  = norm (cross a b) pow 2 + \r
5207   norm b pow 2 `, \r
5208 SIMP_TAC[DOT_SYM;ORTHOGONAL_CROSS_PRODUCT ; PITHAGOR_NORM; DIST_SYM])]);;\r
5209 e (REWRITE_TAC[GSYM dist]);;\r
5210 e (SIMP_TAC[DIST_SYM; OTHORGONAL_QUATER_FOR]);;\r
5211 e (ONCE_REWRITE_TAC[REAL_ARITH` a * b = &0 <=> ( &4 * a ) * b = &0 `]);;\r
5212 e (SIMP_TAC[NORM_CROSS_PRODUCT_UPS_X]);;\r
5213 e (REWRITE_TAC[REAL_ENTIRE]);;\r
5214 e (MESON_TAC[FHFMKIY]);;\r
5215 let NOT_COLLINEAR_IMP_CROSS_NOT_COPLANAR = top_thm();;\r
5216 \r
5217 \r
5218 \r
5219 \r
5220 let ORTHOGONAL_IMP_PITHAGOR = prove(` (x:real^N) dot ((a:real^N) - b) = &0 ==>\r
5221   dist (a + x,b) pow 2 = norm x pow 2 + dist (a,b) pow 2`,\r
5222 SIMP_TAC[dist; vector_norm; DOT_POS_LE; SQRT_WORKS] THEN \r
5223 REWRITE_TAC[VECTOR_ARITH` (a + c) - b = c + a - (b:real^N)`] THEN \r
5224 ABBREV_TAC ` aa = ( a - (b:real^N)) ` THEN \r
5225 SIMP_TAC[DOT_LADD; DOT_RADD; DOT_SYM; ZERO_NEUTRAL]);;\r
5226 \r
5227 \r
5228 \r
5229 let NOT_COL_AND_ORTHO_IMP_NOT_COPL = prove(`! a b c (x:real^3).\r
5230  ~collinear {a, b, c} /\ x dot (a - b) = &0 /\\r
5231  x dot (a - c) = &0 /\ ~(x = vec 0)\r
5232  ==> ~coplanar {a + x, a, b, c}`,\r
5233 MP_TAC POLFLZY THEN LET_TR THEN SIMP_TAC[] THEN \r
5234 SIMP_TAC[ORTHOGONAL_IMP_PITHAGOR ] THEN \r
5235 SIMP_TAC[ORTHOGONAL_IMP_PITHAGOR; NORM_ARITH ` dist (a + x,a) = norm x `] THEN \r
5236 SIMP_TAC[ORTHOGONAL_IMP_PITHAGOR; NORM_ARITH ` dist (a + x,a) = norm x `;\r
5237 OTHORGONAL_QUATER_FOR] THEN SIMP_TAC[COL_EQ_UPS_0] THEN \r
5238 SIMP_TAC[COL_EQ_UPS_0; GSYM NORM_POS_LT; REAL_ENTIRE; MESON[RELATE_POW2]`\r
5239   a pow 2 = &0 <=> a = &0 `; REAL_ARITH ` &0 < a ==> ~( a = &0 ) `]);;\r
5240 \r
5241 \r
5242 \r
5243 \r
5244 \r
5245 let PLANE_NORM_IMP_AFFINE = prove(`! p. plane_norm p ==> affine p `,\r
5246 REWRITE_TAC[plane_norm; affine] THEN GEN_TAC THEN STRIP_TAC THEN \r
5247 ASM_SIMP_TAC[IN_ELIM_THM;  MESON[]` a = &1 <=> &1 = a `] THEN \r
5248 ONCE_REWRITE_TAC[ VECTOR_ARITH ` ( a + b ) - c = ( a + b ) - &1 % c `] THEN \r
5249 ASM_SIMP_TAC[ VECTOR_ARITH` (u % x + v % y) - (u + v) % v0 = \r
5250 u % ( x - v0 ) +  v % ( y - v0 ) `; DOT_RADD; DOT_RMUL; ZERO_NEUTRAL]);;\r
5251 \r
5252 \r
5253 \r
5254 \r
5255 let IN_PLANE_IMP_OTHORGONAL = prove(`\r
5256  n dot (x - v0) = &0 /\ n dot (y - v0) = &0 /\ n dot (z - v0) = &0 ==>\r
5257   n dot ( x - y ) = &0 /\ n dot ( x - z ) = &0 `,\r
5258 SIMP_TAC[DOT_RSUB] THEN REAL_ARITH_TAC);;\r
5259 \r
5260 \r
5261 \r
5262 \r
5263  g `(n:real^N) dot (x - v0) = &0 /\\r
5264  n dot (y - v0) = &0 /\\r
5265  n dot (z - v0) = &0 /\\r
5266  ~(n = vec 0) /\\r
5267  x' = a1 % (x + n) + a2 % x + a3 % y + a4 % z /\\r
5268  a1 + a2 + a3 + a4 = &1 /\\r
5269  n dot (x' - v0) = &0\r
5270  ==> a1 = &0`;;\r
5271 e (STRIP_TAC);;\r
5272 e (UNDISCH_TAC ` (n:real^N) dot (x' - v0) = &0`);;\r
5273 e (ASM_SIMP_TAC[VECTOR_ARITH`(a1 % x + y ) - v0 = a1 % ( x - v0 ) + y - v0 + a1 % v0 `]);;\r
5274 e (ONCE_REWRITE_TAC[ VECTOR_ARITH` a % x - y =\r
5275   a % ( x - y ) + a % y - y `]);;\r
5276 e (ASM_SIMP_TAC[DOT_RADD; VECTOR_ARITH` ( a + b ) - (c:real^N) \r
5277   = b + a - c `; DOT_RMUL; ZERO_NEUTRAL]);;\r
5278 e (ASM_SIMP_TAC[DOT_RADD; VECTOR_ARITH` ( a + b ) - (c:real^N) \r
5279   = b + a - c `; DOT_RMUL; ZERO_NEUTRAL; DOT_RSUB;\r
5280 REAL_ARITH` ((a4 * (n dot v0) - n dot v0 + a3 * (n dot v0)) + a2 * (n dot v0)) +\r
5281  a1 * (n dot v0) = ( a1 + a2 + a3 + a4 ) * ( n dot v0 ) - n dot v0 `;\r
5282   REAL_ARITH ` &1 * a - a = &0 `]);;\r
5283 e (ASM_MESON_TAC[REAL_ENTIRE; GSYM DOT_EQ_0]);;\r
5284 let IMP_A1_EQ_0 = top_thm();;\r
5285 \r
5286 \r
5287 \r
5288 \r
5289 \r
5290 let LEMMA7 = prove(` !x y z (p:real^3 -> bool).\r
5291          plane_norm p /\ ~collinear {x, y, z} /\ {x, y, z} SUBSET p\r
5292          ==> p = aff {x, y, z}`,\r
5293 NHANH (PLANE_IMP_AFFINE) THEN \r
5294 REPEAT STRIP_TAC THEN \r
5295 REWRITE_TAC[aff; SET_EQ_TO_SUBSET] THEN CONJ_TAC THENL [\r
5296 UNDISCH_TAC ` plane_norm (p:real^3 -> bool ) ` THEN \r
5297 REWRITE_TAC[plane_norm] THEN \r
5298 STRIP_TAC THEN \r
5299 UNDISCH_TAC ` {(x:real^3), y, z} SUBSET p` THEN \r
5300 ASM_SIMP_TAC[SET3_SUBSET; IN_ELIM_THM] THEN \r
5301 NHANH (IN_PLANE_IMP_OTHORGONAL ) THEN \r
5302 DOWN_TAC THEN \r
5303 NHANH (MESON[NOT_COL_AND_ORTHO_IMP_NOT_COPL]`\r
5304   ~collinear {(x:real^3), y, z} /\\r
5305  ~(n = vec 0) /\a1 /\a2 /\a4 /\a3/\\r
5306  n dot (x - y) = &0 /\\r
5307  n dot (x - z) = &0 ==> ~coplanar { x + n ,x,y,z} `) THEN \r
5308 REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN \r
5309 REPEAT STRIP_TAC THEN \r
5310 UNDISCH_TAC `~coplanar {x + n, x, y, (z:real^3)} ` THEN \r
5311 NHANH (SPEC `x' :real^3` (GEN `v :real^3` ( SPEC_ALL COEFS_4 ))) THEN \r
5312 ABBREV_TAC ` a1 = COEF4_1 (x + n) x y z x'` THEN \r
5313 ABBREV_TAC ` a2 = COEF4_2 (x + n) x y z x'` THEN \r
5314 ABBREV_TAC ` a3 = COEF4_3 (x + n) x y z x'` THEN \r
5315 ABBREV_TAC ` a4 = COEF4_4 (x + n) x y z x'` THEN \r
5316 STRIP_TAC THEN \r
5317 DOWN_TAC THEN \r
5318 REWRITE_TAC[AFFINE_HULL_3; IN_ELIM_THM] THEN \r
5319 NHANH (MESON[IMP_A1_EQ_0]` ~(n = vec 0) /\\r
5320  aa1 /\\r
5321  n dot (x - v0) = &0 /\\r
5322  n dot (y - v0) = &0 /\\r
5323  n dot (z - v0) = &0 /\\r
5324  aa2 /\aa3 /\\r
5325  n dot (x' - v0) = &0 /\aa4/\aa5 /\aa6/\aa7/\\r
5326  ~coplanar {x + n, x, y, z} /\\r
5327  a1 + a2 + a3 + a4 = &1 /\\r
5328  x' = a1 % (x + n) + a2 % x + a3 % y + a4 % z /\ l ==>\r
5329   a1 = &0 `) THEN \r
5330 PURE_ONCE_REWRITE_TAC[MESON[]` P a1 /\ a1 = &0 <=> P (&0) /\\r
5331   a1 = &0 `] THEN \r
5332 REWRITE_TAC[ZERO_NEUTRAL; VECTOR_ARITH` &0 % x + y = y `] THEN \r
5333 MESON_TAC[];\r
5334 ASM_MESON_TAC[PLANE_NORM_IMP_AFFINE ; FINITE_RULES; \r
5335 SET_RULE` ~({(x:real^N), y, z} = {} )`;  IMP_AFFINE_HULL_SUBSET]]);;\r
5336 \r
5337 let SMWTDMU = LEMMA7;;\r
5338 \r
5339 \r
5340 g ` det_vec3 v1 v2 v3 = ( cross v1 v2 ) dot v3 `;;\r
5341 e (REWRITE_TAC[det_vec3; cross; triple_of_real3;\r
5342   real3_of_triple; mk_vec3; DOT_3; VECTOR_3]);;\r
5343 e (LET_TR);;\r
5344 e (REWRITE_TAC[det_vec3; cross; triple_of_real3;\r
5345   real3_of_triple; mk_vec3; DOT_3; VECTOR_3]);;\r
5346 e (REAL_ARITH_TAC);;\r
5347 let DET_VEC3_AS_CROSS_DOT = top_thm();;\r
5348 \r
5349 \r
5350 \r
5351 g ` ! v1 v2 (v3:real^3). collinear {v1,v2,v3} <=>\r
5352  norm (cross (v2 - v1) (v3 - v1)) pow 2 = &0 `;;\r
5353 e (REWRITE_TAC[COL_EQ_UPS_0]);;\r
5354 e (REWRITE_TAC[GSYM NORM_CROSS_PRODUCT_UPS_X]);;\r
5355 e (REAL_ARITH_TAC);;\r
5356 let COL_EQ_NORM_CROSS = top_thm();;\r
5357 \r
5358 let COLLINEAR_IMP_COPLANAR = prove(` ! v1 v2 v3 v3 (v:real^3). collinear {v1,v2,v3} ==>\r
5359 coplanar {v1,v2,v3,v} `,\r
5360 REWRITE_TAC[COPLANAR_DET_VEC3_EQ_0; COL_EQ_NORM_CROSS; DET_VEC3_AS_CROSS_DOT ] THEN \r
5361 REWRITE_TAC[GSYM RELATE_POW2; NORM_EQ_0] THEN REPEAT GEN_TAC THEN \r
5362 SIMP_TAC[VECTOR_ARITH ` vec 0 dot x = &0 `]);;\r
5363 \r
5364 (* MAY WORKS, LEMMA 85 ; VBVYGGT *)\r
5365 \r
5366 \r
5367 \r
5368 \r
5369 let POS_EQ_NOT_COPLANANR = prove(` &0 <   delta (dist ((x1:real^3),x2) pow 2) (dist (x1,x3) pow 2)\r
5370            (dist (x1,x4) pow 2)\r
5371            (dist (x2,x3) pow 2)\r
5372            (dist (x2,x4) pow 2)\r
5373            (dist (x3,x4) pow 2) <=> ~coplanar {x1, x2, x3, x4} `,\r
5374 MP_TAC (DELTA_POS_4POINTS) THEN MP_TAC POLFLZY THEN LET_TR THEN \r
5375 REWRITE_TAC[REAL_ARITH` a <= b <=> a = b \/ a < b `] THEN \r
5376 MESON_TAC[REAL_ARITH` ~( a = b /\ a < b ) `]);;\r
5377 \r
5378 let SUM_CHI_EQ_2DELTA = prove(` let chi11 = chi x12 x13 x14 x23 x24 x34 in\r
5379  let chi22 = chi x12 x24 x23 x14 x13 x34 in\r
5380  let chi33 = chi x34 x13 x23 x14 x24 x12 in\r
5381  let chi44 = chi x34 x24 x14 x23 x13 x12 in\r
5382  &2 * delta x12 x13 x14 x23 x24 x34 = chi11 + chi22 + chi33 + chi44`, LET_TR THEN \r
5383 REWRITE_TAC[chi; delta] THEN REAL_ARITH_TAC);;\r
5384 \r
5385 let NOT_0_IMP_SUM_CHI_1 = prove(`~(delta x12 x13 x14 x23 x24 x34 = &0)\r
5386  ==> chi x12 x13 x14 x23 x24 x34 / (&2 * delta x12 x13 x14 x23 x24 x34) +\r
5387      chi x12 x24 x23 x14 x13 x34 / (&2 * delta x12 x13 x14 x23 x24 x34) +\r
5388      chi x34 x13 x23 x14 x24 x12 / (&2 * delta x12 x13 x14 x23 x24 x34) +\r
5389      chi x34 x24 x14 x23 x13 x12 / (&2 * delta x12 x13 x14 x23 x24 x34) =\r
5390      &1`, MP_TAC SUM_CHI_EQ_2DELTA THEN \r
5391 LET_TR THEN CONV_TAC REAL_FIELD);;\r
5392 \r
5393 (* MAY WORKS *)\r
5394 \r
5395 let PROVE_DIST_FROM_V1 = prove(` ~coplanar {v1, v2, v3, v4} ==>\r
5396 let x12 = dist (v1,v2) pow 2 in\r
5397  let x13 = dist (v1,v3) pow 2 in\r
5398  let x14 = dist (v1,v4) pow 2 in\r
5399  let x23 = dist (v2,v3) pow 2 in\r
5400  let x24 = dist (v2,v4) pow 2 in\r
5401  let x34 = dist (v3,v4) pow 2 in\r
5402  let chi11 = chi x12 x13 x14 x23 x24 x34 in\r
5403  let chi22 = chi x12 x24 x23 x14 x13 x34 in\r
5404  let chi33 = chi x34 x13 x23 x14 x24 x12 in\r
5405  let chi44 = chi x34 x24 x14 x23 x13 x12 in\r
5406  p =\r
5407  &1 / (&2 * delta x12 x13 x14 x23 x24 x34) %\r
5408  (chi11 % v1 + chi22 % v2 + chi33 % v3 + chi44 % v4)\r
5409  ==> d3 p v1 pow 2 =\r
5410     ( &1 / &2 ) * rho x12 x13 x14 x23 x24 x34 / (&2 * delta x12 x13 x14 x23 x24 x34) `,\r
5411 REWRITE_TAC[ GSYM POS_EQ_NOT_COPLANANR] THEN \r
5412 NHANH (REAL_ARITH` a < b ==> ~( b = a ) `) THEN \r
5413 NHANH NOT_0_IMP_SUM_CHI_1  THEN \r
5414 LET_TR THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC;\r
5415   REAL_ARITH` ( &1 / a ) * b = b / a `] THEN \r
5416 ABBREV_TAC ` a1 = chi (dist (v1,v2) pow 2) (dist (v1,v3) pow 2) (dist (v1,v4) pow 2)\r
5417      (dist (v2,v3) pow 2)\r
5418      (dist (v2,v4) pow 2)\r
5419      (dist (v3,v4) pow 2) /\r
5420      (&2 *\r
5421       delta (dist (v1,v2) pow 2) (dist (v1,v3) pow 2) (dist (v1,v4) pow 2)\r
5422       (dist (v2,v3) pow 2)\r
5423       (dist (v2,v4) pow 2)\r
5424       (dist (v3,(v4:real^3)) pow 2))` THEN \r
5425 ABBREV_TAC ` a2 = chi (dist (v1,v2) pow 2) (dist (v2,v4) pow 2) (dist (v2,v3) pow 2)\r
5426      (dist (v1,v4) pow 2)\r
5427      (dist (v1,v3) pow 2)\r
5428      (dist (v3,v4) pow 2) /\r
5429      (&2 *\r
5430       delta (dist (v1,v2) pow 2) (dist (v1,v3) pow 2) (dist (v1,v4) pow 2)\r
5431       (dist (v2,v3) pow 2)\r
5432       (dist (v2,v4) pow 2)\r
5433       (dist (v3,(v4:real^3)) pow 2)) ` THEN \r
5434 REWRITE_TAC[ GSYM d3] THEN \r
5435 ABBREV_TAC ` a3 = chi (d3 v3 v4 pow 2) (d3 v1 v3 pow 2) (d3 v2 v3 pow 2) (d3 v1 v4 pow 2)\r
5436      (d3 v2 v4 pow 2)\r
5437      (d3 v1 v2 pow 2) /\r
5438      (&2 *\r
5439       delta (d3 v1 v2 pow 2) (d3 v1 v3 pow 2) (d3 v1 v4 pow 2)\r
5440       (d3 v2 v3 pow 2)\r
5441       (d3 v2 v4 pow 2)\r
5442       (d3 v3 v4 pow 2)) ` THEN \r
5443 ABBREV_TAC ` a4 = chi (d3 v3 v4 pow 2) (d3 v2 v4 pow 2) (d3 v1 v4 pow 2) (d3 v2 v3 pow 2)\r
5444      (d3 v1 v3 pow 2)\r
5445      (d3 v1 v2 pow 2) /\r
5446      (&2 *\r
5447       delta (d3 v1 v2 pow 2) (d3 v1 v3 pow 2) (d3 v1 v4 pow 2)\r
5448       (d3 v2 v3 pow 2)\r
5449       (d3 v2 v4 pow 2)\r
5450       (d3 v3 v4 pow 2)) ` THEN \r
5451 SIMP_TAC[REAL_ARITH` a + b = &1 <=> a = &1 - b `] THEN \r
5452 REPEAT STRIP_TAC THEN \r
5453 REWRITE_TAC[d3; dist; NORM_POW_2; VECTOR_ARITH` \r
5454   (((&1 - (a2 + a3 + a4)) % v1 + a2 % v2 + a3 % v3 + a4 % v4) - v1) =\r
5455   a2 % ( v2 - v1 ) + a3 % (v3 - v1 ) + a4 % ( v4 - v1 ) `;\r
5456   VECTOR_ARITH` ( a + b ) dot ( a + b ) = a dot a + &2 * ( a dot b )\r
5457   + b dot b `] THEN \r
5458 REWRITE_TAC[DOT_RADD; DOT_LMUL; DOT_RMUL] THEN \r
5459 REWRITE_TAC[X_DOT_X_EQ] THEN \r
5460 REWRITE_TAC[DOT_NORM_NEG; VECTOR_ARITH` v2 - v1 - (v4 - v1)\r
5461   = (v2:real^N) - v4 `] THEN \r
5462 SIMP_TAC[GSYM dist; DIST_SYM; GSYM d3; D3_SYM] THEN \r
5463 EXPAND_TAC "a2" THEN \r
5464 EXPAND_TAC "a3" THEN \r
5465 EXPAND_TAC "a4" THEN \r
5466 REWRITE_TAC[GSYM d3 ] THEN \r
5467 ABBREV_TAC ` x12 = d3 v1 v2 pow 2 ` THEN \r
5468 ABBREV_TAC ` x13 = d3 v1 v3 pow 2 ` THEN \r
5469 ABBREV_TAC ` x14 = d3 v1 v4 pow 2 ` THEN \r
5470 ABBREV_TAC ` x23 = d3 v2 v3 pow 2 ` THEN \r
5471 ABBREV_TAC ` x24 = d3 v2 v4 pow 2 ` THEN \r
5472 ABBREV_TAC ` x34 = d3 v3 v4 pow 2 ` THEN \r
5473 UNDISCH_TAC ` &0 < delta x12 x13 x14 x23 x24 x34 ` THEN \r
5474 ONCE_REWRITE_TAC[REAL_FIELD` &0 < a ==> b = c <=> &0 < a\r
5475  ==> b * ( &2 * a) pow 2 = c * ( &2 * a ) pow 2 `] THEN \r
5476 ONCE_REWRITE_TAC[REAL_ARITH` &0 < a <=> &0 < &2 * a `] THEN \r
5477 SIMP_TAC[REAL_FIELD` &0 < b ==> ( a / b ) * b pow 2 = a * b `;\r
5478   REAL_RDISTRIB; REAL_FIELD` &0 < b ==> ( a / b ) * ( aa / b ) * c * \r
5479 b pow 2 = a * aa * c `; REAL_ADD_LDISTRIB] THEN \r
5480 SIMP_TAC[REAL_LDISTRIB; REAL_ARITH` (a*b)*c = a *b * c `;\r
5481   REAL_FIELD` &0 < b ==> ( a / b ) * ( a / b ) * c * b pow 2 = a pow 2 * c `;\r
5482   REAL_ARITH` &2 * a * b * c / &2 * d = a * b * d * c `] THEN \r
5483 SIMP_TAC[REAL_FIELD` &0 < a ==> ( b / a ) * ( bb / a ) * a pow 2 \r
5484   * d = b * bb * d `] THEN \r
5485 SIMP_TAC[REAL_FIELD` &0 < a ==> b / a / &2 * a pow 2 =\r
5486   a * b / &2 `] THEN \r
5487 REWRITE_TAC[chi; rho; delta] THEN \r
5488 REAL_ARITH_TAC);;\r
5489 \r
5490 \r
5491 \r
5492 let PROVE_EQ_DIST_FROM4 = prove(` ~coplanar {v1, v2, v3, v4} ==>\r
5493 let x12 = dist (v1,v2) pow 2 in\r
5494  let x13 = dist (v1,v3) pow 2 in\r
5495  let x14 = dist (v1,v4) pow 2 in\r
5496  let x23 = dist (v2,v3) pow 2 in\r
5497  let x24 = dist (v2,v4) pow 2 in\r
5498  let x34 = dist (v3,v4) pow 2 in\r
5499  let chi11 = chi x12 x13 x14 x23 x24 x34 in\r
5500  let chi22 = chi x12 x24 x23 x14 x13 x34 in\r
5501  let chi33 = chi x34 x13 x23 x14 x24 x12 in\r
5502  let chi44 = chi x34 x24 x14 x23 x13 x12 in\r
5503  p =\r
5504  &1 / (&2 * delta x12 x13 x14 x23 x24 x34) %\r
5505  (chi11 % v1 + chi22 % v2 + chi33 % v3 + chi44 % v4)\r
5506 ==>\r
5507 d3 p v2 pow 2 = ( &1 / &2 ) * rho x12 x13 x14 x23 x24 x34 / (&2 * delta x12 x13 x14 x23 x24 x34) /\\r
5508 d3 p v3 pow 2 = ( &1 / &2 ) * rho x12 x13 x14 x23 x24 x34 / (&2 * delta x12 x13 x14 x23 x24 x34) /\\r
5509 d3 p v4 pow 2 =\r
5510  ( &1 / &2 ) * rho x12 x13 x14 x23 x24 x34 / (&2 * delta x12 x13 x14 x23 x24 x34)  `,\r
5511 REWRITE_TAC[ GSYM POS_EQ_NOT_COPLANANR] THEN \r
5512 NHANH (REAL_ARITH` a < b ==> ~( b = a ) `) THEN \r
5513 NHANH NOT_0_IMP_SUM_CHI_1  THEN \r
5514 LET_TR THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC;\r
5515   REAL_ARITH` ( &1 / a ) * b = b / a `] THEN \r
5516 ABBREV_TAC ` a1 = chi (dist (v1,v2) pow 2) (dist (v1,v3) pow 2) (dist (v1,v4) pow 2)\r
5517      (dist (v2,v3) pow 2)\r
5518      (dist (v2,v4) pow 2)\r
5519      (dist (v3,v4) pow 2) /\r
5520      (&2 *\r
5521       delta (dist (v1,v2) pow 2) (dist (v1,v3) pow 2) (dist (v1,v4) pow 2)\r
5522       (dist (v2,v3) pow 2)\r
5523       (dist (v2,v4) pow 2)\r
5524       (dist (v3,(v4:real^3)) pow 2))` THEN \r
5525 ABBREV_TAC ` a2 = chi (dist (v1,v2) pow 2) (dist (v2,v4) pow 2) (dist (v2,v3) pow 2)\r
5526      (dist (v1,v4) pow 2)\r
5527      (dist (v1,v3) pow 2)\r
5528      (dist (v3,v4) pow 2) /\r
5529      (&2 *\r
5530       delta (dist (v1,v2) pow 2) (dist (v1,v3) pow 2) (dist (v1,v4) pow 2)\r
5531       (dist (v2,v3) pow 2)\r
5532       (dist (v2,v4) pow 2)\r
5533       (dist (v3,(v4:real^3)) pow 2)) ` THEN \r
5534 REWRITE_TAC[ GSYM d3] THEN \r
5535 ABBREV_TAC ` a3 = chi (d3 v3 v4 pow 2) (d3 v1 v3 pow 2) (d3 v2 v3 pow 2) (d3 v1 v4 pow 2)\r
5536      (d3 v2 v4 pow 2)\r
5537      (d3 v1 v2 pow 2) /\r
5538      (&2 *\r
5539       delta (d3 v1 v2 pow 2) (d3 v1 v3 pow 2) (d3 v1 v4 pow 2)\r
5540       (d3 v2 v3 pow 2)\r
5541       (d3 v2 v4 pow 2)\r
5542       (d3 v3 v4 pow 2)) ` THEN \r
5543 ABBREV_TAC ` a4 = chi (d3 v3 v4 pow 2) (d3 v2 v4 pow 2) (d3 v1 v4 pow 2) (d3 v2 v3 pow 2)\r
5544      (d3 v1 v3 pow 2)\r
5545      (d3 v1 v2 pow 2) /\r
5546      (&2 *\r
5547       delta (d3 v1 v2 pow 2) (d3 v1 v3 pow 2) (d3 v1 v4 pow 2)\r
5548       (d3 v2 v3 pow 2)\r
5549       (d3 v2 v4 pow 2)\r
5550       (d3 v3 v4 pow 2)) ` THEN \r
5551 ONCE_REWRITE_TAC[MESON[VECTOR_ARITH` &1 % x = x `]` d3 a b pow 2 =\r
5552   aa <=> d3 a ( &1 % b ) pow 2 = aa `] THEN \r
5553 ONCE_REWRITE_TAC[MESON[]` a = &1 <=> &1 = a `] THEN \r
5554 SIMP_TAC[] THEN \r
5555 STRIP_TAC THEN STRIP_TAC THEN \r
5556 REWRITE_TAC[d3; dist] THEN \r
5557 REWRITE_TAC[VECTOR_ARITH` (a1 % v1 + a2 % v2 + a3 % v3 + a4 % v4) - (a1 + a2 + a3 + a4) % v2\r
5558   = a1 % ( v1 - v2 ) + a3 % ( v3 - v2 ) + a4 % (v4 - v2 ) `;\r
5559   VECTOR_ARITH` (a1 % v1 + a2 % v2 + a3 % v3 + a4 % v4) - (a1 + a2 + a3 + a4) % v3\r
5560   = a1 % ( v1 - v3 ) + a2 % ( v2 - v3 ) + a4 % (v4 - v3 )`;\r
5561   VECTOR_ARITH` (a1 % v1 + a2 % v2 + a3 % v3 + a4 % v4) - (a1 + a2 + a3 + a4) % v4 =\r
5562   a1 % ( v1 - v4 ) + a2 % ( v2 - v4 ) + a3 % (v3 - v4 )`] THEN \r
5563 REWRITE_TAC[NORM_POW_2] THEN \r
5564 REWRITE_TAC[DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL; GSYM NORM_POW_2] THEN \r
5565 REWRITE_TAC[DOT_NORM_NEG; VECTOR_ARITH` v3 - v4 - (v2 - v4) =\r
5566   (v3:real^N) - v2 `; GSYM dist; GSYM d3 ] THEN \r
5567 EXPAND_TAC "a1" THEN \r
5568 EXPAND_TAC "a2" THEN \r
5569 EXPAND_TAC "a3" THEN \r
5570 EXPAND_TAC "a4" THEN \r
5571 REWRITE_TAC[GSYM d3 ] THEN \r
5572 REWRITE_TAC[prove(` d3 (v4 - v3) (v1 - v3) = d3 v1 v4 `, \r
5573 REWRITE_TAC[d3] THEN CONV_TAC NORM_ARITH)] THEN \r
5574 SIMP_TAC[D3_SYM] THEN \r
5575 ABBREV_TAC ` x12 = d3 v1 v2 pow 2 ` THEN \r
5576 ABBREV_TAC ` x13 = d3 v1 v3 pow 2 ` THEN \r
5577 ABBREV_TAC ` x14 = d3 v1 v4 pow 2 ` THEN \r
5578 ABBREV_TAC ` x23 = d3 v2 v3 pow 2 ` THEN \r
5579 ABBREV_TAC ` x24 = d3 v2 v4 pow 2 ` THEN \r
5580 ABBREV_TAC ` x34 = d3 v3 v4 pow 2 ` THEN \r
5581 UNDISCH_TAC ` &0 < delta x12 x13 x14 x23 x24 x34 ` THEN \r
5582 ONCE_REWRITE_TAC[REAL_FIELD` &0 < a ==> ( b = c ) /\ ( bb = cc ) /\ ( bbb = ccc ) \r
5583 <=> &0 < a\r
5584  ==> ( b * ( &2 * a) pow 2 = c * ( &2 * a ) pow 2 ) /\\r
5585 ( bb * ( &2 * a) pow 2 = cc * ( &2 * a ) pow 2 ) /\\r
5586 ( bbb * ( &2 * a) pow 2 = ccc * ( &2 * a ) pow 2 ) `] THEN \r
5587 ONCE_REWRITE_TAC[REAL_ARITH` &0 < a <=> &0 < &2 * a `] THEN \r
5588 SIMP_TAC[REAL_FIELD` &0 < b ==> ( a / b ) * b pow 2 = a * b `;\r
5589   REAL_RDISTRIB; REAL_FIELD` &0 < b ==> ( a / b ) * ( aa / b ) * c * \r
5590 b pow 2 = a * aa * c `; REAL_ADD_LDISTRIB] THEN \r
5591 SIMP_TAC[REAL_LDISTRIB; REAL_ARITH` (a*b)*c = a *b * c `;\r
5592   REAL_FIELD` &0 < b ==> ( a / b ) * ( a / b ) * c * b pow 2 = a pow 2 * c `;\r
5593   REAL_ARITH` &2 * a * b * c / &2 * d = a * b * d * c `] THEN \r
5594 SIMP_TAC[REAL_FIELD` &0 < a ==> ( b / a ) * ( bb / a ) * a pow 2 \r
5595   * d = b * bb * d `] THEN \r
5596 SIMP_TAC[REAL_FIELD` &0 < a ==> b / a / &2 * a pow 2 =\r
5597   a * b / &2 `] THEN SIMP_TAC[REAL_FIELD` &0 < b ==> ( a / b ) * b pow 2 = a * b `;\r
5598   REAL_RDISTRIB; REAL_FIELD` &0 < b ==> ( a / b ) * ( aa / b ) * c * \r
5599 b pow 2 = a * aa * c `; REAL_ADD_LDISTRIB] THEN \r
5600 SIMP_TAC[REAL_LDISTRIB; REAL_ARITH` (a*b)*c = a *b * c `;\r
5601   REAL_FIELD` &0 < b ==> ( a / b ) * ( a / b ) * c * b pow 2 = a pow 2 * c `;\r
5602   REAL_ARITH` &2 * a * b * c / &2 * d = a * b * d * c `] THEN \r
5603 SIMP_TAC[REAL_FIELD` &0 < a ==> ( b / a ) * ( bb / a ) * a pow 2 \r
5604   * d = b * bb * d `] THEN \r
5605 SIMP_TAC[REAL_FIELD` &0 < a ==> b / a / &2 * a pow 2 =\r
5606   a * b / &2 `] THEN \r
5607 DISCH_TAC THEN REWRITE_TAC[chi; rho; delta] THEN \r
5608 REAL_ARITH_TAC);;\r
5609 \r
5610 \r
5611 \r
5612 (* the following lemma is in Multivariate/convex.ml *)\r
5613 let AFFINE_HULL_FINITE_STEP = new_axiom\r
5614 `((?u. sum {} u = w /\ vsum {} (\x. u(x) % x) = y) <=>\r
5615     w = &0 /\ y = vec 0) /\\r
5616    (FINITE(s:real^N->bool)\r
5617     ==> ((?u. sum (a INSERT s) u = w /\\r
5618               vsum (a INSERT s) (\x. u(x) % x) = y) <=>\r
5619          ?v u.  sum s u = w - v /\\r
5620                 vsum s (\x. u(x) % x) = y - v % a))`;;\r
5621 \r
5622 let AFFINE_HULL_3 = prove\r
5623  (`affine hull {a,b,c} =\r
5624     { u % a + v % b + w % c | u + v + w = &1}`,\r
5625   SIMP_TAC[AFFINE_HULL_FINITE; FINITE_INSERT; FINITE_RULES] THEN\r
5626   SIMP_TAC[AFFINE_HULL_FINITE_STEP; FINITE_INSERT; FINITE_RULES] THEN\r
5627   REWRITE_TAC[REAL_ARITH `x - y = z:real <=> x = y + z`;\r
5628               VECTOR_ARITH `x - y = z:real^N <=> x = y + z`] THEN\r
5629   REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID] THEN SET_TAC[]);;\r
5630 \r
5631 let AFFINE_HULL_4 = prove\r
5632  (`affine hull {a,b,c,d} =\r
5633     { u % a + v % b + w % c + z % d | u + v + w + z = &1}`,\r
5634   SIMP_TAC[AFFINE_HULL_FINITE; FINITE_INSERT; FINITE_RULES] THEN\r
5635   SIMP_TAC[AFFINE_HULL_FINITE_STEP; FINITE_INSERT; FINITE_RULES] THEN\r
5636   REWRITE_TAC[REAL_ARITH `x - y = z:real <=> x = y + z`;\r
5637               VECTOR_ARITH `x - y = z:real^N <=> x = y + z`] THEN\r
5638   REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID] THEN SET_TAC[]);;\r
5639 \r
5640 \r
5641 let PROVE_EXISTS_CIR_OF_FOUR_POINTS = prove(`!(v1:real^3) v2 v3 v4.\r
5642          CARD {v1, v2, v3, v4} = 4 /\ ~coplanar {v1, v2, v3, v4}\r
5643          ==> (? p. p IN affine hull {v1, v2, v3, v4} /\\r
5644              (?r. !v. v IN {v1, v2, v3, v4}\r
5645                       ==> r = dist (p, v))) `,\r
5646 NHANH (REWRITE_RULE[RIGHT_FORALL_IMP_THM]  (GEN `p:real^3` PROVE_DIST_FROM_V1)) THEN \r
5647 NHANH (REWRITE_RULE[RIGHT_FORALL_IMP_THM]  (GEN `p:real^3` PROVE_EQ_DIST_FROM4 )) THEN \r
5648 REPEAT GEN_TAC THEN REPEAT LET_TAC THEN ABBREV_TAC `rr = &1 / &2 *\r
5649        rho x12 x13 x14 x23 x24 x34 / (&2 * delta x12 x13 x14 x23 x24 x34) ` THEN \r
5650 REWRITE_TAC[GSYM POS_EQ_NOT_COPLANANR] THEN \r
5651 NHANH (SPEC_ALL REAL_POS_NZ) THEN ASM_SIMP_TAC[] THEN \r
5652 NHANH (NOT_0_IMP_SUM_CHI_1 ) THEN ASM_SIMP_TAC[] THEN \r
5653 REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC;\r
5654   REAL_ARITH ` &1 / a * b = b / a `] THEN \r
5655 REWRITE_TAC[FORALL_IN_CLAUSES; MESON[]`(? r. (r:real) = a /\\r
5656   r = b /\ r = c /\ r = d ) <=> a = b /\ a = c /\ a = d `] THEN \r
5657 REWRITE_TAC[MESON[]` (! x. x = a ==> P a ) <=> P a `] THEN DISCH_TAC THEN \r
5658 EXISTS_TAC ` chi11 / (&2 * delta x12 x13 x14 x23 x24 x34) % (v1:real^3) +\r
5659       chi22 / (&2 * delta x12 x13 x14 x23 x24 x34) % v2 +\r
5660       chi33 / (&2 * delta x12 x13 x14 x23 x24 x34) % v3 +\r
5661       chi44 / (&2 * delta x12 x13 x14 x23 x24 x34) % v4 ` THEN \r
5662 CONJ_TAC THENL [REWRITE_TAC[AFFINE_HULL_4; IN_ELIM_THM] THEN \r
5663 FIRST_X_ASSUM MP_TAC THEN MESON_TAC[NOT_0_IMP_SUM_CHI_1 ]; \r
5664 FIRST_X_ASSUM MP_TAC THEN SIMP_TAC[d3; DIST_POS_LE; EQ_POW2_COND]]);;\r
5665 \r
5666 \r
5667 \r
5668 \r
5669 \r
5670 \r
5671 \r
5672 \r
5673 \r
5674 \r
5675 \r
5676 \r
5677 let IMP_PROPERTIES_OF_CIR4 = prove(`!(v1:real^3) v2 v3 v4.\r
5678          CARD {v1, v2, v3, v4} = 4 /\ ~coplanar {v1, v2, v3, v4}\r
5679          ==> circumcenter {v1, v2, v3, v4} IN affine hull {v1, v2, v3, v4} /\\r
5680              (?r. !v. v IN {v1, v2, v3, v4}\r
5681                       ==> r = dist (circumcenter {v1, v2, v3, v4},v))`,\r
5682 NHANH (SPEC_ALL PROVE_EXISTS_CIR_OF_FOUR_POINTS ) THEN REWRITE_TAC[circumcenter; IN]\r
5683 THEN MESON_TAC[EXISTS_THM]);;\r
5684 \r
5685 \r
5686 \r
5687 \r
5688 let DIST_EQ_IMP_ORTHOGONAL = prove(` dist (pp,v2) = dist (pp,v1) /\\r
5689   dist (p,v2) = dist (p,v1) ==>\r
5690   (pp - p ) dot (v2 - v1 ) = &0 `,\r
5691 REWRITE_TAC[MONG7_ROI; DOT_LSUB] THEN REAL_ARITH_TAC);;\r
5692 \r
5693 \r
5694 \r
5695 let IMP_OTHO4 = prove(` n dot (v2 - v1) = &0 /\\r
5696   n dot (v3 - v1) = &0 /\\r
5697   n dot (v4 - v1) = &0 /\\r
5698   x IN affine hull {v1,v2,v3,v4} /\\r
5699   y IN affine hull {v1,v2,v3,v4} ==>\r
5700   n dot (x - y ) = &0 `,\r
5701 REWRITE_TAC[AFFINE_HULL_4; IN_ELIM_THM] THEN STRIP_TAC THEN \r
5702 DOWN_TAC THEN IMP_TAC THEN SIMP_TAC[REAL_ARITH`a + b = c <=> a = c - b `] THEN \r
5703 PHA THEN REWRITE_TAC[VECTOR_ARITH` ((&1 - (v' + w' + z')) % v1 + v' % v2 +\r
5704  w' % v3 + z' % v4) - ((&1 - (v + w + z)) % v1 + v % v2 + w % v3 + z % v4)  =\r
5705   ( v' - v ) % ( v2 - v1 ) + ( w' - w ) % ( v3 - v1 ) +\r
5706   ( z' - z ) % ( v4 - v1 ) `] THEN \r
5707 SIMP_TAC[DOT_RADD; DOT_RMUL; ZERO_NEUTRAL]);;\r
5708 \r
5709 \r
5710 \r
5711 \r
5712 \r
5713 let UNIQUE_EXISISTING_PROPERTY_C4 = prove(`!(v1:real^3) v2 v3 v4.\r
5714          CARD {v1, v2, v3, v4} = 4 /\ ~coplanar {v1, v2, v3, v4}\r
5715          ==>   (!p. p IN affine hull {v1, v2, v3, v4} /\\r
5716                   (?r. !v. v IN {v1, v2, v3, v4} ==> r = dist (p,v))\r
5717                   ==> p = circumcenter {v1, v2, v3, v4}) `,\r
5718 NHANH (SPEC_ALL IMP_PROPERTIES_OF_CIR4 ) THEN \r
5719 REPEAT GEN_TAC THEN \r
5720 ABBREV_TAC ` pp = circumcenter {(v1:real^3), v2, v3, v4}` THEN \r
5721 REPEAT STRIP_TAC THEN \r
5722 DOWN_TAC THEN \r
5723 REWRITE_TAC[FORALL_IN_CLAUSES] THEN \r
5724 REWRITE_TAC[MESON[]` r = a /\ r = b /\ r = c /\ r = d <=> r = a /\ b = a /\ c = a \r
5725   /\ d = a `] THEN \r
5726 PHA THEN \r
5727 NHANH (MESON[DIST_EQ_IMP_ORTHOGONAL ]`dist (pp,v2) = dist (pp,v1) /\\r
5728  dist (pp,v3) = dist (pp,v1) /\\r
5729  dist (pp,v4) = dist (pp,v1) /\a11/\a2/\\r
5730  dist (p,v2) = dist (p,v1) /\\r
5731  dist (p,v3) = dist (p,v1) /\\r
5732  dist (p,v4) = dist (p,v1) ==>\r
5733   ( p - pp) dot ( v2 - v1 ) = &0 /\\r
5734   ( p - pp ) dot ( v3 - v1 ) = &0 /\\r
5735   ( p - pp ) dot ( v4 - v1 ) = &0 `) THEN \r
5736 ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN \r
5737 REWRITE_TAC[GSYM DOT_EQ_0] THEN MESON_TAC[IMP_OTHO4 ]);;\r
5738 \r
5739 \r
5740 \r
5741 \r
5742 let PROVE_IN_AFFINE_HULL_4 = prove(\r
5743 `~(delta x12 x13 x14 x23 x24 x34 = &0)\r
5744  ==> &1 / (&2 * delta x12 x13 x14 x23 x24 x34) %\r
5745      (chi x12 x13 x14 x23 x24 x34 % v1 +\r
5746       chi x12 x24 x23 x14 x13 x34 % v2 +\r
5747       chi x34 x13 x23 x14 x24 x12 % v3 +\r
5748       chi x34 x24 x14 x23 x13 x12 % v4) IN\r
5749      affine hull {(v1:real^3), v2, v3, v4}`,\r
5750 REWRITE_TAC[AFFINE_HULL_4; IN_ELIM_THM; VECTOR_ADD_LDISTRIB;\r
5751   VECTOR_MUL_ASSOC; REAL_ARITH ` ( &1 / a ) * b = b/a `]\r
5752  THEN MESON_TAC[NOT_0_IMP_SUM_CHI_1]);;\r
5753 \r
5754 \r
5755 \r
5756 (* VBVYGGT , le 85 *)\r
5757 \r
5758 \r
5759 \r
5760 MESON[POW_2_SQRT; DIST_POS_LE]` dist (x,y) pow 2 = r ==> dist (x,y) = sqrt ( r ) `;;\r
5761 \r
5762 (* LEMMA 85 *)\r
5763 let VBVYGGT = prove(`!(v1:real^3) v2 v3 v4.\r
5764          CARD {v1, v2, v3, v4} = 4 /\ ~coplanar {v1, v2, v3, v4}\r
5765          ==> circumcenter {v1, v2, v3, v4} IN affine hull {v1, v2, v3, v4} /\\r
5766              (?r. !v. v IN {v1, v2, v3, v4}\r
5767                       ==> r = dist (circumcenter {v1, v2, v3, v4},v)) /\\r
5768              (!p. p IN affine hull {v1, v2, v3, v4} /\\r
5769                   (?r. !v. v IN {v1, v2, v3, v4} ==> r = dist (p,v))\r
5770                   ==> p = circumcenter {v1, v2, v3, v4}) /\\r
5771              (let x12 = dist (v1,v2) pow 2 in\r
5772               let x13 = dist (v1,v3) pow 2 in\r
5773               let x14 = dist (v1,v4) pow 2 in\r
5774               let x23 = dist (v2,v3) pow 2 in\r
5775               let x24 = dist (v2,v4) pow 2 in\r
5776               let x34 = dist (v3,v4) pow 2 in\r
5777               let chi11 = chi x12 x13 x14 x23 x24 x34 in\r
5778               let chi22 = chi x12 x24 x23 x14 x13 x34 in\r
5779               let chi33 = chi x34 x13 x23 x14 x24 x12 in\r
5780               let chi44 = chi x34 x24 x14 x23 x13 x12 in\r
5781               circumcenter {v1, v2, v3, v4} =\r
5782               &1 / (&2 * delta x12 x13 x14 x23 x24 x34) %\r
5783               (chi11 % v1 + chi22 % v2 + chi33 % v3 + chi44 % v4)) `,\r
5784 NHANH (SPEC_ALL UNIQUE_EXISISTING_PROPERTY_C4 ) THEN \r
5785 NHANH (SPEC_ALL IMP_PROPERTIES_OF_CIR4 ) THEN \r
5786 REWRITE_TAC[MESON[]` (a /\ b1/\b2) /\ b ==> b1 /\b2/\ b/\ d <=> a /\ b1 /\b2/\b==>d `] THEN \r
5787 NHANH (REWRITE_RULE[RIGHT_FORALL_IMP_THM] ( GEN `p: real^3 `PROVE_DIST_FROM_V1)) THEN \r
5788 NHANH (REWRITE_RULE[RIGHT_FORALL_IMP_THM] ( GEN `p: real^3 ` PROVE_EQ_DIST_FROM4)) THEN \r
5789 REPEAT GEN_TAC THEN REPEAT LET_TAC THEN ABBREV_TAC `rr = &1 / &2 *\r
5790        rho x12 x13 x14 x23 x24 x34 / (&2 * delta x12 x13 x14 x23 x24 x34) ` THEN \r
5791 REWRITE_TAC[MESON[]` (! x. x = a ==> P x ) <=> P a `] THEN \r
5792 REWRITE_TAC[GSYM POS_EQ_NOT_COPLANANR] THEN \r
5793 NHANH (REAL_ARITH` &0 < a ==> ~( a = &0 )`) THEN \r
5794 NHANH (PROVE_IN_AFFINE_HULL_4 ) THEN \r
5795 UNDISCH_TAC ` dist ((v1:real^3),v2) pow 2 = x12` THEN \r
5796 UNDISCH_TAC ` dist ((v1:real^3),v3) pow 2 = x13` THEN \r
5797 UNDISCH_TAC ` dist ((v1:real^3),v4) pow 2 = x14` THEN \r
5798 UNDISCH_TAC ` dist ((v2:real^3),v3) pow 2 = x23` THEN \r
5799 UNDISCH_TAC ` dist ((v2:real^3),v4) pow 2 = x24` THEN \r
5800 UNDISCH_TAC ` dist ((v3:real^3),v4) pow 2 = x34` THEN \r
5801 UNDISCH_TAC ` chi x12 x13 x14 x23 x24 x34 = chi11 ` THEN \r
5802 UNDISCH_TAC ` chi x12 x24 x23 x14 x13 x34 = chi22 ` THEN \r
5803 UNDISCH_TAC ` chi x34 x13 x23 x14 x24 x12 = chi33` THEN \r
5804 UNDISCH_TAC ` chi x34 x24 x14 x23 x13 x12 = chi44` THEN \r
5805 REWRITE_TAC[MESON[]` a = b ==> P a <=> a = b ==> P b `] THEN \r
5806 ABBREV_TAC ` w =  &1 / (&2 * delta x12 x13 x14 x23 x24 x34) %\r
5807      (chi11 % (v1:real^3) + chi22 % v2 + chi33 % v3 + chi44 % v4)` THEN \r
5808 REWRITE_TAC[MESON[]` a /\ b ==> c <=> a ==> b ==> c `]\r
5809 THEN REPLICATE_TAC 13 DISCH_TAC THEN \r
5810 REWRITE_TAC[FORALL_IN_CLAUSES;d3] THEN PHA THEN \r
5811 NHANH (MESON[POW_2_SQRT; DIST_POS_LE]` dist (x,y) pow 2 = r\r
5812  ==> dist (x,y) = sqrt ( r ) `) THEN MESON_TAC[]);;\r
5813 \r
5814 (* lemma 85 *)\r
5815 (* let VBVYGGT = new_axiom `!(v1:real^3) v2 v3 v4.\r
5816          CARD {v1, v2, v3, v4} = 4 /\ ~coplanar {v1, v2, v3, v4}\r
5817          ==> circumcenter {v1, v2, v3, v4} IN affine hull {v1, v2, v3, v4} /\\r
5818              (?r. !v. v IN {v1, v2, v3, v4}\r
5819                       ==> r = dist (circumcenter {v1, v2, v3, v4},v)) /\\r
5820              (!p. p IN affine hull {v1, v2, v3, v4} /\\r
5821                   (?r. !v. v IN {v1, v2, v3, v4} ==> r = dist (p,v))\r
5822                   ==> p = circumcenter {v1, v2, v3, v4}) /\\r
5823              (let x12 = dist (v1,v2) pow 2 in\r
5824               let x13 = dist (v1,v3) pow 2 in\r
5825               let x14 = dist (v1,v4) pow 2 in\r
5826               let x23 = dist (v2,v3) pow 2 in\r
5827               let x24 = dist (v2,v4) pow 2 in\r
5828               let x34 = dist (v3,v4) pow 2 in\r
5829               let chi11 = chi x12 x13 x14 x23 x24 x34 in\r
5830               let chi22 = chi x12 x24 x23 x14 x13 x34 in\r
5831               let chi33 = chi x34 x13 x23 x14 x24 x12 in\r
5832               let chi44 = chi x34 x24 x14 x23 x13 x12 in\r
5833               circumcenter {v1, v2, v3, v4} =\r
5834               &1 / (&2 * delta x12 x13 x14 x23 x24 x34) %\r
5835               (chi11 % v1 + chi22 % v2 + chi33 % v3 + chi44 % v4)) `;; *)\r
5836 \r
5837 \r
5838 \r
5839 let NOT_COPLANAR_IMP_EXISTS_CIR = prove(`! (v1:real^3) v2 v3 v4.\r
5840        CARD {v1, v2, v3, v4} = 4 /\ ~coplanar {v1, v2, v3, v4}\r
5841        ==> circumcenter {v1, v2, v3, v4} IN affine hull {v1, v2, v3, v4} /\\r
5842            (?r. !v. v IN {v1, v2, v3, v4}\r
5843                     ==> r = dist (circumcenter {v1, v2, v3, v4},v)) `,\r
5844 MESON_TAC[VBVYGGT]);;\r
5845 \r
5846 \r
5847 \r
5848 \r
5849 let THREE_POINTS_COP = prove(` ! v1 v2 (v3:real^3). coplanar {v1,v2,v3} `,\r
5850 MESON_TAC[DIMINDEX_3; ARITH_RULE` 2 <= 3 `; COPLANAR_3]);;\r
5851 \r
5852 \r
5853 \r
5854 \r
5855 let PER_SET4 = SET_RULE ` {a,b,c,d} = {b,a,c,d} /\\r
5856   {a,b,c,d} = {c,b,a,d} /\\r
5857   {a,b,c,d} = {d,b,c,a} `;;\r
5858 \r
5859 \r
5860 let NOT_COPLANAR_IMP_CARD4 = prove(` ~ coplanar {(v1:real^3), v2, v3, v4} \r
5861 ==> CARD {v1, v2, v3, v4} = 4 `, REWRITE_TAC[CARD4; IN_SET3] THEN \r
5862 MP_TAC (GEN_ALL THREE_POINTS_COP ) THEN \r
5863 MESON_TAC[PER_SET4; SET_RULE` {a,a,b,c} = {a,b,c} `]);;\r
5864 \r
5865 \r
5866 let NOT_COPLANAR_IMP_EXISTS_CIR2 = MESON[NOT_COPLANAR_IMP_EXISTS_CIR ; \r
5867 NOT_COPLANAR_IMP_CARD4 ]` ! (v1:real^3) v2 v3 v4. ~ coplanar {v1, v2, v3, v4}\r
5868        ==> circumcenter {v1, v2, v3, v4} IN affine hull {v1, v2, v3, v4} /\\r
5869            (?r. !v. v IN {v1, v2, v3, v4}\r
5870                     ==> r = dist (circumcenter {v1, v2, v3, v4},v)) `;;\r
5871 \r
5872 \r
5873 \r
5874 let NOT_COPLANAR_IMP_RADV_PROPERTIES = prove(` ~coplanar {(v1:real^3), v2, v3, v4} ==>\r
5875   (! w. {v1, v2, v3, v4} w ==> radV {v1, v2, v3, v4} \r
5876     = dist (circumcenter {v1,v2,v3,v4} ,w) ) `,\r
5877 NHANH (SPEC_ALL NOT_COPLANAR_IMP_EXISTS_CIR2) THEN \r
5878 REWRITE_TAC[IN; radV] THEN MESON_TAC[EXISTS_THM]);;\r
5879 \r
5880 \r
5881 \r
5882 let ZJEWPAP = ` ! v1 v2 v3 (v4:real^3).\r
5883   let s = {v1, v2, v3, v4} in CARD s = 4 /\ ~ coplanar s \r
5884   ==> radV {v1,v2,v3}  <= radV s  `;;\r
5885 \r
5886 \r
5887 \r
5888 let PHA = REWRITE_TAC[MESON[]` ( a ==> b ==> c <=> a /\ b ==> c ) /\\r
5889   ( (a /\ b ) /\ c <=> a /\ b /\ c ) `];;\r
5890 \r
5891 \r
5892 let NOT_COL_EQ_UPS_X_POS = prove(`! v1 v2 v3.  ~ collinear {(v1:real^3), v2, v3} <=>\r
5893            &0 < ups_x (dist (v1,v2) pow 2) (dist (v1,v3) pow 2)\r
5894            (dist (v2,v3) pow 2) `,\r
5895 MP_TAC (GEN_ALL ZERO_LE_UPS_X) THEN REWRITE_TAC[UPS_X_EQ_ZERO_COND] THEN \r
5896 REWRITE_TAC[UPS_X_EQ_ZERO_COND; REAL_ARITH` a <= b <=> a = b \/ a < b `] THEN \r
5897 REWRITE_TAC[d3] THEN MESON_TAC[REAL_ARITH` ~( a = b /\ a < b ) `]);;\r
5898 \r
5899 \r
5900 let ETA_Y_POW2_EQ = prove(`(dist (v1,v2) pow 2 * dist (v1,v3) pow 2 * dist (v2,v3) pow 2) /\r
5901       ups_x (dist (v1,v2) pow 2) (dist (v1,v3) pow 2) (dist (v2,v3) pow 2) =\r
5902 ( eta_y (d3 v2 v3) (d3 v1 v3) (d3 v1 v2)) pow 2 `,\r
5903 REWRITE_TAC[eta_y;d3; eta_x] THEN LET_TR THEN \r
5904 REWRITE_TAC[GSYM REAL_POW_2; GSYM d3 ] THEN \r
5905 SIMP_TAC[MESON[UPS_X_SYM]` ups_x a b c = ups_x c b a `; \r
5906 REAL_ARITH ` a * b * c = c * b * a `] THEN \r
5907 MESON_TAC[SQRT_WORKS; REAL_LE_SQUARE_POW; REAL_LE_MUL;\r
5908   REAL_LE_DIV; d3 ; ZERO_LE_UPS_X; UPS_X_SYM]);;\r
5909 \r
5910 \r
5911 let ETA_Y_POS_LE = prove(` &0 <= eta_y (d3 v1 v2) (d3 v1 v3) (d3 v2 v3) `,\r
5912 REWRITE_TAC[eta_y; eta_x] THEN LET_TR THEN REWRITE_TAC[GSYM REAL_POW_2] THEN \r
5913 MESON_TAC[REAL_LE_POW_2; REAL_LE_MUL; ZERO_LE_UPS_X; REAL_LE_DIV;\r
5914   SQRT_POS_LE]);;\r
5915 \r
5916 \r
5917 (* lemma 87 *)\r
5918 let ZJEWPAP = prove(` ! v1 v2 v3 (v4:real^3).\r
5919   let s = {v1, v2, v3, v4} in CARD s = 4 /\ ~ coplanar s \r
5920   ==> radV {v1,v2,v3}  <= radV s  `,\r
5921 LET_TR THEN \r
5922 NHANH (MESON[COLLINEAR_IMP_COPLANAR ]`~coplanar {v1, v2, v3, v4}\r
5923   ==> ~ collinear {(v1:real^3),v2,v3} `) THEN \r
5924 SIMP_TAC[NOT_COLL_IMP_RADV_EQ_ETA_Y] THEN \r
5925 REWRITE_TAC[MESON[]` a /\ b /\ c <=> (a/\b)/\c`] THEN \r
5926 NHANH (SPEC_ALL VBVYGGT) THEN \r
5927 REPEAT GEN_TAC THEN \r
5928 NHANH (NOT_COPLANAR_IMP_RADV_PROPERTIES) THEN \r
5929 ABBREV_TAC ` pp = circumcenter {(v1:real^3), v2, v3, v4}` THEN \r
5930 MP_TAC (SPECL [`pp :real^3`; ` v1: real^3`; `v2:real^3`; ` v3:real^3`] DELTA_POS_4POINTS ) THEN \r
5931 REWRITE_TAC[REWRITE_RULE[IN] FORALL_IN_CLAUSES; \r
5932    FORALL_IN_CLAUSES ] THEN \r
5933 REWRITE_TAC[MESON[]` ( a ==> b ==> c <=> a /\ b ==> c ) /\\r
5934   ( (a /\ b ) /\ c <=> a /\ b /\ c ) `] THEN \r
5935 REPEAT STRIP_TAC THEN \r
5936 UNDISCH_TAC ` &0 <=\r
5937       delta (dist ((pp:real^3),v1) pow 2) (dist (pp,v2) pow 2) (dist (pp,v3) pow 2)\r
5938       (dist (v1,v2) pow 2)\r
5939       (dist (v1,v3) pow 2)\r
5940       (dist (v2,v3) pow 2)` THEN \r
5941 ABBREV_TAC `p1 = dist ((pp:real^3),v1)` THEN \r
5942 ABBREV_TAC `p2 = dist ((pp:real^3),v2)` THEN \r
5943 ABBREV_TAC `p3 = dist ((pp:real^3),v3)` THEN \r
5944  REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC THEN MATCH_MP_TAC \r
5945 (MESON[]` a ==> b ==> a `)) THEN \r
5946 EXPAND_TAC "p1" THEN \r
5947 EXPAND_TAC "p2" THEN \r
5948 EXPAND_TAC "p3" THEN \r
5949 FIRST_X_ASSUM MP_TAC THEN \r
5950 REWRITE_TAC[NOT_COL_EQ_UPS_X_POS ] THEN \r
5951 REWRITE_TAC[NOT_COL_EQ_UPS_X_POS; DELTA_RRR_INTERPRETE] THEN \r
5952 SIMP_TAC[REAL_FIELD` &0 < a ==> -- b * c + r * a = a * ( r - ( b * c )  / a ) `] THEN \r
5953 SIMP_TAC[ETA_Y_POW2_EQ; REAL_LE_MUL_EQ] THEN \r
5954 UNDISCH_TAC ` radV {(v1:real^3), v2, v3, v4} = p1 ` THEN \r
5955 SIMP_TAC[] THEN \r
5956 EXPAND_TAC "p1" THEN \r
5957 UNDISCH_TAC `r = dist ((pp: real^3),v4)` THEN \r
5958 SIMP_TAC[] THEN \r
5959 REPLICATE_TAC 3 REMOVE_TAC THEN \r
5960 SIMP_TAC[ETA_Y_SYYM; REAL_ARITH` &0 <= a - b <=> b <= a `] THEN \r
5961 MESON_TAC[DIST_POS_LE; POW2_COND; ETA_Y_POS_LE ]);;\r
5962 \r
5963 \r
5964 \r
5965 \r
5966 \r
5967 let NOT_EQ_BASIS_IMP_OTHORGANAL = MESON[DOT_BASIS_BASIS_UNEQUAL]\r
5968 ` ! i j. ~( i = j ) ==> basis i dot basis j = &0 `;;\r
5969 \r
5970 \r
5971 let BASIS_DIS_OTHORGONAL = \r
5972 MESON[ARITH_RULE` ~( 1 = 2 \/ 1 = 3 \/ 2 = 3 ) `; NOT_EQ_BASIS_IMP_OTHORGANAL]\r
5973 ` basis 1 dot basis 2 = &0 /\\r
5974   basis 1 dot basis 3 = &0 /\\r
5975   basis 2 dot basis 3 = &0 ` ;;\r
5976 \r
5977 \r
5978 let NORM_BASIS_VEC3 = prove(` ! i. i = 1 \/ i = 2 \/ i = 3 ==> \r
5979 norm (( basis i ):real^3 ) = &1 `,\r
5980 MESON_TAC[DIMINDEX_3; ARITH_RULE` i = 1 \/ i = 2 \/ i = 3 <=>\r
5981   1 <= i /\ i <= 3`; NORM_BASIS]);;\r
5982 \r
5983 \r
5984 let AAA_LEMMA = prove(` &0 < a /\\r
5985  a <= b /\\r
5986  b <= c /\ ll ==> &0 <= b pow 2 - a pow 2 /\ &0 <= c pow 2 - b pow 2 `,\r
5987 REWRITE_TAC[REAL_ARITH` &0 <= a - b <=> b <= a `] THEN \r
5988 MESON_TAC[REAL_LT_IMP_LE; POW2_COND; POS_IMP_POW2; REAL_LE_TRANS]);;\r
5989 \r
5990 \r
5991 let LLEEMAA = prove(` &0 < a /\\r
5992      a <= b /\\r
5993      b <= c /\\r
5994      &0 < a' /\\r
5995      a' <= b' /\\r
5996      b' <= c' /\\r
5997      a <= a' /\\r
5998      b <= b' /\\r
5999      c <= c' /\ l ==> &0 <= a' pow 2 - a pow 2 /\\r
6000   &0 <= b' pow 2 - b pow 2 /\\r
6001   &0 <= c' pow 2 - c pow 2 `,\r
6002 REWRITE_TAC[REAL_ARITH` &0 <= a - b <=> b <= a `] THEN \r
6003 MESON_TAC[POS_IMP_POW2; REAL_ARITH` a < b ==> a <= b `;\r
6004   REAL_LE_TRANS]);;\r
6005 \r
6006 \r
6007 \r
6008 let TYUNJLA = prove(` !(e1:real^3) e2 e3 a b c a' b' c' t1 t2 t3.\r
6009   e1 = basis 1 /\\r
6010      e2 = basis 2 /\\r
6011      e3 = basis 3 /\\r
6012      &0 < a /\\r
6013      a <= b /\\r
6014      b <= c /\\r
6015      &0 < a' /\\r
6016      a' <= b' /\\r
6017      b' <= c' /\\r
6018      a <= a' /\\r
6019      b <= b' /\\r
6020      c <= c' /\\r
6021      (!x. x IN {t1, t2, t3} ==> &0 < x) /\\r
6022      t1 + t2 + t3 < &1 /\\r
6023      v =\r
6024      ((t1 + t2 + t3) * a) % e1 +\r
6025      ((t2 + t3) * sqrt (b pow 2 - a pow 2)) % e2 +\r
6026      (t3 * sqrt (c pow 2 - b pow 2)) % e3 /\\r
6027   v' = ((t1 + t2 + t3) * a') % e1 +\r
6028      ((t2 + t3) * sqrt (b' pow 2 - a' pow 2)) % e2 +\r
6029      (t3 * sqrt (c' pow 2 - b' pow 2)) % e3 ==>\r
6030   norm v <= norm v' `,\r
6031 REPEAT STRIP_TAC THEN FIRST_X_ASSUM MP_TAC THEN \r
6032 FIRST_X_ASSUM MP_TAC THEN \r
6033 SIMP_TAC[POW2_COND; NORM_POS_LE; NORM_POW_2; DOT_LADD; DOT_RADD;\r
6034 DOT_LMUL; DOT_RMUL] THEN ASM_SIMP_TAC[] THEN \r
6035 SIMP_TAC[GSYM NORM_POW_2; NORM_BASIS_VEC3 ] THEN \r
6036 SIMP_TAC[BASIS_DIS_OTHORGONAL; MESON[DOT_SYM; BASIS_DIS_OTHORGONAL]\r
6037   ` basis 2 dot basis 1 = &0 /\ basis 3 dot basis 1 = &0 /\\r
6038   basis 3 dot basis 2 = &0 `; ZERO_NEUTRAL] THEN \r
6039 REWRITE_TAC[REAL_ARITH` (a * x ) * ( b * x ) * c = a * b * c * x pow 2 `] THEN \r
6040 REPEAT STRIP_TAC THEN DOWN_TAC THEN \r
6041 NHANH (AAA_LEMMA) THEN PHA THEN \r
6042 NHANH (MESON[AAA_LEMMA]` &0 < a /\ a <= b /\ b <= c /\ aa <= a /\ l ==>\r
6043   &0 <= b pow 2 - a pow 2 /\ &0 <= c pow 2 - b pow 2 `) THEN \r
6044 SIMP_TAC[SQRT_WORKS] THEN \r
6045 ONCE_REWRITE_TAC[REAL_ARITH` a <= b <=> &0 <= b - a `] THEN \r
6046 REWRITE_TAC[REAL_ARITH` ((t1 + t2 + t3) * (t1 + t2 + t3) * &1 pow 2 * a' pow 2 +\r
6047       (t2 + t3) * (t2 + t3) * &1 pow 2 * (b' pow 2 - a' pow 2) +\r
6048       t3 * t3 * &1 pow 2 * (c' pow 2 - b' pow 2)) -\r
6049      ((t1 + t2 + t3) * (t1 + t2 + t3) * &1 pow 2 * a pow 2 +\r
6050       (t2 + t3) * (t2 + t3) * &1 pow 2 * (b pow 2 - a pow 2) +\r
6051       t3 * t3 * &1 pow 2 * (c pow 2 - b pow 2)) = \r
6052   t1 * ( t1 + &2 * t2 + &2 * t3 ) * ( a' pow 2 - a pow 2 ) +\r
6053   t2 * (t2 + &2 * t3 ) * ( b' pow 2 - b pow 2 ) +\r
6054   t3 pow 2 * ( c' pow 2 - c pow 2 ) `] THEN \r
6055 REWRITE_TAC[REAL_ARITH` &0 <= a - b <=> b <= a `] THEN \r
6056 PHA THEN NHANH (LLEEMAA) THEN STRIP_TAC THEN \r
6057 UNDISCH_TAC ` (!x. x IN {t1, t2, t3} ==> &0 < x)` THEN \r
6058 REPLICATE_TAC 3 ( FIRST_X_ASSUM MP_TAC) THEN \r
6059 REWRITE_TAC[FORALL_IN_CLAUSES] THEN PHA THEN \r
6060 NHANH (REAL_ARITH` &0 < t1 /\ &0 < t2 /\ &0 < t3 ==>\r
6061   &0 <= t1 /\ &0 <= t2 /\ &0 <= t1 + &2 * t2 + &2 * t3 /\\r
6062   &0 <= t2 + &2 * t3 `) THEN \r
6063 MESON_TAC[REAL_LE_ADD; REAL_LE_MUL; REAL_LE_POW_2]);;\r
6064 \r
6065 let LEMMA83 = TYUNJLA ;;\r
6066 \r
6067 \r
6068 \r
6069 (* This lemma will be proved by Harrison *)\r
6070 let NORM_TOWARD_FORTH_POINT = new_axiom`!(v1:real^3) v2 v3 w.\r
6071      ~coplanar {v1, v2, v3, w}\r
6072      ==> (?nor. norm nor = &1 /\\r
6073                 (!x. x IN aff_ge {v1, v2, v3} {w} <=>\r
6074                      (?xx h.\r
6075                           xx IN affine hull {v1, v2, v3} /\\r
6076                           &0 <= h /\\r
6077                           x = xx + h % nor)) /\\r
6078                 (!x y.\r
6079                      {x, y} SUBSET affine hull {v1, v2, v3}\r
6080                      ==> nor dot (x - y) = &0))`;;\r
6081 \r
6082 \r
6083 let DELTA_TRIPLE_SUB_H_EXPAND = prove(`\r
6084 delta (a01 - h) (a02 - h) (a03 - h) x12 x13 x23 = \r
6085   delta a01 a02 a03 x12 x13 x23 - h * ups_x x12 x13 x23 `,\r
6086 REWRITE_TAC[delta;ups_x] THEN REAL_ARITH_TAC);;\r
6087 \r
6088 let PROVE_EXISTS_H_DELTA_0 = prove(`&0 < ups_x x12 x13 x23 /\ &0 <= delta a01 a02 a03 x12 x13 x23\r
6089  ==> (?h. &0 <= h /\ h = ( delta a01 a02 a03 x12 x13 x23 ) / ups_x x12 x13 x23 /\\r
6090  delta (a01 - h) (a02 - h) (a03 - h) x12 x13 x23 = &0 )`,\r
6091 REWRITE_TAC[DELTA_TRIPLE_SUB_H_EXPAND] THEN \r
6092 DISCH_TAC THEN \r
6093 EXISTS_TAC`( delta a01 a02 a03 x12 x13 x23 ) / ups_x x12 x13 x23` THEN \r
6094 ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_DIV] THEN \r
6095 FIRST_X_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD);;\r
6096 \r
6097 \r
6098 \r
6099 let FIRST_POINT_IN_AFF3 = prove(` ! w v1 v2. w IN aff {w,v1,v2} `,\r
6100 REWRITE_TAC[aff; AFFINE_HULL_3; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN \r
6101 EXISTS_TAC ` &1 ` THEN EXISTS_TAC `&0` THEN EXISTS_TAC `&0` THEN \r
6102 REWRITE_TAC[ZERO_NEUTRAL] THEN CONV_TAC VECTOR_ARITH);;\r
6103 \r
6104 let THREE_GEN_POINTS_IN_AFF3 = MESON[PER_SET3; FIRST_POINT_IN_AFF3 ]` a IN aff {a,b,c} /\\r
6105   b IN aff {a,b,c} /\ c IN aff {a,b,c} `;;\r
6106 \r
6107 \r
6108 (* LEMMA73 *)\r
6109 let OFGJQUS = prove(` ! v1 v2 v3 (v4:real^3) a01 a02 a03 .\r
6110   let x12 = d3 v1 v2 pow 2 in\r
6111          let x13 = d3 v1 v3 pow 2 in\r
6112          let x23 = d3 v2 v3 pow 2 in\r
6113          CARD {v1, v2, v3, v4} = 4 /\\r
6114 \r
6115          ~coplanar {v1, v2, v3, v4} /\\r
6116   &0 <= a01 /\ &0 <= a02 /\ &0 <= a03 /\ \r
6117   delta a01 a02 a03 x12 x13 x23 >= &0\r
6118          ==> (?v0. v0 IN aff_ge {v1, v2, v3} {v4} /\\r
6119                    d3 v0 v1 pow 2 = a01 /\\r
6120                    d3 v0 v2 pow 2 = a02 /\\r
6121                    d3 v0 v3 pow 2 = a03 /\\r
6122                    (!vv0. vv0 IN aff_ge {v1, v2, v3} {v4} /\\r
6123                           d3 vv0 v1 pow 2 = a01 /\\r
6124                           d3 vv0 v2 pow 2 = a02 /\\r
6125                           d3 vv0 v3 pow 2 = a03\r
6126                           ==> vv0 = v0) /\\r
6127                    ( v0 IN aff {v1,v2,v3} <=> \r
6128                      delta a01 a02 a03 x12 x13 x23 = &0 )) `,\r
6129 REPEAT GEN_TAC THEN \r
6130 REPEAT LET_TAC THEN \r
6131 NHANH (MESON[COLLINEAR_IMP_COPLANAR ]`~coplanar {v1, v2, v3, v4}\r
6132   ==> ~ collinear {(v1:real^3),v2,v3} `) THEN \r
6133 REWRITE_TAC[NOT_COL_EQ_UPS_X_POS] THEN \r
6134 PHA THEN REWRITE_TAC[MESON[]` ( &0 < a ) /\ l <=> l /\ &0 < a `] THEN \r
6135 PHA THEN \r
6136 REWRITE_TAC[d3 ; REAL_ARITH` a >= b <=> b <= a `; \r
6137   GSYM (MESON[]` ( &0 < a ) /\ l <=> l /\ &0 < a `)] THEN \r
6138 EXPAND_TAC "x12" THEN \r
6139 EXPAND_TAC "x13" THEN \r
6140 EXPAND_TAC "x23" THEN \r
6141 REWRITE_TAC[d3] THEN NHANH (PROVE_EXISTS_H_DELTA_0 ) THEN \r
6142 NHANH (SPEC_ALL NORM_TOWARD_FORTH_POINT ) THEN \r
6143 NHANH (MESON[COLLINEAR_IMP_COPLANAR]`~coplanar {v1, v2, v3, v4}\r
6144   ==> ~ collinear {(v1:real^3),v2,v3} `) THEN \r
6145 STRIP_TAC THEN \r
6146 FIRST_X_ASSUM MP_TAC THEN \r
6147 UNDISCH_TAC ` ~collinear {(v1:real^3), v2, v3}` THEN \r
6148 PHA THEN \r
6149 REWRITE_TAC[GSYM d3] THEN \r
6150 NHANH (SPEC_ALL SDIHJZK_INTERPRETE) THEN \r
6151 STRIP_TAC THEN \r
6152 EXISTS_TAC ` (v0:real^3) + sqrt (h) % nor ` THEN \r
6153 CONJ_TAC THENL [\r
6154 ASM_MESON_TAC[SQRT_WORKS; d3; aff];  \r
6155 UNDISCH_TAC ` !x y. {x, y} SUBSET affine hull {v1, v2, v3} \r
6156   ==> (nor:real^3) dot (x - y) = &0`] THEN \r
6157 NHANH (MESON[]` (! x y. P x y ) ==> P v0 v1 /\ P v0 v2 /\ P v0 v3 `) THEN \r
6158 SIMP_TAC[SET2_SU_EX; GSYM aff; THREE_GEN_POINTS_IN_AFF3 ] THEN \r
6159 UNDISCH_TAC ` (v0:real^3) IN aff {v1, v2, v3}` THEN \r
6160 SIMP_TAC[] THEN \r
6161 NHANH (MESON[REAL_MUL_RZERO; DOT_LMUL]`nor dot v = &0 ==>\r
6162   sqrt h % nor dot v = &0 `) THEN \r
6163 SIMP_TAC[ORTHOGONAL_IMP_PITHAGOR; d3; NORM_MUL; REAL_ARITH ` (a * b ) pow 2 = \r
6164 a pow 2 * b pow 2 `;  REAL_POW2_ABS] THEN \r
6165 STRIP_TAC THEN \r
6166 STRIP_TAC THEN \r
6167 UNDISCH_TAC ` &0 <= h ` THEN \r
6168 UNDISCH_TAC` norm (nor:real^3) = &1` THEN \r
6169 SIMP_TAC[SQRT_WORKS; REAL_ARITH` &1 pow 2 = &1`; REAL_MUL_RID] THEN \r
6170 REPLICATE_TAC 2 DISCH_TAC THEN \r
6171 UNDISCH_TAC `a01 - h = d3 v0 v1 pow 2` THEN \r
6172 UNDISCH_TAC `a02 - h = d3 v0 v2 pow 2` THEN \r
6173 UNDISCH_TAC `a03 - h = d3 v0 v3 pow 2` THEN \r
6174 SIMP_TAC[REAL_ARITH` a - b = c <=> c = a - b `; d3 ; \r
6175   REAL_ARITH` a + b - a = b `] THEN \r
6176 REPEAT STRIP_TAC THENL [\r
6177 UNDISCH_TAC` vv0 IN aff_ge {v1, v2, v3} {(v4:real^3)} ` THEN \r
6178 UNDISCH_TAC ` !x. (x:real^3) IN aff_ge {v1, v2, v3} {v4} <=>\r
6179           (?xx h.\r
6180                xx IN affine hull {v1, v2, v3} /\ &0 <= h /\ x = xx + h % nor) ` THEN \r
6181 SIMP_TAC[] THEN \r
6182 REPEAT STRIP_TAC THEN \r
6183 REPLICATE_TAC 7 (FIRST_X_ASSUM MP_TAC) THEN PHA THEN DAO THEN \r
6184 \r
6185 PURE_ONCE_REWRITE_TAC[MESON[]`a = b /\ P a <=> a = b /\ P b `] THEN \r
6186 UNDISCH_TAC`!x y.\r
6187           (x:real^3) IN aff {v1, v2, v3} /\ y IN aff {v1, v2, v3}\r
6188           ==> nor dot (x - y) = &0 /\ sqrt h % nor dot (x - y) = &0` THEN \r
6189 PHA THEN \r
6190 NHANH (MESON[THREE_GEN_POINTS_IN_AFF3; aff]`(!x y.\r
6191       x IN aff {v1, v2, v3} /\ y IN aff {v1, v2, v3} ==> P x y ) /\\r
6192   a1 /\ a2 /\ xx IN affine hull {v1, v2, v3} /\ l ==>\r
6193   P xx v1 /\ P xx v2 /\ P xx v3 `) THEN \r
6194 NHANH (MESON[DOT_LMUL; REAL_MUL_RZERO]` nor dot (xx - v1) = &0 /\ l ==>\r
6195   ( h' % nor) dot ( xx - v1 ) = &0 `) THEN \r
6196 DAO THEN \r
6197 ONCE_REWRITE_TAC[MESON[]` a1/\a2/\a3/\a4/\a5/\a6/\a7/\l ==> las\r
6198   <=> a1/\a2/\a3/\a4/\a5/\a6/\a7 ==> l ==> las `] THEN \r
6199 SIMP_TAC[ORTHOGONAL_IMP_PITHAGOR] THEN \r
6200 REWRITE_TAC[MESON[]` a1 /\a2/\a3/\ (! x. P x ) /\ l <=> (a1 /\a2/\a3)\r
6201   /\ (! x. P x ) /\ l`] THEN \r
6202 REWRITE_TAC[REAL_ARITH` c + a = aa /\ c + b = bb /\ c + d = dd\r
6203   <=> c + a = aa /\ a - b = aa - bb /\ d - b = dd - bb `] THEN \r
6204 REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC) THEN \r
6205 PHA THEN \r
6206 SIMP_TAC[MESON[]` a1/\a2/\a3/\a4 <=> (a1/\a2/\a3)/\a4 `] THEN \r
6207 REWRITE_TAC[REAL_ARITH` a3 = aa3 - h /\ a2 = aa2 - h /\ \r
6208   a1 = aa1 - h <=> a2 - a1 = aa2 - aa1 /\ a3 - a1 = aa3 - aa1 /\\r
6209   a3 = aa3 - h `] THEN \r
6210 STRIP_TAC THEN \r
6211 \r
6212 UNDISCH_TAC`dist ((v0:real^3),v2) pow 2 - dist (v0,v1) pow 2 = a02 - a01` THEN \r
6213 UNDISCH_TAC`dist ((v0:real^3),v3) pow 2 - dist (v0,v1) pow 2 = a03 - a01` THEN \r
6214 UNDISCH_TAC`dist ((xx:real^3),v2) pow 2 - dist (xx,v1) pow 2 = a02 - a01` THEN \r
6215 UNDISCH_TAC`dist ((xx:real^3),v3) pow 2 - dist (xx,v1) pow 2 = a03 - a01` THEN \r
6216 \r
6217 UNDISCH_TAC `(v0:real^3) IN aff {v1, v2, v3}` THEN \r
6218 UNDISCH_TAC `(xx:real^3) IN affine hull {v1, v2, v3}` THEN \r
6219 PHA THEN \r
6220 REWRITE_TAC[MESON[]` a1 = a /\ b1 = b /\ a2 = a /\ b2 = b <=>\r
6221   a1 = a /\ b1 = b /\ b1 = b2 /\ a1 = a2 `] THEN \r
6222 REWRITE_TAC[aff; MESON[SET2_SU_EX]`  a IN s /\ b IN s /\ a1 \r
6223   /\a2 /\ l <=> a1/\a2/\ {a,b} SUBSET s /\ l `] THEN \r
6224 NHANH (SPEC_ALL EQ_SUB_DIST_POW2_IMP_IDENTIFIED) THEN \r
6225 UNDISCH_TAC ` dist ((v0:real^3),v3) pow 2 = a03 - h` THEN \r
6226 UNDISCH_TAC` norm (h' % (nor:real^3)) pow 2 + dist ((xx:real^3),v2) pow 2 = a02` THEN \r
6227 PHA THEN DAO THEN \r
6228 REWRITE_TAC[MESON[]` a /\ b ==> c <=> a ==> b ==> c `] THEN \r
6229 SIMP_TAC[REAL_ARITH` a - b = c <=> a = b + c `] THEN \r
6230 SIMP_TAC[REAL_ARITH` a + b + c = d <=> b = d - a - c `] THEN \r
6231 REWRITE_TAC[REAL_ARITH` a02 - norm (h' % nor) pow 2 - (a02 - a01) + a03 - a01 = a03 - h\r
6232   <=> norm (h' % nor) pow 2 = h `] THEN \r
6233 REPLICATE_TAC 7 DISCH_TAC THEN \r
6234 SIMP_TAC[NORM_MUL; REAL_ARITH` (a*b) pow 2 = a pow 2 * b pow 2 `;\r
6235   REAL_POW2_ABS] THEN \r
6236 UNDISCH_TAC` norm (nor:real^3) = &1 ` THEN \r
6237 SIMP_TAC[REAL_ARITH` a * &1 pow 2 = a `] THEN \r
6238 UNDISCH_TAC ` &0 <= h ` THEN \r
6239 UNDISCH_TAC ` &0 <= h' ` THEN \r
6240 MESON_TAC[SQRT_WORKS; EQ_POW2_COND];\r
6241 \r
6242 \r
6243 \r
6244 \r
6245 EQ_TAC THENL[\r
6246 UNDISCH_TAC `(v0:real^3) IN aff {v1, v2, v3}` THEN \r
6247 UNDISCH_TAC` !(x:real^3) y.\r
6248           x IN aff {v1, v2, v3} /\ y IN aff {v1, v2, v3}\r
6249           ==> nor dot (x - y) = &0 /\ sqrt h % nor dot (x - y) = &0 ` THEN \r
6250 PHA THEN \r
6251 NHANH (MESON[]` (! x y. x IN aff {v1, v2, v3} /\ y IN aff {v1, v2, v3} ==> l x y ) \r
6252   /\ a IN aff {v1, v2, v3} /\ b IN aff {v1, v2, v3} ==> l a b `) THEN \r
6253 REWRITE_TAC[VECTOR_ARITH` a - ( a + s % x ) = ( -- s ) % x `;\r
6254   DOT_RMUL; GSYM NORM_POW_2] THEN \r
6255 UNDISCH_TAC ` norm (nor:real^3) = &1 ` THEN \r
6256 SIMP_TAC[REAL_ARITH` a * &1 pow 2 = a `; DOT_LMUL; GSYM NORM_POW_2;\r
6257   REAL_ARITH` ( -- a ) * a = &0 <=> a pow 2 = &0 `] THEN \r
6258 UNDISCH_TAC` &0 <= h ` THEN \r
6259 UNDISCH_TAC` delta (a01 - h) (a02 - h) (a03 - h) (d3 v1 v2 pow 2) (d3 v1 v3 pow 2)\r
6260       (d3 v2 v3 pow 2) =\r
6261       &0 ` THEN \r
6262 SIMP_TAC[SQRT_WORKS; d3] THEN \r
6263 MESON_TAC[REAL_ARITH` a - &0 = a `];\r
6264 ABBREV_TAC ` tu = delta a01 a02 a03 (dist ((v1:real^3),v2) pow 2) (dist (v1,v3) pow 2)\r
6265  (dist (v2,v3) pow 2) ` THEN \r
6266 UNDISCH_TAC` h =\r
6267       tu /\r
6268       ups_x (dist ((v1:real^3),v2) pow 2) (dist (v1,v3) pow 2) (dist (v2,v3) pow 2)` THEN \r
6269 PHA THEN SIMP_TAC[REAL_ARITH` &0 / a = &0 `] THEN \r
6270 STRIP_TAC THEN \r
6271 SIMP_TAC[SQRT_0; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN \r
6272 UNDISCH_TAC` (v0:real^3) IN aff {v1, v2, v3}` THEN \r
6273 SIMP_TAC[]]]);;\r
6274 \r
6275 (* END *)\r
6276 \r
6277 \r
6278 \r
6279 \r
6280 \r
6281 \r
6282 \r
6283 \r
6284 \r
6285 \r
6286 \r
6287 \r
6288 let PROVE_THE_HYPOTHESI_FOR_74 = prove(` (let s = {v1, v2, v3, v4} in\r
6289          CARD s = 4 /\\r
6290 \r
6291          ~coplanar s /\\r
6292          eta_y (d3 v1 v2 ) (d3 v1 v3) (d3 v2 v3) <= r )\r
6293 ==> ( let x12 = d3 v1 v2 pow 2 in\r
6294      let x13 = d3 v1 v3 pow 2 in\r
6295      let x23 = d3 v2 v3 pow 2 in\r
6296      CARD {v1, v2, v3, v4} = 4 /\\r
6297 \r
6298      ~coplanar {v1, v2, v3, v4} /\\r
6299      &0 <= r pow 2 /\\r
6300      &0 <= r pow 2 /\\r
6301      &0 <= r pow 2 /\\r
6302      delta (r pow 2) (r pow 2) (r pow 2) x12 x13 x23 >= &0 ) `,\r
6303 REPEAT LET_TAC THEN \r
6304 SIMP_TAC[REAL_LE_POW_2] THEN \r
6305 REWRITE_TAC[DELTA_RRR_INTERPRETE] THEN \r
6306 EXPAND_TAC "s" THEN \r
6307 NHANH (MESON[COLLINEAR_IMP_COPLANAR]` ~ coplanar {v1, v2, v3, v} ==>\r
6308   ~ collinear {v1, v2, (v3:real^3)} `) THEN \r
6309 REWRITE_TAC[NOT_COL_EQ_UPS_X_POS] THEN \r
6310 EXPAND_TAC "x12" THEN \r
6311 EXPAND_TAC "x13" THEN \r
6312 EXPAND_TAC "x23" THEN \r
6313 REWRITE_TAC[d3] THEN \r
6314 SIMP_TAC[REAL_FIELD` &0 < a ==> -- x * y + r * a = a * ( r - (x * y ) / a )`] THEN \r
6315 SIMP_TAC[ETA_Y_POW2_EQ;d3; ETA_Y_SYYM] THEN \r
6316 MP_TAC ETA_Y_POS_LE THEN \r
6317 DAO THEN PHA THEN \r
6318 REWRITE_TAC[d3] THEN DAO THEN \r
6319 NHANH (MESON[POS_IMP_POW2]` a <= b /\ &0 <= a ==> \r
6320   a pow 2 <= b pow 2 `) THEN \r
6321 ONCE_REWRITE_TAC[REAL_ARITH` a <= b <=> &0 <= b - a `] THEN \r
6322 REWRITE_TAC[REAL_ARITH` a >= &0 <=> &0 <= a `] THEN \r
6323 SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_MUL]);;\r
6324 \r
6325 \r
6326 \r
6327 (*   OFGJQUS       *)\r
6328 (* LEMMA 74 *)\r
6329 \r
6330 let LFYTDXC = prove(` ? p. ! v1 v2 v3 (v4:real^3) r.\r
6331   let s = {v1, v2, v3, v4} in\r
6332          CARD s = 4 /\\r
6333 \r
6334          ~coplanar s /\\r
6335          eta_y (d3 v1 v2 ) (d3 v1 v3 ) (d3 v2 v3 ) <= r\r
6336          ==> p v1 v2 v3 v4 r IN aff_ge {v1, v2, v3} {v4} /\\r
6337                    r = d3 ( p v1 v2 v3 v4 r ) v1 /\\r
6338                    r = d3 ( p v1 v2 v3 v4 r ) v2 /\\r
6339                    r = d3 ( p v1 v2 v3 v4 r )  v3 /\\r
6340                    (!w. w IN aff_ge {v1, v2, v3} {v4} /\\r
6341                         r = d3 w v1 /\\r
6342                         r = d3 w v2 /\\r
6343                         r = d3 w v3\r
6344                         ==> w = ( p v1 v2 v3 v4 r ) ) `,\r
6345 REWRITE_TAC[GSYM SKOLEM_THM] THEN \r
6346 REPEAT GEN_TAC THEN (MP_TAC PROVE_THE_HYPOTHESI_FOR_74 ) THEN LET_TAC THEN \r
6347 REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN \r
6348 MP_TAC (SPECL [`v1:real^3`;`v2:real^3`;`v3:real^3`;` v4:real^3`;\r
6349   ` r pow 2 `; ` r pow 2 `; ` r pow 2 `] OFGJQUS) THEN REPEAT LET_TAC THEN \r
6350 REWRITE_TAC[MESON[]` ( a ==> b ) ==> a ==> c <=> a /\ b ==> c`]\r
6351  THEN EXPAND_TAC "s" THEN REWRITE_TAC[MESON[]` ( a ==> b) ==> c /\ a ==> l <=> \r
6352   a /\ b /\ c ==> l `] THEN MATCH_MP_TAC (MESON[]` (c /\ b ==> l ) ==> \r
6353 a /\ b /\ c ==> l `) THEN NHANH (MESON[ETA_Y_POS_LE; REAL_LE_TRANS]\r
6354 ` eta_y (d3 v1 v2) (d3 v1 v3) (d3 v2 v3) <= r  ==> &0 <= r `    ) THEN \r
6355 STRIP_TAC THEN EXISTS_TAC `v0:real^3` THEN ASM_MESON_TAC[D3_POS_LE;\r
6356  GSYM EQ_POW2_COND]);;\r
6357 \r
6358 \r
6359 \r
6360 let LEMMA74 = LFYTDXC;;\r
6361 let point_eq = new_specification ["point_eq"] LFYTDXC;;\r
6362 \r
6363 \r
6364 \r
6365 let INSERT_SUBSET = SET_RULE` {} SUBSET s /\\r
6366   ( ( a INSERT s ) SUBSET ss <=> a IN ss /\ s SUBSET  ss ) `;;\r
6367 \r
6368 \r
6369 let IMP_TAC = REWRITE_TAC[MESON[]` a /\ b ==> c <=> a ==> b ==> c `];;\r
6370 \r
6371 let IMP_OTHORGONAL_AFF3 = prove(`!v1 v2 v3 u.\r
6372      u dot (v1 - v2) = &0 /\ u dot (v1 - v3) = &0\r
6373      ==> (!x y. {x, y} SUBSET aff {v1, v2, v3} ==> u dot (x - y) = &0)`,\r
6374 REWRITE_TAC[aff; AFFINE_HULL_3; INSERT_SUBSET; IN_ELIM_THM] THEN \r
6375 REPEAT STRIP_TAC THEN DOWN_TAC THEN \r
6376 REWRITE_TAC[MESON[]` a /\ b ==> c <=> a ==> b ==> c `] THEN \r
6377 SIMP_TAC[REAL_ARITH` a + b = &1 <=> a = &1 - b `] THEN \r
6378 REWRITE_TAC[VECTOR_ARITH` ((&1 - (v + w)) % v1 + v % v2 + w % v3) -\r
6379       ((&1 - (v' + w')) % v1 + v' % v2 + w' % v3) =\r
6380   ( v' - v ) % ( v1 - v2 ) + ( w' - w ) % ( v1 - v3 ) `] THEN REPEAT STRIP_TAC\r
6381  THEN ASM_SIMP_TAC[DOT_RADD; DOT_RMUL; ZERO_NEUTRAL]);;\r
6382 \r
6383 \r
6384 (* MONG7_ROI *)\r
6385 \r
6386 let DIST_EQ_IMP_OTHORGONAL = prove(` ! a b p q. dist (p,a) = dist (p,b) /\ dist (q,a) = dist(q,b) \r
6387 ==> ( p - q ) dot ( a - b ) = &0 `,\r
6388 REWRITE_TAC[MONG7_ROI; DOT_LSUB] THEN REAL_ARITH_TAC);;\r
6389 \r
6390 let NOT_COPLANAR_IMP_NOT_COLLINEAR =\r
6391   MATCH_MP (MESON[]` (a ==> b) ==> ~ b ==> ~ a `) (SPEC_ALL COLLINEAR_IMP_COPLANAR);;\r
6392 \r
6393 \r
6394 (* LEMMA 75 *)\r
6395 let TIEEBHT = prove(` !v1 v2 v3 (v4:real^3) r p p' u. let s = {v1,v2,v3,v4} in\r
6396 let x12 = d3 v1 v2  in\r
6397 let x13 = d3 v1 v3  in\r
6398 let x23 = d3 v2 v3  in\r
6399 ~ coplanar s /\\r
6400 CARD s = 4 /\\r
6401 eta_y x12 x13 x23 <= r /\\r
6402 p' = point_eq v1 v2 v3 v4 r /\\r
6403 p = circumcenter {v1,v2,v3} /\ u IN aff {v1,v2,v3} ==>\r
6404 ( p' - p ) dot ( u - p ) = &0 `,\r
6405 REPEAT STRIP_TAC THEN LET_TR THEN NHANH NOT_COPLANAR_IMP_NOT_COLLINEAR THEN \r
6406 NHANH PRE_RADV_COND THEN MP_TAC ( SPEC_ALL point_eq) THEN LET_TR THEN \r
6407 REWRITE_TAC[MESON[]` ( a /\ b /\ c ==> l ) ==>\r
6408   ( b /\ bb ) /\ a /\ c /\ las ==> ll <=>\r
6409   a /\ b /\ c /\ bb /\ las /\ l ==> ll `] THEN \r
6410 NGOAC THEN REWRITE_TAC[MESON[]` a /\ p = circumcenter {v1, v2, v3} \r
6411   <=> p = circumcenter {v1, v2, v3} /\ a `] THEN PHA THEN \r
6412 NHANH (SPEC_ALL CIRCUMCENTER_PROPTIES) THEN \r
6413 REWRITE_TAC[MESON[]` a = b /\ P b <=> a = b /\ P a `] THEN \r
6414 REWRITE_TAC[REWRITE_RULE[IN] FORALL_IN_CLAUSES] THEN \r
6415 REWRITE_TAC[MESON[]`(? c. c = a /\ c = b /\ c = d ) <=>\r
6416    a = b /\ a = d `; MESON[]` r = a /\ r = b /\ r = c /\ l <=>\r
6417   a = b /\ a = c /\ r = c /\ l `; d3] THEN \r
6418 NHANH (MESON[DIST_EQ_IMP_OTHORGONAL]` (dist (p,v1) = dist (p,v2) /\ \r
6419 dist (p,v1) = dist (p,v3)) /\ a1 /\a2 /\a3/\ dist (p',v1) = dist (p',v2) /\\r
6420  dist (p',v1) = dist (p',v3) /\ l ==>  ( p' - p ) dot ( v1 - v2 ) = &0 /\\r
6421   (p' - p ) dot ( v1 - v3 ) = &0 `) THEN \r
6422 REWRITE_TAC[GSYM aff] THEN STRIP_TAC THEN \r
6423 UNDISCH_TAC` (p:real^3) IN aff {v1, v2, v3}` THEN \r
6424 UNDISCH_TAC` (u:real^3) IN aff {v1, v2, v3}` THEN \r
6425 PHA THEN REWRITE_TAC[GSYM SET2_SU_EX] THEN \r
6426 REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN PHA THEN \r
6427 MESON_TAC[IMP_OTHORGONAL_AFF3 ]);;\r
6428 \r
6429 \r
6430 (* lemma 89 *)\r
6431 let PVLJZLA = prove( `! (v1:real^3) v2 v3 v4.\r
6432      let s = {v1, v2, v3, v4} in\r
6433      ~coplanar s\r
6434      ==> (circumcenter s IN conv0 s <=>\r
6435           orientation s v1 (\x. &0 < x) /\\r
6436           orientation s v2 (\x. &0 < x) /\\r
6437           orientation s v3 (\x. &0 < x) /\\r
6438           orientation s v4 (\x. &0 < x))`,\r
6439 REWRITE_TAC[orientation; affsign] THEN \r
6440 REPEAT GEN_TAC THEN \r
6441 LET_TR THEN \r
6442 REWRITE_TAC[lin_combo] THEN \r
6443 REWRITE_TAC[SET_RULE` s DIFF {a} UNION {a} = s UNION {a} `;\r
6444   SET_RULE` {a,b,c,d} UNION {a} = {a,b,c,d} /\\r
6445   {a,b,c,d} UNION {b} = {a,b,c,d} /\\r
6446   {a,b,c,d} UNION {c} = {a,b,c,d} /\\r
6447   {a,b,c,d} UNION {d} = {a,b,c,d}`] THEN \r
6448 REWRITE_TAC[MESON[]`a = b /\ c /\ d <=> c /\ d /\ b = a `] THEN \r
6449 REWRITE_TAC[SET_RULE` (!w. {v1} w ==> &0 < f w) /\\r
6450            sum {v1, v2, v3, v4} f = &1 /\ l\r
6451   <=> (!w. w IN {v1,v2,v3,v4} ==> {v1} w ==> &0 < f w) /\\r
6452   sum {v1, v2, v3, v4} f = &1 /\ l `;\r
6453   SET_RULE` (!w. {v2} w ==> &0 < f w) /\\r
6454            sum {v1, v2, v3, v4} f = &1 /\ l\r
6455   <=> (!w. w IN {v1,v2,v3,v4} ==> {v2} w ==> &0 < f w) /\\r
6456   sum {v1, v2, v3, v4} f = &1 /\ l `;\r
6457   SET_RULE` (!w. {v2} w ==> &0 < f w) /\\r
6458            sum {v1, v2, v3, v4} f = &1 /\ l\r
6459   <=> (!w. w IN {v1,v2,v3,v4} ==> {v2} w ==> &0 < f w) /\\r
6460   sum {v1, v2, v3, v4} f = &1 /\ l `;\r
6461   SET_RULE` (!w. {v3} w ==> &0 < f w) /\\r
6462            sum {v1, v2, v3, v4} f = &1 /\ l\r
6463   <=> (!w. w IN {v1,v2,v3,v4} ==> {v3} w ==> &0 < f w) /\\r
6464   sum {v1, v2, v3, v4} f = &1 /\ l `;\r
6465   SET_RULE` (!w. {v4} w ==> &0 < f w) /\\r
6466            sum {v1, v2, v3, v4} f = &1 /\ l\r
6467   <=> (!w. w IN {v1,v2,v3,v4} ==> {v4} w ==> &0 < f w) /\\r
6468   sum {v1, v2, v3, v4} f = &1 /\ l `] THEN \r
6469  SIMP_TAC[AFFINE_HULL_FINITE_STEP_GEN;\r
6470             REAL_ARITH `&0 < x /\ &0 < y  ==> &0 < x + y`;\r
6471             REAL_ARITH ` &0 < x ==> &0 < x / &2`;\r
6472             FINITE_INSERT; CONJUNCT1 FINITE_RULES\r
6473 ; RIGHT_EXISTS_AND_THM]  THEN \r
6474 NHANH (NOT_COPLANAR_IMP_CARD4) THEN \r
6475 SIMP_TAC[IN_ACT_SING; CARD4; IN_SET3; DE_MORGAN_THM] THEN \r
6476 REWRITE_TAC[REAL_ARITH` a - b = c <=> a = b + c `; ZERO_NEUTRAL;\r
6477   VECTOR_ARITH`(a:real^N) - b = c <=> a = b + c `; VECTOR_ARITH` x +\r
6478   vec 0 = x `] THEN \r
6479 REWRITE_TAC[CONV0_4; IN_ELIM_THM] THEN \r
6480 NHANH (SPEC ` circumcenter {(v1:real^3), v2, v3, v4} ` ( GEN `v:real^3` (SPEC_ALL COEFS_4))) THEN \r
6481 STRIP_TAC THEN \r
6482 EQ_TAC THENL [\r
6483 MESON_TAC[]; \r
6484 UNDISCH_TAC ` !ta tb tc td.\r
6485           circumcenter {v1, v2, v3, v4} =\r
6486           ta % v1 + tb % v2 + tc % v3 + td % v4 /\\r
6487           ta + tb + tc + td = &1\r
6488           ==> ta = COEF4_1 v1 v2 v3 v4 (circumcenter {v1, v2, v3, v4}) /\\r
6489               tb = COEF4_2 v1 v2 v3 v4 (circumcenter {v1, v2, v3, v4}) /\\r
6490               tc = COEF4_3 v1 v2 v3 v4 (circumcenter {v1, v2, v3, v4}) /\\r
6491               td = COEF4_4 v1 v2 v3 v4 (circumcenter {v1, v2, v3, v4})` THEN \r
6492 REWRITE_TAC[MESON[]`&0 < v /\ ( ? b . P v b ) <=>\r
6493   (? b. &0 < v /\ P v b ) `] THEN \r
6494 REWRITE_TAC[MESON[]` &1 = a /\ aa = b <=> a = &1 /\ b = aa `] THEN \r
6495 ABBREV_TAC ` (vv:real^3) = circumcenter {v1, v2, v3, v4} ` THEN \r
6496 ABBREV_TAC ` a1 = COEF4_1 v1 v2 v3 v4 vv ` THEN \r
6497 ABBREV_TAC ` a2 = COEF4_2 v1 v2 v3 v4 vv ` THEN \r
6498 ABBREV_TAC ` a3 = COEF4_3 v1 v2 v3 v4 vv ` THEN \r
6499 ABBREV_TAC ` a4 = COEF4_4 v1 v2 v3 v4 vv ` THEN PHA THEN \r
6500 IMP_TAC THEN STRIP_TAC THEN STRIP_TAC THEN \r
6501 REPLICATE_TAC 4 (FIRST_X_ASSUM MP_TAC) THEN PHA THEN \r
6502 NHANH (MESON[]`(!ta tb tc td.\r
6503       vv = ta % v1 + tb % v2 + tc % v3 + td % v4 /\ ta + tb + tc + td = &1\r
6504       ==> ta = a1 /\ tb = a2 /\ tc = a3 /\ td = a4) /\\r
6505  a111  /\\r
6506  v + v' + v'' + v''' = &1 /\\r
6507  v % v1 + v' % v2 + v'' % v3 + v''' % v4 = vv /\\r
6508  (?v v' v'' v'''.\r
6509       &0 < v' /\\r
6510       v + v' + v'' + v''' = &1 /\\r
6511       v % v1 + v' % v2 + v'' % v3 + v''' % v4 = vv) /\\r
6512  (?v v' v'' v'''.\r
6513       &0 < v'' /\\r
6514       v + v' + v'' + v''' = &1 /\\r
6515       v % v1 + v' % v2 + v'' % v3 + v''' % v4 = vv) /\\r
6516  (?v v' v'' v'''.\r
6517       &0 < v''' /\\r
6518       v + v' + v'' + v''' = &1 /\\r
6519       v % v1 + v' % v2 + v'' % v3 + v''' % v4 = vv) ==>\r
6520   &0 < v' /\ &0 < v'' /\ &0 < v''' `) THEN MESON_TAC[]]);;\r
6521 \r
6522 \r
6523 \r
6524 \r
6525 let IMP_IN_AFF_LT = prove(`CARD {v1, v2, v3, v4} = 4 ==> ( (?v v' v'' v'''.\r
6526            v < &0 /\\r
6527            &1 = v + v' + v'' + v''' /\ vv =\r
6528            v % v1 + v' % v2 + v'' % v3 + v''' % v4) <=>\r
6529   vv IN aff_lt {v2,v3,v4} {v1} ) `,\r
6530 REWRITE_TAC[CARD4; IN_SET3; DE_MORGAN_THM] THEN SIMP_TAC[AFF_GES_GTS; IN_ELIM_THM]\r
6531 THEN REMOVE_TAC THEN \r
6532 MESON_TAC[REAL_ARITH` a + b + c + d = d + a + b + c `;\r
6533   VECTOR_ARITH` a + b + c + d = d + a + b + (c:real^N)`]);;\r
6534 \r
6535 \r
6536 \r
6537 \r
6538 (* LEMMA 85 *)\r
6539 let VBVYGGT = new_axiom `!(v1:real^3) v2 v3 v4.\r
6540          CARD {v1, v2, v3, v4} = 4 /\ ~coplanar {v1, v2, v3, v4}\r
6541          ==> circumcenter {v1, v2, v3, v4} IN affine hull {v1, v2, v3, v4} /\\r
6542              (?r. !v. v IN {v1, v2, v3, v4}\r
6543                       ==> r = dist (circumcenter {v1, v2, v3, v4},v)) /\\r
6544              (!p. p IN affine hull {v1, v2, v3, v4} /\\r
6545                   (?r. !v. v IN {v1, v2, v3, v4} ==> r = dist (p,v))\r
6546                   ==> p = circumcenter {v1, v2, v3, v4}) /\\r
6547              (let x12 = dist (v1,v2) pow 2 in\r
6548               let x13 = dist (v1,v3) pow 2 in\r
6549               let x14 = dist (v1,v4) pow 2 in\r
6550               let x23 = dist (v2,v3) pow 2 in\r
6551               let x24 = dist (v2,v4) pow 2 in\r
6552               let x34 = dist (v3,v4) pow 2 in\r
6553               let chi11 = chi x12 x13 x14 x23 x24 x34 in\r
6554               let chi22 = chi x12 x24 x23 x14 x13 x34 in\r
6555               let chi33 = chi x34 x13 x23 x14 x24 x12 in\r
6556               let chi44 = chi x34 x24 x14 x23 x13 x12 in\r
6557               circumcenter {v1, v2, v3, v4} =\r
6558               &1 / (&2 * delta x12 x13 x14 x23 x24 x34) %\r
6559               (chi11 % v1 + chi22 % v2 + chi33 % v3 + chi44 % v4)) `;;\r
6560 \r
6561 \r
6562 \r
6563 \r
6564 \r
6565 \r
6566 (* lemma 88 *)\r
6567 let VSMPQYO = prove(` ! v1 v2 v3 (v4:real^3).\r
6568          CARD {v1, v2, v3, v4} = 4 /\ ~ coplanar {v1,v2,v3,v4} \r
6569          ==> (let s = {v1, v2, v3, v4} in\r
6570               let x12 = dist (v1,v2) pow 2 in\r
6571               let x13 = dist (v1,v3) pow 2 in\r
6572               let x14 = dist (v1,v4) pow 2 in\r
6573               let x23 = dist (v2,v3) pow 2 in\r
6574               let x24 = dist (v2,v4) pow 2 in\r
6575               let x34 = dist (v3,v4) pow 2 in\r
6576               orientation s v1 (\t. t < &0) <=>\r
6577               chi x12 x13 x14 x23 x24 x34 < &0) `,\r
6578 REWRITE_TAC[orientation; affsign; lin_combo] THEN REPEAT GEN_TAC THEN \r
6579 LET_TAC THEN EXPAND_TAC "s" THEN \r
6580 REWRITE_TAC[CARD4; SET_RULE` ( a INSERT s) DIFF {a} UNION {a} = \r
6581   a INSERT s `] THEN \r
6582 REWRITE_TAC[MESON[]` a = b /\ c /\ d <=> c /\ d /\ b = a `] THEN \r
6583 ONCE_REWRITE_TAC[SET_RULE` {v1} w ==> P <=> w IN {v1,v2,v3,v4} ==>\r
6584   {v1} w ==> P `] THEN  SIMP_TAC[AFFINE_HULL_FINITE_STEP_GEN;\r
6585             REAL_ARITH `x < &0 /\ y < &0 ==> x + y < &0`;\r
6586             REAL_ARITH `x < &0 ==> x / &2 < &0`;\r
6587             FINITE_INSERT; CONJUNCT1 FINITE_RULES\r
6588 ; RIGHT_EXISTS_AND_THM]  THEN \r
6589 SIMP_TAC[IN_ACT_SING; IN_SET3; DE_MORGAN_THM] THEN \r
6590 SIMP_TAC[REAL_ARITH` a - b = c <=> a = b + c `; ZERO_NEUTRAL;\r
6591   VECTOR_ARITH` a - b = c <=> a = b + (c:real^y)`; VECTOR_ADD_RID;\r
6592   RIGHT_AND_EXISTS_THM] THEN \r
6593 REWRITE_TAC[GSYM DE_MORGAN_THM; GSYM IN_SET3] THEN \r
6594 REWRITE_TAC[DE_MORGAN_THM] THEN \r
6595 REWRITE_TAC[MESON[]` a1 /\ ~ a /\ ~ b /\ ~ ( c = d )  <=> a1 /\ ~ ( a \/ b \/ \r
6596   c = d ) `; GSYM CARD4 ] THEN NHANH (SPEC_ALL VBVYGGT) THEN STRIP_TAC THEN \r
6597 UNDISCH_TAC ` CARD {(v1:real^3), v2, v3, v4} = 4` THEN \r
6598 SIMP_TAC[IMP_IN_AFF_LT ] THEN \r
6599 UNDISCH_TAC `~coplanar {(v1:real^3), v2, v3, v4}` THEN \r
6600 SIMP_TAC[ GSYM SRGTIHY] THEN \r
6601 NHANH (SPECL [` v1:real^3`; `v2:real^3`;`v3:real^3`;`v4:real^3`; \r
6602   ` circumcenter {(v1:real^3), v2, v3, v4} `] COEFS_4) THEN \r
6603 MP_TAC (GEN_ALL SUM_CHI_EQ_2DELTA ) THEN \r
6604 ABBREV_TAC ` p = circumcenter {(v1:real^3), v2, v3, v4}` THEN \r
6605 ABBREV_TAC `c1 = COEF4_1 v1 v2 v3 v4 p` THEN \r
6606 ABBREV_TAC `c2 = COEF4_2 v1 v2 v3 v4 p` THEN \r
6607 ABBREV_TAC `c3 = COEF4_3 v1 v2 v3 v4 p` THEN \r
6608 ABBREV_TAC `c4 = COEF4_4 v1 v2 v3 v4 p` THEN \r
6609 PHA THEN STRIP_TAC THEN \r
6610 REPLICATE_TAC 12 (FIRST_X_ASSUM MP_TAC) THEN \r
6611 REPEAT LET_TAC THEN EXPAND_TAC "chi11" THEN \r
6612 EXPAND_TAC "chi22" THEN EXPAND_TAC "chi33" THEN \r
6613 EXPAND_TAC "chi44" THEN \r
6614 REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; \r
6615   REAL_ARITH` ( &1 / a ) * b = b / a `] THEN \r
6616 REWRITE_TAC[GSYM POS_EQ_NOT_COPLANANR ] THEN \r
6617 REPLICATE_TAC 7 STRIP_TAC THEN \r
6618 UNDISCH_TAC ` dist ((v1:real^3),v2) pow 2 = x12 ` THEN \r
6619 UNDISCH_TAC ` dist ((v1:real^3),v3) pow 2 = x13 ` THEN \r
6620 UNDISCH_TAC ` dist ((v1:real^3),v4) pow 2 = x14 ` THEN \r
6621 UNDISCH_TAC ` dist ((v2:real^3),v3) pow 2 = x23 ` THEN \r
6622 UNDISCH_TAC ` dist ((v2:real^3),v4) pow 2 = x24 ` THEN \r
6623 UNDISCH_TAC ` dist ((v3:real^3),v4) pow 2 = x34 ` THEN \r
6624 REWRITE_TAC[MESON[]` a = b ==> P a <=> a = b ==> P b `] THEN \r
6625 NHANH (REAL_ARITH` &0 < a ==> ~( a = &0 ) `) THEN \r
6626 NHANH (NOT_0_IMP_SUM_CHI_1 ) THEN REPEAT STRIP_TAC THEN \r
6627 UNDISCH_TAC ` &0 < delta x12 x13 x14 x23 x24 x34 ` THEN \r
6628 ONCE_REWRITE_TAC[\r
6629 prove(` &0 < p a ==> ( aa <=> q a < &0)  <=> &0 < p a ==> ( aa <=> (  q a ) / ( &2 * p a ) < &0 ) `,\r
6630 REWRITE_TAC[REAL_ARITH` a < &0 <=> &0 < -- a `;\r
6631   REAL_ARITH ` -- ( a / b ) = ( -- a ) / b `] THEN \r
6632 MESON_TAC[REAL_LT_RDIV_0; REAL_ARITH` &0 < a <=> &0 < &2 * a `])] THEN \r
6633 ABBREV_TAC ` c11 = chi x12 x13 x14 x23 x24 x34 / (&2 * delta x12 x13 x14 x23 x24 x34) ` THEN \r
6634 ABBREV_TAC ` c22 = chi x12 x24 x23 x14 x13 x34 / (&2 * delta x12 x13 x14 x23 x24 x34) ` THEN \r
6635 ABBREV_TAC ` c33 = chi x34 x13 x23 x14 x24 x12 / (&2 * delta x12 x13 x14 x23 x24 x34) ` THEN \r
6636 ABBREV_TAC ` c44 = chi x34 x24 x14 x23 x13 x12 / (&2 * delta x12 x13 x14 x23 x24 x34) ` THEN \r
6637 REPLICATE_TAC 5 (FIRST_X_ASSUM MP_TAC THEN REMOVE_TAC) THEN \r
6638 REPLICATE_TAC 4 (FIRST_X_ASSUM MP_TAC) THEN UNDISCH_TAC \r
6639 ` (p:real^3) = c11 % v1 + c22 % v2 + c33 % v3 + c44 % v4` THEN MESON_TAC[]);;\r
6640 \r
6641 \r
6642 \r
6643 \r
6644 \r
6645 \r
6646 \r
6647 \r
6648 \r
6649 \r
6650 \r
6651 \r
6652 let SQRT4_EQ2 = prove(` sqrt ( &4 ) = &2 `,\r
6653 REWRITE_TAC[REAL_ARITH` &4 = &2 pow 2 `] THEN \r
6654 MESON_TAC[POW_2_SQRT; REAL_ARITH` &0 <= &2 `]);;\r
6655 \r
6656 \r
6657 \r
6658 \r
6659 \r
6660 \r
6661 \r
6662 \r
6663 \r
6664 let RHUFIIB = prove( ` !x12 x13 x14 x23 x24 x34.\r
6665          rho x12 x13 x14 x23 x24 x34 * ups_x x34 x24 x23 =\r
6666          chi x12 x13 x14 x23 x24 x34 pow 2 +\r
6667          &4 * delta x12 x13 x14 x23 x24 x34 * x34 * x24 * x23 `,\r
6668 REWRITE_TAC[rho; chi; delta; ups_x] THEN REAL_ARITH_TAC);;\r
6669 \r
6670 \r
6671 (* lemma 84 *)\r
6672 let SHOGYBS = prove(` ! x1 x2 x3 (x4:real^3).\r
6673   ~coplanar {x1,x2,x3,x4} ==>\r
6674          let x12 = dist (x1,x2) pow 2 in\r
6675          let x13 = dist (x1,x3) pow 2 in\r
6676          let x14 = dist (x1,x4) pow 2 in\r
6677          let x23 = dist (x2,x3) pow 2 in\r
6678          let x24 = dist (x2,x4) pow 2 in\r
6679          let x34 = dist (x3,x4) pow 2 in\r
6680   &0 <= rho x12 x13 x14 x23 x24 x34  `,\r
6681 ONCE_REWRITE_TAC[SET_RULE` {v1,v2,v3,v4} =  {v2,v3,v4,v1} `] THEN \r
6682 NHANH (NOT_COPLANAR_IMP_NOT_COLLINEAR) THEN \r
6683 ONCE_REWRITE_TAC[GSYM (SET_RULE` {v1,v2,v3,v4} =  {v2,v3,v4,v1} `)] THEN \r
6684 REWRITE_TAC[NOT_COL_EQ_UPS_X_POS] THEN REPEAT GEN_TAC THEN \r
6685 MP_TAC (SPEC_ALL DELTA_POS_4POINTS) THEN \r
6686 REPEAT LET_TAC THEN MP_TAC (SPEC_ALL RHUFIIB) THEN DOWN_TAC THEN \r
6687 NHANH (MESON[REAL_LE_POW_2]` a pow 2 = b   ==> &0 <= b `) THEN DAO THEN \r
6688 SIMP_TAC[UPS_X_SYM] THEN \r
6689 REWRITE_TAC[MESON[REAL_FIELD` &0 < a ==> (b * a = c <=> b = c / a )`]`\r
6690   &0 < a /\a1 /\a2/\ b * a = c /\l <=>  &0 < a /\a1 /\a2/\ b = c / a /\ l `] THEN \r
6691 MP_TAC (REAL_ARITH` &0 <= &4 `) THEN PHA THEN \r
6692 NHANH (MESON[REAL_LT_IMP_LE; REAL_LE_DIV;\r
6693   REAL_LE_MUL; REAL_LE_ADD; REAL_LE_POW_2]`  &0 <= &4 /\\r
6694  &0 < ups_x x23 x24 x34 /\a1/\\r
6695  &0 <= delta x12 x13 x14 x23 x24 x34 /\ a2 /\\r
6696  &0 <= x34 /\a3 /\ &0 <= x24 /\a4 /\ &0 <= x23 /\a5/\\r
6697  &0 <= x14 /\a6 /\ &0 <= x13 /\a7 /\a8 /\ &0 <= x12 ==> \r
6698   &0 <= &4 * delta x12 x13 x14 x23 x24 x34 * x34 * x24 * x23 `) THEN \r
6699 ABBREV_TAC ` aaa = &4 * delta x12 x13 x14 x23 x24 x34 * x34 * x24 * x23 ` THEN STRIP_TAC THEN \r
6700 FIRST_X_ASSUM MP_TAC THEN UNDISCH_TAC ` rho x12 x13 x14 x23 x24 x34 =\r
6701       (chi x12 x13 x14 x23 x24 x34 pow 2 + aaa) / ups_x x23 x24 x34 ` THEN \r
6702 UNDISCH_TAC`&0 < ups_x x23 x24 x34` THEN MESON_TAC[REAL_LT_IMP_LE; REAL_LE_DIV;\r
6703   REAL_LE_MUL; REAL_LE_ADD; REAL_LE_POW_2]);;\r
6704 \r
6705 \r
6706 (* le 86 . GDRQXLG *)\r
6707 \r
6708 \r
6709 let GDRQXLG = prove(` ! v1 v2 v3 (v4:real^3).\r
6710   let s = {v1, v2, v3, v4} in\r
6711 let x12 = dist (v1,v2) pow 2 in\r
6712                     let x13 = dist (v1,v3) pow 2 in\r
6713                     let x14 = dist (v1,v4) pow 2 in\r
6714                     let x23 = dist (v2,v3) pow 2 in\r
6715                     let x24 = dist (v2,v4) pow 2 in\r
6716                     let x34 = dist (v3,v4) pow 2 in\r
6717      CARD s = 4 /\ ~coplanar s\r
6718      ==> radV s =\r
6719         sqrt ( rho x12 x13 x14 x23 x24 x34) /\r
6720          (&2 * sqrt (delta x12 x13 x14 x23 x24 x34))`,\r
6721 REPEAT GEN_TAC THEN REPEAT LET_TAC THEN EXPAND_TAC "s" THEN \r
6722 NHANH (NOT_COPLANAR_IMP_RADV_PROPERTIES) THEN \r
6723 NHANH (REWRITE_RULE[RIGHT_FORALL_IMP_THM] (GEN `p:real^3` PROVE_DIST_FROM_V1  )) THEN \r
6724 NHANH (REWRITE_RULE[RIGHT_FORALL_IMP_THM] (GEN `p:real^3` PROVE_EQ_DIST_FROM4 ) ) THEN \r
6725 REWRITE_TAC[GSYM POS_EQ_NOT_COPLANANR] THEN \r
6726 NHANH (REAL_ARITH` &0 < a ==> ~( a = &0 )`) THEN \r
6727 NHANH (PROVE_IN_AFFINE_HULL_4 ) THEN LET_TR THEN \r
6728 REWRITE_TAC[MESON[]`(!x. x = a ==> p x) <=> p a `] THEN \r
6729 ABBREV_TAC `taa = (&1 /    (&2 *\r
6730      delta (dist (v1,v2) pow 2) (dist (v1,v3) pow 2) (dist (v1,v4) pow 2)\r
6731      (dist (v2,v3) pow 2)\r
6732      (dist (v2,v4) pow 2)\r
6733      (dist (v3,v4) pow 2)) %\r
6734     (chi (dist (v1,v2) pow 2) (dist (v1,v3) pow 2) (dist (v1,v4) pow 2)\r
6735      (dist (v2,v3) pow 2)\r
6736      (dist (v2,v4) pow 2)\r
6737      (dist (v3,v4) pow 2) %\r
6738      (v1:real^3) +\r
6739      chi (dist (v1,v2) pow 2) (dist (v2,v4) pow 2) (dist (v2,v3) pow 2)\r
6740      (dist (v1,v4) pow 2)\r
6741      (dist (v1,v3) pow 2)\r
6742      (dist (v3,v4) pow 2) %\r
6743      v2 +\r
6744      chi (dist (v3,v4) pow 2) (dist (v1,v3) pow 2) (dist (v2,v3) pow 2)\r
6745      (dist (v1,v4) pow 2)\r
6746      (dist (v2,v4) pow 2)\r
6747      (dist (v1,v2) pow 2) %\r
6748      v3 +\r
6749      chi (dist (v3,v4) pow 2) (dist (v2,v4) pow 2) (dist (v1,v4) pow 2)\r
6750      (dist (v2,v3) pow 2)\r
6751      (dist (v1,v3) pow 2)\r
6752      (dist (v1,v2) pow 2) %\r
6753      v4)) ` THEN \r
6754 REWRITE_TAC[ POS_EQ_NOT_COPLANANR] THEN NGOAC THEN \r
6755 NHANH (SPEC_ALL UNIQUE_EXISISTING_PROPERTY_C4 ) THEN \r
6756 REWRITE_TAC[FORALL_IN_CLAUSES] THEN ABBREV_TAC ` abc = &1 / &2 *\r
6757  rho (dist (v1,v2) pow 2) (dist (v1,v3) pow 2) (dist (v1,v4) pow 2)\r
6758  (dist (v2,v3) pow 2) (dist (v2,v4) pow 2) (dist (v3,v4) pow 2) /\r
6759  (&2 *\r
6760   delta (dist ((v1:real^3),v2) pow 2) (dist (v1,v3) pow 2) (dist (v1,v4) pow 2)\r
6761   (dist (v2,v3) pow 2)\r
6762   (dist (v2,v4) pow 2)\r
6763   (dist (v3,v4) pow 2)) ` THEN REWRITE_TAC[d3] THEN \r
6764 NHANH (MESON[POW_2_SQRT; DIST_POS_LE]` dist (taa,v2) pow 2 = a ==>\r
6765   dist(taa,v2) = sqrt a `) THEN PHA THEN \r
6766 NHANH (MESON[]`(!p. p IN affine hull {v1, v2, v3, v4} /\\r
6767       (?r. r = dist (p,v1) /\\r
6768            r = dist (p,v2) /\\r
6769            r = dist (p,v3) /\\r
6770            r = dist (p,v4))\r
6771       ==> p = circumcenter {v1, v2, v3, v4}) /\ a11 /\\r
6772  taa IN affine hull {v1, v2, v3, v4} /\\r
6773  dist (taa,v2) pow 2 = abc /\\r
6774  dist (taa,v2) = sqrt abc /\\r
6775  dist (taa,v3) pow 2 = abc /\\r
6776  dist (taa,v3) = sqrt abc /\\r
6777  dist (taa,v4) pow 2 = abc /\\r
6778  dist (taa,v4) = sqrt abc /\\r
6779  dist (taa,v1) pow 2 = abc /\\r
6780  dist (taa,v1) = sqrt abc /\ lll ==> taa = circumcenter {v1, v2, v3, v4} `) THEN \r
6781 NHANH (SET_RULE ` (!w. {v1, v2, v3, v4} w ==> P w ) ==> P v1 `) THEN PHA THEN \r
6782 REWRITE_TAC[MESON[]` a = dist (aa,b) /\ ta = aa <=> ta = aa  /\ a = dist (ta,b) `] THEN \r
6783 NHANH (MESON[]` a = b /\ a1 /\ a2 /\ c = a ==> c = b `) THEN NHANH (SPEC_ALL SHOGYBS) THEN \r
6784 MP_TAC (SPECL [`v1:real^3`;` v2:real^3`;`v3:real^3`;`v4:real^3`] \r
6785 DELTA_POS_4POINTS) THEN REPEAT LET_TAC THEN IMP_TAC THEN REPEAT (FIRST_X_ASSUM MP_TAC) THEN \r
6786 REWRITE_TAC[MESON[]` a = b ==> P a <=> a = b ==> P b `] THEN \r
6787 REWRITE_TAC[MESON[]` a = b ==> a = c <=> a = b ==> c = b `] THEN REPEAT STRIP_TAC THEN \r
6788 UNDISCH_TAC ` &1 / &2 *      rho x12 x13 x14 x23 x24 x34 / (&2 * delta x12 x13 x14 x23 x24 x34) =\r
6789       abc ` THEN UNDISCH_TAC ` &0 <= rho x12 x13 x14 x23 x24 x34 ` THEN \r
6790 ABBREV_TAC ` edl = delta x12 x13 x14 x23 x24 x34 ` THEN UNDISCH_TAC` &0 <= edl ` THEN \r
6791 SIMP_TAC[REAL_ARITH` &0 <= &4 `; GSYM SQRT_MUL; GSYM SQRT4_EQ2] THEN \r
6792 SIMP_TAC[REAL_ARITH` &0 <= &4 `; REAL_LE_MUL;  GSYM SQRT_DIV] THEN \r
6793 REWRITE_TAC[SQRT4_EQ2] THEN MESON_TAC[REAL_FIELD` &1 / &2 * x34 / (&2 * edl) =  x34 / (&4 * edl)`]);;\r
6794 \r
6795 \r
6796 let BAJSVHC =  ` ! v1 v2 v3 v4 (v5:real^3).\r
6797    CARD {v1, v2, v3, v4, v5} = 5 /\\r
6798      ~coplanar {v1, v2, v3, v4} /\\r
6799      v5 IN aff_ge {v1, v3} {v2, v4} /\\r
6800      ~(v5 IN aff {v1, v3})\r
6801      ==> aff_ge {v1, v3} {v2, v4} =\r
6802          aff_ge {v1, v3} {v2, v5} UNION aff_ge {v1, v3} {v4, v5} /\\r
6803          aff_gt {v1, v3} {v2, v5} INTER aff_gt {v1, v3} {v4, v5} = {}`;;\r
6804 let LEMMA104 = BAJSVHC;;\r
6805 \r
6806 \r
6807 \r
6808 \r
6809 \r
6810 let AFF_GE22 = prove(`!v1 v2 w1 (w2:real^N).\r
6811      {v1, v2} INTER {w1, w2} = {}\r
6812      ==> aff_ge {v1, v2} {w1, w2} =\r
6813          {x | ?a1 a2 b1 b2.\r
6814                   &0 <= b1 /\\r
6815                   &0 <= b2 /\\r
6816                   a1 + a2 + b1 + b2 = &1 /\\r
6817                   x = a1 % v1 + a2 % v2 + b1 % w1 + b2 % w2}`,\r
6818 REWRITE_TAC[aff_ge_def; affsign; FUN_EQ_THM; lin_combo; sgn_ge] THEN \r
6819 REWRITE_TAC[MESON[]` (a = aa )/\ (! w. P w ) /\ b <=>\r
6820   (!w. P w ) /\ b /\ ( aa = a ) `] THEN \r
6821 ONCE_REWRITE_TAC[SET_RULE` {w1, w2} w ==> P w <=> w IN ( v1 INSERT ( v2 \r
6822   INSERT {w1, w2} )) ==> {w1, w2} w ==> P w `;\r
6823   SET_RULE` {a,b} UNION {c,d} = {a,b,c,d} `] THEN \r
6824 SIMP_TAC[AFFINE_HULL_FINITE_STEP_GEN;\r
6825             REAL_ARITH `&0 <= x /\ &0 <= y ==> &0 <= x + y`;\r
6826             REAL_ARITH `&0 <= x ==> &0 <= x / &2`;\r
6827             FINITE_INSERT; CONJUNCT1 FINITE_RULES\r
6828 ; RIGHT_EXISTS_AND_THM]  THEN \r
6829 SIMP_TAC[SET_RULE`(!x. ({v1, v2} INTER {w1, w2}) x <=> {} x)\r
6830   <=> ~ ({w1,w2} v1 ) /\ ~({w1,w2} v2 )`;\r
6831   SET_RULE` {a,b} a /\ {a,b} b `] THEN \r
6832 REPEAT STRIP_TAC THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM; IN_ELIM_THM;\r
6833   REAL_ARITH` a - b = c <=> a = b + c `; ZERO_NEUTRAL;\r
6834   VECTOR_ARITH` a - b = c <=> a = b + (c:real^N)`; VECTOR_ADD_RID;\r
6835   REAL_ARITH` &1 = a <=> a = &1 `]);;\r
6836 \r
6837 \r
6838 \r
6839 \r
6840 \r
6841 let PROVE_UNION_AFF22_SUBSET = prove(` ! v1 v2 v3 v4 (v5:real^3).\r
6842    CARD {v1, v2, v3, v4, v5} = 5 /\ ~coplanar {v1, v2, v3, v4} /\\r
6843      v5 IN aff_ge {v1, v3} {v2, v4} /\\r
6844      ~(v5 IN aff {v1, v3})\r
6845      ==>  aff_ge {v1, v3} {v2, v5} UNION aff_ge {v1, v3} {v4, v5} \r
6846  SUBSET aff_ge {v1, v3} {v2, v4} `,\r
6847 REWRITE_TAC[UNION_SUBSET] THEN \r
6848 ONCE_REWRITE_TAC[MESON[INSERT_AC]` a /\ b SUBSET \r
6849   s {v1,v2} <=> a /\ b SUBSET s {v2,v1} `] THEN \r
6850 MATCH_MP_TAC (MESON[]` (! v1 v2 v3 v4 v5. P v1 v2 v3 v4 v5 <=>\r
6851   P v1 v4 v3 v2 v5 ) /\ (! v1 v2 v3 v4 v5.\r
6852   P v1 v2 v3 v4 v5 ==> Q v1 v2 v3 v4 v5 ) ==>\r
6853   (! v1 v2 v3 v4 v5. P v1 v2 v3 v4 v5 ==>\r
6854   Q v1 v2 v3 v4 v5 /\ Q v1 v4 v3 v2 v5 ) `) THEN \r
6855 SIMP_TAC[INSERT_AC] THEN REPEAT GEN_TAC THEN \r
6856 ONCE_REWRITE_TAC[SET_RULE ` {a,b,c,d,e} = {e,a,b,c,d}`] THEN \r
6857 REWRITE_TAC[CARD5] THEN \r
6858 NHANH (SET_RULE` ~(v1 IN {v2, v3, v4}) /\\r
6859       ~(v2 = v3 \/ v3 = v4 \/ v4 = v2) ==>\r
6860   {v1,v3} INTER {v2,v4} = {} `) THEN \r
6861 NHANH (SPEC_ALL AFF_GE22) THEN PHA THEN \r
6862 REWRITE_TAC[IN_ELIM_THM; MESON[]` a = b /\ a1 /\ v IN a /\l <=>\r
6863   a = b /\ a1 /\ v IN b /\ l`] THEN \r
6864 NHANH (SET_RULE` ~(v5 IN {v1, v2, v3, v4}) /\\r
6865  ~(v1 IN {v2, v3, v4}) /\\r
6866  ~(v2 = v3 \/ v3 = v4 \/ v4 = v2) /\ l ==>\r
6867   {v1,v3} INTER {v2,v5} = {} /\\r
6868   {v1,v3} INTER {v4,v5} = {} `) THEN \r
6869 SIMP_TAC[AFF_GE22] THEN STRIP_TAC THEN \r
6870 SIMP_TAC[UNION_SUBSET; SUBSET; IN_ELIM_THM] THEN \r
6871 GEN_TAC THEN STRIP_TAC THEN \r
6872 UNDISCH_TAC ` x = a1' % v1 + a2' % v3 + b1' % v2 + b2' % (v5:real^3)` THEN \r
6873 UNDISCH_TAC ` v5 = a1 % v1 + a2 % v3 + b1 % v2 + b2 % (v4:real^3)` THEN \r
6874 PHA THEN \r
6875 PURE_ONCE_REWRITE_TAC[MESON[]` a = b /\ P a <=> a = b /\ P (b:real^3) `] THEN \r
6876 REWRITE_TAC[VECTOR_ARITH` a1' % v1 + a2' % v3 + b1' % v2 +\r
6877  b2' % (a1 % v1 + a2 % v3 + b1 % v2 + b2 % v4) =\r
6878   (a1' + b2' * a1 ) % v1 + (a2' + b2' * a2 ) % v3\r
6879   + (b1' + b2' * b1 ) % v2 + (b2' * b2 ) % v4 `] THEN \r
6880 STRIP_TAC THEN EXISTS_TAC `a1' + b2' * a1` THEN \r
6881 EXISTS_TAC `a2' + b2' * a2` THEN \r
6882 EXISTS_TAC `b1' + b2' * b1` THEN EXISTS_TAC `b2' * b2` THEN \r
6883 ASM_SIMP_TAC[REAL_LE_ADD; REAL_LE_MUL;\r
6884 prove(`a1 + a2 + b1 + b2 = &1 /\ a1' + a2' + b1' + b2' = &1\r
6885  ==> (a1' + b2' * a1) + (a2' + b2' * a2) + (b1' + b2' * b1) + b2' * b2 = &1`,\r
6886 SIMP_TAC[REAL_ARITH` a + b = c <=> a = c - b `] THEN REAL_ARITH_TAC)]);;\r
6887 \r
6888 \r
6889 \r
6890 \r
6891 \r
6892 \r
6893 \r
6894 \r
6895 \r
6896 (* AFF_GES_GTS *)\r
6897 \r
6898 let AFF_GT21 = MESON[AFF_GES_GTS]`!a b v0.\r
6899          ~(a = v0) /\ ~(b = v0) \r
6900          ==> aff_gt {a, b} {v0} =\r
6901              {x | ?ta tb t.\r
6902                       ta + tb + t = &1 /\\r
6903                       &0 < t /\\r
6904                       x = ta % a + tb % b + t % v0}`;;\r
6905  let AFF_GE21 = MESON[AFF_GES_GTS]`!a b v0.\r
6906          ~(a = v0) /\ ~(b = v0) \r
6907          ==> aff_ge {a, b} {v0} =\r
6908              {x | ?ta tb t.\r
6909                       ta + tb + t = &1 /\\r
6910                       &0 <= t /\\r
6911                       x = ta % a + tb % b + t % v0}`;;\r
6912 \r
6913 \r
6914 let AFF_GT31 = MESON[AFF_GES_GTS]`!a b c v0.\r
6915          ~(a = v0) /\ ~(b = v0) /\ ~(c = v0 )\r
6916          ==> aff_gt {a, b, c} {v0} =\r
6917              {x | ?ta tb tc t.\r
6918                       &0 < t /\\r
6919                       ta + tb + tc + t = &1 /\\r
6920                       x = ta % a + tb % b + tc % c + t % v0}`;;\r
6921 let AFF_GE31 = MESON[AFF_GES_GTS]`!a b c v0.\r
6922          ~(a = v0) /\ ~(b = v0) /\ ~(c = v0 )\r
6923          ==> aff_ge {a, b, c} {v0} =\r
6924              {x | ?ta tb tc t.\r
6925                       &0 <= t /\\r
6926                       ta + tb + tc + t = &1 /\\r
6927                       x = ta % a + tb % b + tc % c + t % v0}`;;\r
6928 \r
6929 \r
6930 \r
6931 \r
6932 \r
6933 \r
6934 \r
6935 let AFF_GE21_SUBSET_AFF22 = prove(`{a,b} INTER {x,y} = {}\r
6936 ==>  aff_ge {a,b} {y} SUBSET aff_ge {a,b} {x,y} `,\r
6937 NHANH (SET_RULE ` {a,b} INTER {x,y} = {} ==>\r
6938    ~ ( a = y ) /\ ~ ( b = y ) `) THEN \r
6939 SIMP_TAC[AFF_GE22; AFF_GE21; SUBSET; IN_ELIM_THM] THEN \r
6940 REPEAT STRIP_TAC THEN \r
6941 EXISTS_TAC`ta :real` THEN \r
6942 EXISTS_TAC`tb :real` THEN \r
6943 EXISTS_TAC`&0 ` THEN \r
6944 EXISTS_TAC`t :real` THEN \r
6945 ASM_SIMP_TAC[REAL_LE_REFL; ZERO_NEUTRAL; \r
6946 VECTOR_MUL_LZERO; VECTOR_ADD_LID]);;\r
6947 \r
6948 \r
6949 \r
6950 \r
6951 \r
6952 \r
6953 \r
6954 \r
6955 \r
6956 \r
6957 let V5_IN_AFF21_IMP_SET_EQ = prove(`   (v5:real^3) IN aff_ge {v1, v3} {v4} /\\r
6958  ~coplanar {v1, v2, v3, v4} /\\r
6959  ~(v5 IN aff {v1, v3}) /\ CARD {v1, v2, v3, v4, v5} = 5 \r
6960  ==> aff_ge {v1, v3} {v2, v4} = aff_ge {v1, v3} {v2, v5}`,\r
6961 REWRITE_TAC[CARD5] THEN NHANH (SET_RULE` ~(v1 IN {v2, v3, v4, v5}) /\\r
6962  ~(v2 IN {v3, v4, v5}) /\ ~(v3 = v4 \/ v4 = v5 \/ v5 = v3) ==>  {v1,v3} INTER {v2,v4} = {} `) THEN \r
6963 NHANH (AFF_GE21_SUBSET_AFF22 ) THEN REWRITE_TAC[ GSYM CARD5] THEN \r
6964 REWRITE_TAC[MESON[]` x IN s /\l <=> l /\ x IN s `] THEN  PHA THEN \r
6965 NHANH (SET_RULE ` a SUBSET b /\ x IN a ==> x IN b `) THEN ONCE_REWRITE_TAC[MESON[]` a1 /\ a2 /\ CARD s = 5\r
6966   /\ a4 /\ a5 /\ a6 <=>a4 /\ a5 /\ CARD s = 5 /\ a1 /\a6 /\a2 `] THEN \r
6967 NHANH (SPEC_ALL PROVE_UNION_AFF22_SUBSET ) THEN SIMP_TAC[UNION_SUBSET; SET_EQ_TO_SUBSET] THEN \r
6968 SIMP_TAC[GSYM SET_EQ_TO_SUBSET; CARD5] THEN NHANH (SET_RULE` ~(v1 IN {v2, v3, v4, v5}) /\\r
6969    ~(v2 IN {v3, v4, v5}) /\   ~(v3 = v4 \/ v4 = v5 \/ v5 = v3) ==>\r
6970   {v1, v3} INTER {v2, v5} = {} `) THEN SIMP_TAC[AFF_GE22] THEN \r
6971 REWRITE_TAC[GSYM SET_EQ_TO_SUBSET; SET_RULE ` {v1, v3} INTER {v2, v4} = {}\r
6972   <=> ~(v1 = v4) /\ ~(v3 = v4) /\ ~(v1 = v2) /\ ~(v3 = v2)`] THEN \r
6973 ONCE_REWRITE_TAC[MESON[]` a /\b ==> c <=> a ==> b ==> c `] THEN SIMP_TAC[AFF_GE21] THEN \r
6974 REWRITE_TAC[IN_ELIM_THM; AFF_2POINTS_INTERPRET] THEN REPEAT STRIP_TAC THEN \r
6975 ASM_CASES_TAC `t = &0 ` THENL [UNDISCH_TAC `ta + tb + t = &1` THEN \r
6976 UNDISCH_TAC `(v5:real^3) = ta % v1 + tb % v3 + t % v4` THEN UNDISCH_TAC` t = &0 ` THEN \r
6977 SIMP_TAC[ZERO_NEUTRAL; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN PHA THEN ASM_MESON_TAC[];\r
6978 REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN \r
6979 UNDISCH_TAC `x = a1 % v1 + a2 % v3 + b1 % v2 + b2 % (v4:real^3)` THEN \r
6980 ONCE_REWRITE_TAC[MESON[]` a ==> b <=> ~b ==> ~ a `] THEN DISCH_TAC THEN \r
6981 ONCE_REWRITE_TAC[VECTOR_ARITH` x = a <=> x = a - (b2 /t) % (v5:real^3) + (b2 /t) % (v5:real^3)`] THEN \r
6982 UNDISCH_TAC` (v5:real^3) = ta % v1 + tb % v3 + t % v4 ` THEN SIMP_TAC[] THEN \r
6983 REWRITE_TAC[VECTOR_ARITH` (a1 % v1 + a2 % v3 + b1 % v2 + b2 % v4) -\r
6984         tt % (ta % v1 + tb % v3 + t % v4) =   ( a1 - tt * ta ) % v1 + ( a2 - tt * tb ) % v3  + b1 % v2 +\r
6985   ( b2 - tt * t ) % v4 `] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN \r
6986 UNDISCH_TAC`~(t = &0 )` THEN SIMP_TAC[REAL_FIELD` ~( a = &0) ==> b / a * a = b `;\r
6987   REAL_SUB_REFL; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN UNDISCH_TAC`ta + tb + t = &1` THEN \r
6988 UNDISCH_TAC ` a1 + a2 + b1 + b2 = &1 ` THEN PHA THEN DAO THEN NHANH (REAL_FIELD` ~(t = &0) /\\r
6989  a1 + a2 + b1 + b2 = &1 /\ ta + tb + t = &1 ==> a1 - b2 / t * ta + a2 - b2 / t * tb + b1 + b2 / t = &1`) THEN \r
6990 UNDISCH_TAC ` &0 <= b2 ` THEN UNDISCH_TAC ` &0 <= t ` THEN PHA THEN \r
6991 NHANH (MESON[REAL_LE_DIV]` &0 <= t /\ &0 <= b /\ l ==> &0 <= b / t `) THEN \r
6992 REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN REWRITE_TAC[VECTOR_ARITH` ((a:real^N) + b ) + c =\r
6993   a + b + c `] THEN MESON_TAC[]]);;\r
6994 \r
6995 \r
6996 \r
6997 \r
6998 \r
6999 \r
7000 \r
7001 \r
7002 \r
7003 \r
7004 \r
7005 \r
7006 \r
7007 \r
7008 let AFF_GT22 = prove( `{(a:real^N), b} INTER {x, y} = {}\r
7009  ==> aff_gt {a, b} {x, y} =\r
7010      {w | ?ta tb tx ty.\r
7011               &0 < tx /\\r
7012               &0 < ty /\\r
7013               ta + tb + tx + ty = &1 /\\r
7014               w = ta % a + tb % b + tx % x + ty % y}`,\r
7015 REWRITE_TAC[aff_gt_def; FUN_EQ_THM; affsign; sgn_gt;\r
7016   lin_combo] THEN \r
7017 ONCE_REWRITE_TAC[SET_RULE` {x, y} w ==> P <=>\r
7018   w IN ({a, b} UNION {x, y}) ==> {x, y} w ==> P`] THEN \r
7019 REWRITE_TAC[MESON[]` a = b /\ cc /\ j <=> cc /\ j \r
7020   /\ b = a `] THEN \r
7021 REWRITE_TAC[SET_RULE` {a, b} UNION {x, y} =\r
7022   {a,b,x,y}`] THEN \r
7023  SIMP_TAC[AFFINE_HULL_FINITE_STEP_GEN;\r
7024             REAL_ARITH `&0 < x /\ &0 < y ==> &0 < x + y`;\r
7025             REAL_ARITH `&0 < x ==> &0 < x / &2`;\r
7026             FINITE_INSERT; CONJUNCT1 FINITE_RULES\r
7027 ; RIGHT_EXISTS_AND_THM]  THEN \r
7028 NHANH (SET_RULE` (!x'. ({a, b} INTER {x, y}) x' <=> {} x')\r
7029     ==> ~( {x,y} a ) /\ ~( {x,y} b ) /\ {x,y} x /\ {x,y} y `) THEN \r
7030 SIMP_TAC[RIGHT_AND_EXISTS_THM; REAL_ARITH` a - b = c \r
7031   <=> a = b + c `; ZERO_NEUTRAL; VECTOR_ARITH` (a:real^N) - b \r
7032   = c <=> a = b + c `; VECTOR_ADD_RID; IN_ELIM_THM] THEN \r
7033 SIMP_TAC[EQ_SYM_EQ]);;\r
7034 \r
7035 \r
7036 \r
7037 \r
7038 let PROVE_B1B2_POS = prove(` ~((?ta tb t. ta + tb + t = &1 /\ &0 <= t /\ v5 = ta % v1 + tb % v3 + t % v2) \/\r
7039    (?ta tb t. ta + tb + t = &1 /\ &0 <= t /\ v5 = ta % v1 + tb % v3 + t % v4)) /\\r
7040  ~coplanar {v1, v2, v3, v4} /\\r
7041  &0 <= b1 /\\r
7042  &0 <= b2 /\\r
7043  a1 + a2 + b1 + b2 = &1 /\\r
7044  v5 = a1 % v1 + a2 % v3 + b1 % v2 + b2 % v4 /\ l\r
7045   ==> &0 < b1 /\ &0 < b2 `,\r
7046 ASM_CASES_TAC `b1 = &0 ` THENL [\r
7047 ASM_SIMP_TAC[ZERO_NEUTRAL; VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN \r
7048 MESON_TAC[]; ASM_CASES_TAC `b2 = &0 ` THENL [\r
7049 ASM_SIMP_TAC[ZERO_NEUTRAL; VECTOR_MUL_LZERO; VECTOR_ADD_LID; VECTOR_ADD_RID] \r
7050 THEN MESON_TAC[]; ASM_SIMP_TAC[REAL_ARITH` a <= b <=> b = a \/ a < b `]]]);;\r
7051 \r
7052 \r
7053 \r
7054 let NOT_COPLANAR_AND_SUM_IMP_UNIQUE = prove(\r
7055 ` ~coplanar {(v1:real^3), v2, v3, v4} ==>\r
7056 (! x s1 s2 s3 s4 t1 t2 t3 t4.\r
7057   t1 + t2 + t3 + t4 = &1 /\\r
7058   x = t1 % v1 + t2 % v2 + t3 % v3 + t4 % v4 /\\r
7059  s1 + s2 + s3 + s4 = &1 /\\r
7060   x = s1 % v1 + s2 % v2 + s3 % v3 + s4 % v4 ==>\r
7061   s1 = t1 /\ s2 = t2 /\ s3 = t3 /\ s4 = t4 ) `,\r
7062 NHANH (SPEC_ALL (REWRITE_RULE[RIGHT_FORALL_IMP_THM] COEFS_4)) \r
7063 THEN MESON_TAC[]);;\r
7064 \r
7065 \r
7066 \r
7067 g ` ! (v1:real^3) (v2:real^3) (v3:real^3) (v4:real^3) (v5:real^3).\r
7068    CARD {v1, v2, v3, v4, v5} = 5 /\\r
7069      ~coplanar {v1, v2, v3, v4} /\\r
7070      v5 IN aff_ge {v1, v3} {v2, v4} /\\r
7071      ~(v5 IN aff {v1, v3})\r
7072      ==> aff_ge {v1, v3} {v2, v4} =\r
7073          aff_ge {v1, v3} {v2, v5} UNION aff_ge {v1, v3} {v4, v5} /\\r
7074          aff_gt {v1, v3} {v2, v5} INTER aff_gt {v1, v3} {v4, v5} = {}`;;\r
7075 e (SIMP_TAC[GSYM SUBSET_ANTISYM_EQ; PROVE_UNION_AFF22_SUBSET; \r
7076 EMPTY_SUBSET ]);;\r
7077 e (REPEAT GEN_TAC);;\r
7078 e (ASM_CASES_TAC ` (v5:real^3) IN aff_ge {v1,v3} {v2} \/\r
7079   v5 IN aff_ge {v1,v3} {v4} `);;\r
7080 e (DOWN_TAC);;\r
7081 e (SPEC_TAC (`v2:real^3`,`v2:real^3`));;\r
7082 e (SPEC_TAC (`v4:real^3`,`v4:real^3`));;\r
7083 e (ONCE_REWRITE_TAC[MESON[]` a /\ b ==> c <=> \r
7084   a ==> b ==> c `]);;\r
7085 e (MATCH_MP_TAC (MESON[]`(! a b. L a b <=> L b a ) /\ (! a b . P a ==> L a b )  ==> (! a b. P b \/ P a ==>\r
7086   L a b ) `));;\r
7087 e (CONJ_TAC);;\r
7088 e (SIMP_TAC[UNION_COMM; INTER_COMM; INSERT_AC]);;\r
7089 e (PHA);;\r
7090 e (ONCE_REWRITE_TAC[MESON[]`a1 /\a2/\a3/\a4/\a5 <=>\r
7091   a4 /\ a1 /\a3/\a5/\a2`]);;\r
7092 e (NHANH (V5_IN_AFF21_IMP_SET_EQ));;\r
7093 e (SIMP_TAC[SET_RULE` a = b ==> a SUBSET (b UNION cc )`]);;\r
7094 e (ONCE_REWRITE_TAC[MESON[]`a IN s /\ b /\ ss = tt ==> l\r
7095   <=> ss = tt ==> a IN s /\ b ==> l`]);;\r
7096 e (ONCE_REWRITE_TAC[GSYM (MESON[]`a1 /\a2/\a3/\a4/\a5 <=>\r
7097   a4 /\ a1 /\a3/\a5/\a2`)]);;\r
7098 e (ONCE_REWRITE_TAC[SET_RULE ` {a,b,c,d,e} = {e,a,b,c,d}`]);;\r
7099 e (REWRITE_TAC[CARD5]);;\r
7100 e (NHANH (SET_RULE` ~(v1 IN {v2, v3, v4}) /\\r
7101       ~(v2 = v3 \/ v3 = v4 \/ v4 = v2) ==>\r
7102   {v1,v3} INTER {v2,v4} = {} `));;\r
7103 e (NHANH (SPEC_ALL AFF_GE22));;\r
7104 e (PHA);;\r
7105 e (REWRITE_TAC[IN_ELIM_THM; MESON[]` a = b /\ a1 /\ v IN a /\l <=>\r
7106   a = b /\ a1 /\ v IN b /\ l`]);;\r
7107 e (REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM]);;\r
7108 e (PHA);;\r
7109 e (NHANH (MESON[AFF_GE21]` ~(v1 = v4) /\\r
7110      ~(v2 = v3) /\\r
7111      ~(v3 = v4) /\ ll ==>\r
7112   aff_ge {v1,v3} {v4} = \r
7113                {x | ?ta tb t.\r
7114                         ta + tb + t = &1 /\\r
7115                         &0 <= t /\\r
7116                         x = ta % v1 + tb % v3 + t % v4}`));;\r
7117 e (REWRITE_TAC[MESON[]` a IN s /\ l <=> l /\ a IN s `]);;\r
7118 e (REWRITE_TAC[MESON[]` a IN s /\ l <=> l /\ a IN s `;\r
7119   MESON[]` a = b /\ x IN a <=> a = b /\ x IN b `; IN_ELIM_THM]);;\r
7120 e (PHA);;\r
7121 e (REWRITE_TAC[MESON[]` a = b /\ x IN a <=>\r
7122   x IN b /\ a = b `; IN_ELIM_THM]);;\r
7123 e (NHANH (SET_RULE`  ~(v5 = v1) /\\r
7124      ~(v5 = v2) /\\r
7125      ~(v5 = v3) /\\r
7126      ~(v5 = v4) /\\r
7127      ~(v1 = v2) /\\r
7128      ~(v1 = v3) /\\r
7129      ~(v1 = v4) /\\r
7130      ~(v2 = v3) /\\r
7131      ~(v3 = v4) /\\r
7132      ~(v4 = v2) /\ l ==> {v1, v3} INTER {v2, v5} = {} /\\r
7133   {v1,v3} INTER {v4,v5} = {} `));;\r
7134 e (SIMP_TAC[AFF_GT22]);;\r
7135 e (REWRITE_TAC[SET_RULE` a INTER b SUBSET {} <=> (! x. ~( x IN a \r
7136   /\ x IN b ))`]);;\r
7137 e (REWRITE_TAC[SET_RULE` a INTER b SUBSET {} <=> (! x. ~( x IN a \r
7138   /\ x IN b ))`; IN_ELIM_THM] THEN REPEAT STRIP_TAC);;\r
7139 e (ASM_CASES_TAC ` t = &0 `);;\r
7140 \r
7141 \r
7142 \r
7143 e (UNDISCH_TAC `v5 = ta % v1 + tb % v3 + t % (v4:real^3)`);;\r
7144 e (UNDISCH_TAC `ta + tb + t = &1`);;\r
7145 e (UNDISCH_TAC `t = &0`);;\r
7146 e (UNDISCH_TAC `~(v5 IN aff {v1, (v3:real^3)})`);;\r
7147 e (SIMP_TAC[ZERO_NEUTRAL; VECTOR_MUL_LZERO; VECTOR_ADD_RID;\r
7148  AFF_2POINTS_INTERPRET; IN_ELIM_THM]);;\r
7149 e (MESON_TAC[]);;\r
7150 e (REPLICATE_TAC 13 (FIRST_X_ASSUM MP_TAC));;\r
7151 e (PURE_ONCE_REWRITE_TAC[MESON[]` a = b ==> p a <=> a = b ==> p b `]);;\r
7152 \r
7153 \r
7154 e (REWRITE_TAC[  VECTOR_ARITH` ta' % v1 + tb' % v3 + tx % v2 + ty % (ta % v1 + tb % v3 + t % v4) = \r
7155   ( ta' + ty * ta ) % v1 + ( tb' + ty * tb ) % v3 + tx % v2 + ( ty * t ) % v4 `]);;\r
7156 \r
7157 \r
7158 e (REWRITE_TAC[VECTOR_ARITH` (ta'' + ty' * ta) % v1 +\r
7159      (tb'' + ty' * tb) % v3 +\r
7160      tx' % v4 +\r
7161      (ty' * t) % v4 =\r
7162   (ta'' + ty' * ta ) % v1 + (tb'' + ty' * tb ) % v3 + &0 % v2 + (tx' + ty' * t ) % v4 `]);;\r
7163 \r
7164 e (REPEAT STRIP_TAC);;\r
7165 e (UNDISCH_TAC `ta + tb + t = &1`);;\r
7166 e (UNDISCH_TAC `ta' + tb' + tx + ty = &1`);;\r
7167 e (UNDISCH_TAC `ta'' + tb'' + tx' + ty' = &1`);;\r
7168 e (PHA);;\r
7169 e (NHANH (REAL_FIELD`ta'' + tb'' + tx' + ty' = &1 /\ ta' + tb' + tx + ty = &1 /\ ta + tb + t = &1 ==>\r
7170   (ta' + ty * ta) + (tb' + ty * tb) + tx + (ty * t) = &1 /\\r
7171   (ta'' + ty' * ta) + (tb'' + ty' * tb) + &0 + (tx' + ty' * t ) = &1 `));;\r
7172 e (MATCH_MP_TAC (MESON[]` (b ==> c) ==> ( a /\ b ==> c)`));;\r
7173 e (UNDISCH_TAC `x =\r
7174       (ta' + ty * ta) % v1 + (tb' + ty * tb) % v3 + tx % v2 + (ty * t) % (v4:real^3)`);;\r
7175 e (UNDISCH_TAC `x =\r
7176       (ta'' + ty' * ta) % v1 +\r
7177       (tb'' + ty' * tb) % v3 +\r
7178       &0 % v2 +\r
7179       (tx' + ty' * t) % (v4:real^3)`);;\r
7180 e (UNDISCH_TAC `~coplanar {v1, v2, v3, (v4:real^3)}`);;\r
7181 e (ONCE_REWRITE_TAC[SET_RULE` {v1, v2, v3, v4} =\r
7182   {v1,v3,v2,v4}`]);;\r
7183 e (PHA THEN ONCE_REWRITE_TAC[MESON[]`a1/\a2/\a3/\a4/\a5 <=>\r
7184   a1/\a5/\a2/\a4/\a3`]);;\r
7185 e (ABBREV_TAC ` t11 = (ta'' + ty' * ta) `);;\r
7186 e (ABBREV_TAC ` t33 = (tb'' + ty' * tb) `);;\r
7187 e (ABBREV_TAC ` t44 = (tx' + ty' * t) `);;\r
7188 e (ABBREV_TAC ` s11 = (ta' + ty * ta) `);;\r
7189 e (ABBREV_TAC ` s33 = (tb' + ty * tb) `);;\r
7190 e (ABBREV_TAC ` s44 = (ty * t) `);;\r
7191 e (NHANH (SPEC_ALL (REWRITE_RULE[RIGHT_FORALL_IMP_THM] COEFS_4)));;\r
7192 e (NHANH (MESON[]`(! x. p x ) ==> p (x:real^3)`));;\r
7193 e (PHA);;\r
7194 e (NHANH (MESON[]`(!ta tb tc td.\r
7195       x = ta % v1 + tb % v3 + tc % v2 + td % v4 /\ ta + tb + tc + td = &1\r
7196       ==> ta = COEF4_1 v1 v3 v2 v4 x /\\r
7197           tb = COEF4_2 v1 v3 v2 v4 x /\\r
7198           tc = COEF4_3 v1 v3 v2 v4 x /\\r
7199           td = COEF4_4 v1 v3 v2 v4 x) /\\r
7200  t11 + t33 + &0 + t44 = &1 /\\r
7201  x = t11 % v1 + t33 % v3 + &0 % v2 + t44 % v4 /\\r
7202  s11 + s33 + tx + s44 = &1 /\\r
7203  x = s11 % v1 + s33 % v3 + tx % v2 + s44 % v4 ==>\r
7204   tx = &0 `));;\r
7205 e (STRIP_TAC);;\r
7206 e (UNDISCH_TAC `&0 < tx `);;\r
7207 e (UNDISCH_TAC ` tx = &0 `);;\r
7208 e (MESON_TAC[REAL_ARITH`~( a = &0 /\ &0 < a )`]);;\r
7209 \r
7210 \r
7211 \r
7212 e (DOWN_TAC);;\r
7213 e (ONCE_REWRITE_TAC[MESON[]` a/\b/\c ==> l <=> b ==> a /\ c ==> l`]);;\r
7214 e (REWRITE_TAC[CARD5]);;\r
7215 e (NHANH (SET_RULE` ~(v1 IN {v2, v3, v4, v5}) /\\r
7216  ~(v2 IN {v3, v4, v5}) /\\r
7217  ~(v3 = v4 \/ v4 = v5 \/ v5 = v3) ==>\r
7218   ~(v1 = v2 ) /\ ~(v3 = v2) /\ ~(v1 = v4) /\ ~ (v3 = v4) /\\r
7219   {v1,v3} INTER {v2,v4} = {} /\\r
7220   {v1, v3} INTER {v2, v5} = {} /\\r
7221   {v1, v3} INTER {v4, v5} = {}`));;\r
7222 e (SIMP_TAC[AFF_GE22; AFF_GT22; AFF_GE21]);;\r
7223 e (REWRITE_TAC[IN_ELIM_THM]);;\r
7224 e (STRIP_TAC THEN STRIP_TAC);;\r
7225 e (DOWN_TAC);;\r
7226 \r
7227 (* *)\r
7228 e (NHANH (PROVE_B1B2_POS ));;\r
7229 e (REPEAT STRIP_TAC);;\r
7230 e (REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM; SUBSET; IN_UNION]);;\r
7231 e (REPEAT STRIP_TAC);;\r
7232 e (ABBREV_TAC ` r = b1 * b2' - b1' * b2`);;\r
7233 e (ASM_CASES_TAC ` &0 <= r `);;\r
7234 e (UNDISCH_TAC `x = a1' % v1 + a2' % v3 + b1' % v2 + b2' % (v4:real^3)`);;\r
7235 e (ONCE_REWRITE_TAC[MESON[VECTOR_ARITH` a = a - b + (b:real^N)`]` x = a ==> l <=>\r
7236   x = a - ( b1' / b1 ) % v5 + ( b1' / b1 ) % v5 ==> l `]);;\r
7237 e (UNDISCH_TAC `v5 = a1 % v1 + a2 % v3 + b1 % v2 + b2 % (v4:real^3)`);;\r
7238 e (PHA THEN PURE_ONCE_REWRITE_TAC[MESON[]`v = b /\ x = aa - t % v + t % v <=>\r
7239   v = b /\ x = aa - t % b + t % v `]);;\r
7240 e (REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC]);;\r
7241 e (IMP_TAC);;\r
7242 e (DISCH_TAC);;\r
7243 e (UNDISCH_TAC` &0 < b1 `);;\r
7244 e (SIMP_TAC[REAL_FIELD` &0 < b ==> a / b * b = a `]);;\r
7245 e (REWRITE_TAC[VECTOR_ARITH` (a1' % v1 + a2' % v3 + b1' % v2 + b2' % v4) -\r
7246      (b1 % v1 +\r
7247       b2 % v3 +\r
7248       b1' % v2 +\r
7249        bb % v4) = (a1' - b1 ) % v1 \r
7250   + (a2' - b2 ) % v3 + ( b2' - bb ) % v4 `]);;\r
7251 e (SIMP_TAC[REAL_FIELD`&0 < b ==> a - x / b * c = ( a * b - x * c ) / b `]);;\r
7252 e (REPEAT STRIP_TAC THEN DISJ2_TAC);;\r
7253 e (EXISTS_TAC`(a1' * b1 - b1' * a1) / b1 `);;\r
7254 e (EXISTS_TAC`(a2' * b1 - b1' * a2) / b1`);;\r
7255 e (EXISTS_TAC`(b2' * b1 - b1' * b2) / b1`);;\r
7256 e (EXISTS_TAC`b1' / b1`);;\r
7257 e (SIMP_TAC[VECTOR_ARITH` (a+b) + (c:real^N) = a + b + c `]);;\r
7258 e (ASM_SIMP_TAC[REAL_LE_DIV; REAL_ARITH` b1 * b2' - b1' * b2\r
7259   = b2' * b1 - b1' * b2 `]);;\r
7260 e (ASM_MESON_TAC[REAL_FIELD` &0 < b1 /\ a1 + a2 + b1 + b2 = &1 /\\r
7261   a1' + a2' + b1' + b2' = &1 /\ b1 * b2' - b1' * b2 = r ==>\r
7262   (a1' * b1 - b1' * a1) / b1 + (a2' * b1 - b1' * a2) / b1 + r / b1 + b1' / b1 =\r
7263  &1 `]);;\r
7264 e (UNDISCH_TAC `x = a1' % v1 + a2' % v3 + b1' % v2 + b2' % (v4:real^3)`);;\r
7265 e (ONCE_REWRITE_TAC[MESON[VECTOR_ARITH` a = a - b + (b:real^N)`]` x = a ==> l <=>\r
7266   x = a - ( b2' / b2 ) % v5 + ( b2' / b2 ) % v5 ==> l `]);;\r
7267 e (UNDISCH_TAC `v5 = a1 % v1 + a2 % v3 + b1 % v2 + b2 % (v4:real^3)`);;\r
7268 e (PHA THEN PURE_ONCE_REWRITE_TAC[MESON[]`v = b /\ x = aa - t % v + t % v <=>\r
7269   v = b /\ x = aa - t % b + t % v `]);;\r
7270 e (REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC]);;\r
7271 e (UNDISCH_TAC` &0 < b2 `);;\r
7272 e (ONCE_REWRITE_TAC[MESON[]` a ==> b /\ c ==> l <=>\r
7273   b ==> a /\ c ==> l`]);;\r
7274 e (DISCH_TAC);;\r
7275 e (IMP_TAC THEN SIMP_TAC[REAL_FIELD` &0 < b2 ==> b2' / b2 * b2 = b2'`]);;\r
7276 e (REWRITE_TAC[VECTOR_ARITH`(a1' % v1 + a2' % v3 + b1' % v2 + a44 % v4) -\r
7277      (a11 % v1 + a33 % v3 + a22 % v2 + a44 % v4) +\r
7278      a55 % v5 =\r
7279      (a1' - a11) % v1 + (a2' - a33) % v3 + (b1' - a22) % v2 + a55 % v5`]);;\r
7280 e (REPEAT STRIP_TAC THEN DISJ1_TAC);;\r
7281 e (EXISTS_TAC` (a1' - b2' / b2 * a1) `);;\r
7282 e (EXISTS_TAC` (a2' - b2' / b2 * a2) `);;\r
7283 e (EXISTS_TAC` (b1' - b2' / b2 * b1) `);;\r
7284 e (EXISTS_TAC` b2' / b2 `);;\r
7285 e (UNDISCH_TAC ` ~( &0 <= r )`);;\r
7286 e (ASM_SIMP_TAC[REAL_LE_DIV; REAL_FIELD` &0 < b2 ==>\r
7287   b1' - b2' / b2 * b1 = ( -- ( b1 * b2' - b1' * b2 ))/ b2 `;\r
7288   REAL_ARITH` ~( &0 <= a) <=> &0 <= -- a /\ ~( a = &0 ) `]);;\r
7289 e (STRIP_TAC);;\r
7290 e (EXPAND_TAC "r");;\r
7291 e (ASM_SIMP_TAC[REAL_FIELD` &0 < b2 /\ a1' + a2' + b1' + b2' = &1 /\ a1 + a2 + b1 + b2 = &1\r
7292      ==> --(a1 * b2' - a1' * b2) / b2 +\r
7293          --(a2 * b2' - a2' * b2) / b2 +\r
7294          --(b1 * b2' - b1' * b2) / b2 +\r
7295          b2' / b2 =\r
7296          &1 `]);;\r
7297 e (REWRITE_TAC[SET_RULE`a INTER b SUBSET {} <=> (! x. ~( x IN a /\ x IN b ))`; IN_ELIM_THM]);;\r
7298 e (GEN_TAC);;\r
7299 e (ASM_SIMP_TAC[VECTOR_ARITH` ta % v1 +\r
7300         tb % v3 +\r
7301         tx % v2 +\r
7302         ty % (a1 % v1 + a2 % v3 + b1 % v2 + b2 % v4)\r
7303   = (ta + ty * a1 ) % v1 + ( tb + ty * a2 ) % v3 +\r
7304   ( tx + ty * b1 ) % v2 + ( ty * b2 ) % v4 `;\r
7305   VECTOR_ARITH` ta % v1 +\r
7306         tb % v3 +\r
7307         tx % v4 +\r
7308         ty % (a1 % v1 + a2 % v3 + b1 % v2 + b2 % v4) =\r
7309   ( ta + ty * a1 ) % v1 + ( tb + ty * a2 ) % v3 +\r
7310   ( ty * b1 ) % v2 + ( tx + ty * b2 ) % v4 `]);;\r
7311 e (ONCE_REWRITE_TAC[MESON[]` ~ a <=> a ==> F `] THEN STRIP_TAC);;\r
7312 e (UNDISCH_TAC` ta + tb + tx + ty = &1 `);;\r
7313 e (UNDISCH_TAC` a1 + a2 + b1 + b2 = &1 `);;\r
7314 e (UNDISCH_TAC` ta' + tb' + tx' + ty' = &1 `);;\r
7315 e (PHA);;\r
7316 e (NHANH (REAL_FIELD`ta' + tb' + tx' + ty' = &1 /\\r
7317    a1 + a2 + b1 + b2 = &1 /\\r
7318    ta + tb + tx + ty = &1 ==>\r
7319   (ta' + ty' * a1) + (tb' + ty' * a2) + (ty' * b1) +\r
7320   (tx' + ty' * b2) = &1 /\\r
7321   (ta + ty * a1) + (tb + ty * a2) + (tx + ty * b1) +\r
7322   (ty * b2) = &1 `));;\r
7323 e (STRIP_TAC);;\r
7324 e (UNDISCH_TAC `x =\r
7325       (ta + ty * a1) % v1 +\r
7326       (tb + ty * a2) % v3 +\r
7327       (tx + ty * b1) % v2 +\r
7328       (ty * b2) % (v4:real^3)`);;\r
7329 e (UNDISCH_TAC `(ta + ty * a1) + (tb + ty * a2) + (tx + ty * b1) + ty * b2 = &1`);;\r
7330 e (UNDISCH_TAC`x =\r
7331       (ta' + ty' * a1) % v1 +\r
7332       (tb' + ty' * a2) % v3 +\r
7333       (ty' * b1) % v2 +\r
7334       (tx' + ty' * b2) % (v4:real^3) `);;\r
7335 e (UNDISCH_TAC`(ta' + ty' * a1) + (tb' + ty' * a2) + ty' * b1 + tx' + ty' * b2 = &1 `);;\r
7336 e (UNDISCH_TAC `~coplanar {(v1:real^3), v2, v3, v4}`);;\r
7337 e (PHA);;\r
7338 e (ONCE_REWRITE_TAC[SET_RULE` {a,b,c,d} = {a,c,b,d}`]);;\r
7339 e (NHANH (NOT_COPLANAR_AND_SUM_IMP_UNIQUE));;\r
7340 e (PHA);;\r
7341 e (NHANH (MESON[]`(!x s1 s2 s3 s4 t1 t2 t3 t4.\r
7342         t1 + t2 + t3 + t4 = &1 /\\r
7343         x = t1 % v1 + t2 % v3 + t3 % v2 + t4 % v4 /\\r
7344         s1 + s2 + s3 + s4 = &1 /\\r
7345         x = s1 % v1 + s2 % v3 + s3 % v2 + s4 % v4\r
7346         ==> s1 = t1 /\ s2 = t2 /\ s3 = t3 /\ s4 = t4) /\\r
7347    (ta' + ty' * a1) + (tb' + ty' * a2) + ty' * b1 + tx' + ty' * b2 = &1 /\\r
7348    x =\r
7349    (ta' + ty' * a1) % v1 +\r
7350    (tb' + ty' * a2) % v3 +\r
7351    (ty' * b1) % v2 +\r
7352    (tx' + ty' * b2) % v4 /\\r
7353    (ta + ty * a1) + (tb + ty * a2) + (tx + ty * b1) + ty * b2 = &1 /\\r
7354    x =\r
7355    (ta + ty * a1) % v1 +\r
7356    (tb + ty * a2) % v3 +\r
7357    (tx + ty * b1) % v2 +\r
7358    (ty * b2) % v4 ==>\r
7359   ty' * b1 = (tx + ty * b1) /\\r
7360   (tx' + ty' * b2) = (ty * b2) `));;\r
7361 e (NHANH (REAL_FIELD`a = b /\ aa = bb ==>\r
7362   a * bb - b * aa = &0 `));;\r
7363 \r
7364 e (STRIP_TAC);;\r
7365 e (FIRST_X_ASSUM MP_TAC);;\r
7366 e (ONCE_REWRITE_TAC[REAL_ARITH` a = &0 <=> -- a = &0 `]);;\r
7367 e (ONCE_REWRITE_TAC[REAL_ARITH` a = &0 <=> -- a = &0 `]);;\r
7368 e (REWRITE_TAC[REAL_POLY_CONV` --((ty' * b1) * ty * b2 - (tx + ty * b1) * (tx' + ty' * b2)) `]);;\r
7369 e (UNDISCH_TAC ` &0 < b1 `);;\r
7370 e (UNDISCH_TAC ` &0 < b2 `);;\r
7371 e (UNDISCH_TAC ` &0 < tx `);;\r
7372 e (UNDISCH_TAC ` &0 < ty `);;\r
7373 e (UNDISCH_TAC ` &0 < tx' `);;\r
7374 e (UNDISCH_TAC ` &0 < ty' `);;\r
7375 e (PHA);;\r
7376 e (NHANH (MESON[REAL_LT_MUL]`\r
7377   &0 < ty' /\ &0 < tx' /\ &0 < ty /\ &0 < tx /\ &0 < b2 /\ &0 < b1\r
7378   ==> &0 < b1 * tx' * ty  /\ &0 < b2 * tx * ty' /\ &0 < tx * tx' `));;\r
7379 e (MESON_TAC[REAL_LT_IMP_NZ; REAL_LT_ADD]);;\r
7380 let BAJSVHC = top_thm();;\r
7381 \r
7382 \r
7383 \r
7384 \r
7385 \r