text_formalization/packing/counting_spheres.hl

   1 (* ========================================================================== *)
   2 (* FLYSPECK - BOOK FORMALIZATION                                              *)
   3 (* Section: Counting Spheres                                                  *)
   4 (* Chapter: packing                                                           *)
   5 (* Author: Thomas C. Hales                                                    *)
   6 (* Date: 2011-06-18                                                           *)
   7 (* ========================================================================== *)
   8
   9 module Counting_spheres = struct
  10
  11   open Tactics_jordan;;
  12 open Ysskqoy;;
  13 open Hales_tactic;;
  14
  15 let CALC_ID_TAC = Calc_derivative.CALC_ID_TAC;;
  16 let DIHV_SYM = Trigonometry2.DIHV_SYM;;
  17
  18 (* -------------- *)
  19
  20
  21 (* fat_lemma1 = Fatugpd.lemma1  *)
  22 let fat_lemma1 = prove_by_refinement(
  23  `! (S:real^3->bool). packing S /\ S SUBSET ball_annulus ==> FINITE S`,
  24 [
  25   (REPEAT STRIP_TAC);
  26   (SUBGOAL_THEN ` (S:real^3->bool) = S INTER ball (vec 0,&3 * h0)` ASSUME_TAC);
  27     (MATCH_MP_TAC (SET_RULE `! U V. U SUBSET ball_annulus /\ ball_annulus SUBSET V ==> (U = U INTER V)`));
  28     (ASM_SIMP_TAC[Pack_defs.ball_annulus;ball;cball;IN_DIFF;SUBSET;IN_ELIM_THM;Sphere.h0]);
  29     (REPEAT STRIP_TAC );
  30     (MATCH_MP_TAC (ARITH_RULE ` u <= &2 * #1.26 ==> u < &3 * #1.26`));
  31     BY((ASM_SIMP_TAC[]));
  32   (ONCE_ASM_REWRITE_TAC[]);
  33   BY((ASM_SIMP_TAC[Pack2.KIUMVTC]))
  34 ]);;
  35
  36 (* ckq_in_ball_annulus = Ckqowsa_3_points.in_ball_annulus *)
  37
  38 let ckq_in_ball_annulus = prove(`!v. v IN ball_annulus <=> &2 <= norm v /\ norm v <= &2 * h0 /\ ~(v = vec 0)`,
  39    REWRITE_TAC[Pack_defs.ball_annulus] THEN
  40      REWRITE_TAC[IN_DIFF; cball; ball; IN_ELIM_THM; DIST_0] THEN
  41      REWRITE_TAC[GSYM NORM_EQ_0] THEN
  42      REAL_ARITH_TAC);;
  43
  44
  45 let lemma = prove_by_refinement(
  46   `!a2 b c. (&0 < a2)  /\ (&0 < c) /\ (!t. &0 <= t /\ t < c ==> a2*t <= b) ==> (!t. &0 <= t /\ t <= c ==> a2*t <= b)`,
  47   (* {{{ proof *)
  48 [
  49   REPEAT STRIP_TAC;
  50   DISJ_CASES_TAC (REAL_ARITH `t < c \/  ~(t <= c) \/ t=c `);
  51     BY(ASM_MESON_TAC []);
  52   HASH_UNDISCH_TAC 9516;
  53   ASM_REWRITE_TAC [];
  54   DISCH_THEN SUBST1_TAC;
  55   HASH_UNDISCH_TAC 6171;
  56   DISCH_THEN (fun loc_t -> ASSUME_TAC loc_t THEN ASSUME_TAC loc_t);
  57   HASH_RULE_TAC 6171 (SPEC `(b/(&2 * a2) + c/(&2))`);
  58   HASH_RULE_TAC 6171 (SPEC `&0`);
  59   ANTS_TAC;
  60     BY(ASM_REAL_ARITH_TAC);
  61   REWRITE_TAC [REAL_ARITH`x* &0= &0`];
  62   DISCH_TAC;
  63   SUBGOAL_THEN `(&0 <= b / (&2 * a2) + c / &2)=T` SUBST1_TAC;
  64     ASM_REWRITE_TAC [];
  65     MATCH_MP_TAC (REAL_ARITH `&0 <= x /\( &0 < y) ==> &0 <= x + y/ &2`);
  66     ASM_REWRITE_TAC [];
  67     MATCH_MP_TAC REAL_LE_DIV;
  68     BY(ASM_REAL_ARITH_TAC);
  69   REWRITE_TAC [];
  70   ONCE_REWRITE_TAC [REAL_ARITH `((x < y) = (x - y < &0)) /\((x <= y) = (x - y <= &0))`];
  71   MP_TAC (Calc_derivative.rational_identity `(b / (&2 * a2) + c / &2) - c = -- (a2*c - b)/(&2 * a2)`);
  72   MP_TAC (Calc_derivative.rational_identity `(a2 * (b/ (&2 * a2) + c / &2) - b) = (a2 * c - b) /(&2)`);
  73   ASM_SIMP_TAC [REAL_ARITH `~(&2 = &0) /\( &0 < a2 ==> ~(a2 = &0))`];
  74   DISCH_THEN SUBST1_TAC;
  75   DISCH_THEN SUBST1_TAC;
  76   ABBREV_TAC `u = a2 * c - b `;
  77   HASH_UNDISCH_TAC 3659;
  78   REWRITE_TAC[REAL_ARITH `--x / a < &0 <=> &0 < x / a`];
  79   SIMP_TAC [REAL_ARITH`&0 < x ==> &0 < &2 * x`;Trigonometry2.REAL_LT_DIV_0];
  80   BY(REAL_ARITH_TAC )
  81 ]
  82 );;
  83   (* }}} *)
  84
  85 let eus1 = prove_by_refinement(
  86   `!(P:real^2 -> bool) c. polyhedron P /\ c facet_of P  ==>
  87      (?a b.  (norm a = &1) /\
  88         (!r. (&0 < r) /\ (!p. norm p < r ==> P p) ==> (r <= b)) /\
  89                     P SUBSET {x | a dot x <= b} /\
  90                     c = P INTER {x | a dot x = b})`,
  91   (* {{{ proof *)
  92 [
  93 REPEAT STRIP_TAC ;
  94 MP_TAC (SPECL[`P:real^2->bool`;`c:real^2->bool`] (INST_TYPE [(`:2`,`:N`)] FACET_OF_POLYHEDRON));
  95 ASM_REWRITE_TAC [];
  96 REPEAT STRIP_TAC ;
  97 EXISTS_TAC  `&1/ norm a % (a:real^2)`;
  98 EXISTS_TAC  `&1/ norm (a:real^2) * (b:real)`;
  99 ASM_REWRITE_TAC [GSYM Trigonometry2.NOT_VEC0_UNITABLE];
 100 SUBGOAL_THEN  `&0 < norm (a:real^2)` ASSUME_TAC;
 101 ASM_REWRITE_TAC [NORM_POS_LT];
 102 SUBGOAL_THEN `&0 < &1/ norm (a:real^2)` ASSUME_TAC;
 103 MATCH_MP_TAC  REAL_LT_DIV THEN CONJ_TAC THEN TRY REAL_ARITH_TAC THEN ASM_REWRITE_TAC[];
 104 HASH_UNDISCH_TAC 7978 ;
 105 REWRITE_TAC  [DOT_LMUL];
 106 ASM_SIMP_TAC [REAL_LE_LMUL_EQ];
 107 REWRITE_TAC [REAL_EQ_MUL_LCANCEL];
 108 SIMP_TAC [REAL_ARITH `&0 < d==> ~(d= &0)`];
 109 DISCH_TAC ;
 110 REPEAT STRIP_TAC;
 111 SUBGOAL_THEN `!p. norm (p:real^2) < r ==> (a:real^2) dot p <= b` ASSUME_TAC;
 112 REPEAT STRIP_TAC ;
 113 HASH_UNDISCH_TAC 5889 ;
 114 REWRITE_TAC [SUBSET;IN;IN_ELIM_THM];
 115 DISCH_THEN MATCH_MP_TAC;
 116 FIRST_X_ASSUM MATCH_MP_TAC;
 117 ASM_REWRITE_TAC [];
 118 SUBGOAL_THEN  `(&0 < norm (a:real^2) pow 2) /\(&0 < r/ norm a) /\(!t. &0 <= t /\( t < r/ norm a) ==> (norm a pow 2 )*t <= b)` (fun t -> MP_TAC (MATCH_MP lemma t));
 119 CONJ_TAC ;
 120 HASH_UNDISCH_TAC 7435 ;
 121 REWRITE_TAC [GSYM Trigonometry2.NOT_ZERO_EQ_POW2_LT];
 122 REAL_ARITH_TAC ;
 123 CONJ_TAC ;
 124 MATCH_MP_TAC REAL_LT_DIV;
 125 ASM_REWRITE_TAC [];
 126 REPEAT STRIP_TAC ;
 127 HASH_RULE_TAC 4896 (SPEC `t % (a:real^2)`);
 128 ASM_SIMP_TAC [NORM_MUL;REAL_ARITH `&0 <= t ==> (abs t = t)`];
 129 REWRITE_TAC [DOT_RMUL];
 130 REWRITE_TAC [DOT_SQUARE_NORM];
 131 ANTS_TAC;
 132 HASH_RULE_TAC 7310 (Calc_derivative.rational_ineq_rule);
 133 HASH_UNDISCH_TAC 7435 ;
 134 SIMP_TAC [REAL_LT_MUL_EQ];
 135 MP_TAC (REAL_ARITH `&0 < x ==> ~(x = &0)`);
 136 REAL_ARITH_TAC ;
 137 REAL_ARITH_TAC ;
 138 DISCH_THEN (fun t-> MP_TAC (SPEC `r/ norm (a:real^2)` t));
 139 ANTS_TAC;
 140 REWRITE_TAC [REAL_ARITH `x <= x`];
 141 REWRITE_TAC [Calc_derivative.invert_den_le];
 142 MATCH_MP_TAC REAL_LE_MUL;
 143 ASM_REAL_ARITH_TAC;
 144 DISCH_THEN (MP_TAC o Calc_derivative.rational_ineq_rule);
 145 DISCH_TAC ;
 146 MATCH_MP_TAC (REAL_ARITH `((x < y) ==> F) ==> (y <= x)`);
 147 DISCH_THEN (MP_TAC o Calc_derivative.rational_ineq_rule);
 148 HASH_UNDISCH_TAC 5880 ;
 149 SUBGOAL_THEN `~(norm (a:real^2) = &0)` ASSUME_TAC;
 150 ASM_REAL_ARITH_TAC;
 151 ASM_REWRITE_TAC [];
 152 REWRITE_TAC [REAL_ARITH `~(&0 < (x - y) * b) <=> (&0 <= (y - x)*b)`];
 153 REWRITE_TAC [REAL_RING `(b * norm (a:real^2) - norm a pow 2 * r) = (b - r * norm a) * norm a`];
 154 HASH_UNDISCH_TAC 7435 ;
 155 REWRITE_TAC [REAL_MUL_POS_LE;REAL_MUL_POS_LT;REAL_ENTIRE;REAL_ARITH `a * b < &0 <=> ~(&0 <= a * b)`];
 156 REAL_ARITH_TAC
 157 ]);;
 158   (* }}} *)
 159
 160
 161 let facet_rep_uniq = prove_by_refinement(
 162   `!(P:real^2 -> bool) a b1 b2. polyhedron P /\
 163     c1 facet_of P  /\ c2 facet_of P /\
 164     P SUBSET {x | a dot x <= b1} /\
 165     P SUBSET {x | a dot x <= b2} /\
 166     c1 = P INTER {x | a dot x = b1} /\
 167     c2 = P INTER {x | a dot x = b2} ==>
 168     (b1 = b2) /\ (c1 = c2)`,
 169   (* {{{ proof *)
 170 [
 171 REPEAT GEN_TAC ;
 172 REWRITE_TAC [facet_of;face_of;SUBSET;GSYM MEMBER_NOT_EMPTY;IN;IN_ELIM_THM;INTER];
 173 STRIP_TAC ;
 174 SUBGOAL_THEN `a dot x = b1 /\ (a:real^2) dot x' = b2` ASSUME_TAC;
 175 HASH_UNDISCH_TAC 4776 ;
 176 HASH_UNDISCH_TAC 6239 ;
 177 ASM_REWRITE_TAC [IN_ELIM_THM];
 178 MESON_TAC [];
 179 ASM_MESON_TAC [REAL_ARITH `b1 <= b2 /\ b2 <= b1 ==> (b1 = b2)`]
 180 ]
 181 );;
 182   (* }}} *)
 183
 184 let facet_rep_spec = prove_by_refinement(
 185   `?a b. !(P:real^2 -> bool) c. polyhedron P /\ c facet_of P
 186    ==>
 187      (  (norm (a P c) = &1) /\
 188      (!r. (&0 < r) /\ (!p. norm p < r ==> P p) ==> (r <= (b P c))) /\
 189      P SUBSET {x | (a P c) dot x <= (b P c)} /\
 190      c = P INTER {x | (a P c) dot x = (b P c)})`,
 191   (* {{{ proof *)
 192   [
 193 REWRITE_TAC [GSYM SKOLEM_THM;RIGHT_EXISTS_IMP_THM];
 194 MESON_TAC [eus1]
 195   ]);;
 196   (* }}} *)
 197
 198 let facet_rep_def = new_specification ["facet_rep_a";"facet_rep_b"] facet_rep_spec;;
 199
 200 let facet_rep_uniq_c = prove_by_refinement(
 201   `!(P:real^2 -> bool) c1 c2. polyhedron P /\ c1 facet_of P /\ c2 facet_of P /\
 202     (facet_rep_a P c1 = facet_rep_a P c2) ==> (c1 = c2)`,
 203   (* {{{ proof *)
 204   [
 205 REPEAT STRIP_TAC ;
 206 MP_TAC (SPECL[`P:real^2->bool`;`facet_rep_a P c1`;`facet_rep_b P c1`;`facet_rep_b P c2`] facet_rep_uniq);
 207 ASM_REWRITE_TAC [];
 208 MP_TAC (SPECL[`P:real^2->bool`;`c1:real^2->bool`] facet_rep_def);
 209 MP_TAC (SPECL[`P:real^2->bool`;`c2:real^2->bool`] facet_rep_def);
 210 ASM_REWRITE_TAC [];
 211 REPEAT STRIP_TAC ;
 212 ASM_MESON_TAC []
 213   ]);;
 214   (* }}} *)
 215
 216 let norm1_cauchy_eq = prove_by_refinement(
 217   `!(x:real^N) y. norm x = &1 /\ norm y = &1 /\ x dot y = &1 ==> (x = y)`,
 218   (* {{{ proof *)
 219   [
 220 REPEAT STRIP_TAC ;
 221 MP_TAC (SPECL [`x:real^N`;`y:real^N`] NORM_CAUCHY_SCHWARZ_EQ);
 222 ASM_REWRITE_TAC [REAL_ARITH `&1 * &1 = &1`;VECTOR_MUL_LID];
 223 MESON_TAC []
 224   ]);;
 225   (* }}} *)
 226
 227 let facet_rep_in_facet = prove_by_refinement(
 228   `!(P:real^2->bool) c1 c2 r. polyhedron P /\ c1 facet_of P /\ c2 facet_of P /\
 229   (&0 < r) /\ (!p. norm p < r ==> P p) /\
 230   (facet_rep_b P c1 <= facet_rep_a P c1 dot (r % facet_rep_a P c2)) ==>
 231    (c1 = c2)`,
 232   (* {{{ proof *)
 233   [
 234 REWRITE_TAC [DOT_RMUL];
 235 REPEAT STRIP_TAC ;
 236 MATCH_MP_TAC facet_rep_uniq_c;
 237 EXISTS_TAC `P:real^2->bool`;
 238 ASM_REWRITE_TAC [];
 239 MATCH_MP_TAC (norm1_cauchy_eq);
 240 SUBGOAL_THEN `norm (facet_rep_a (P:real^2->bool) c1) = &1 /\  norm (facet_rep_a P c2) = &1 /\  facet_rep_a P c1 dot facet_rep_a P c2 <= &1` (MP_TAC);
 241 ASM_MESON_TAC [facet_rep_def;REAL_ARITH `&1 * &1 = &1`;NORM_CAUCHY_SCHWARZ];
 242 REPEAT STRIP_TAC  THEN ASM_REWRITE_TAC[];
 243 SUBGOAL_THEN `r <= facet_rep_b P c1` MP_TAC;
 244 ASM_MESON_TAC [facet_rep_def];
 245 DISCH_TAC ;
 246 HASH_UNDISCH_TAC 4642 ;
 247 REWRITE_TAC [REAL_ARITH `x <= &1 <=> (x = &1) \/ (x < &1)`];
 248 DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[];
 249 ABBREV_TAC `d = facet_rep_a P c1 dot facet_rep_a P c2 `;
 250 SUBGOAL_THEN `&0 < (r * (&1 - d))` ASSUME_TAC;
 251 MATCH_MP_TAC REAL_LT_MUL;
 252 ASM_REAL_ARITH_TAC ;
 253 ASM_REAL_ARITH_TAC
 254   ]);;
 255   (* }}} *)
 256
 257 let facet_rep_refl = prove_by_refinement(
 258   `!(P:real^2->bool) c r. polyhedron P /\ c facet_of P /\
 259   (&0 < r) /\ (!p. norm p < r ==> P p)  ==>
 260    (facet_rep_a P c dot (r % facet_rep_a P c) <= facet_rep_b P c)`,
 261   (* {{{ proof *)
 262   [
 263 REWRITE_TAC [DOT_RMUL;Collect_geom.X_DOT_X_EQ];
 264 REPEAT STRIP_TAC ;
 265 MP_TAC (SPECL[`P:real^2->bool`;`c:real^2->bool`] facet_rep_def);
 266 ASM_REWRITE_TAC [];
 267 REPEAT STRIP_TAC ;
 268 ASM_REWRITE_TAC [Trigonometry2.POW2_1;REAL_ARITH ` r * &1 = r`];
 269 ASM_MESON_TAC []
 270   ]);;
 271   (* }}} *)
 272
 273
 274 let DOT_EQ_IMP_INEQ_LEMMA = prove_by_refinement(
 275   `!(a:real^N) b a' b'.
 276     (!x. a dot x = b <=> a' dot x = b') /\ (&0 <  b) /\ (&0 < b') ==>
 277    (!x. ~(a dot x = &0) ==> (a dot x <= b <=> a' dot x <= b'))`,
 278   (* {{{ proof *)
 279   [
 280 REPEAT STRIP_TAC ;
 281 HASH_RULE_TAC 2720 (SPEC `((b/(a dot x)) % (x:real^N))`);
 282 REWRITE_TAC [DOT_RMUL];
 283 SUBGOAL_THEN `b / (a dot x) * (a dot (x:real^N)) = b` SUBST1_TAC;
 284 HASH_UNDISCH_TAC 5506 ;
 285 BY(CONV_TAC REAL_FIELD);
 286 REWRITE_TAC [REAL_FIELD `b/ (a dot x) * (a' dot x) = b * ((a' dot x) / (a dot (x:real^N)))`];
 287   DISCH_THEN (fun t-> ASSUME_TAC(GSYM t));
 288 ASM_REWRITE_TAC [];
 289 SUBGOAL_THEN `&0 < (a' dot (x:real^N)) / (a dot x) ` ASSUME_TAC;
 290 HASH_UNDISCH_TAC 9752 ;
 291 ASM_REWRITE_TAC [REAL_MUL_POS_LT];
 292 ASM_REAL_ARITH_TAC;
 293 SUBGOAL_THEN `a dot (x:real^N) <= b <=> (a dot x) * ((a' dot x)/(a dot x)) <= b * (a' dot x)/(a dot x)` SUBST1_TAC;
 294 ASM_SIMP_TAC [REAL_LE_RMUL_EQ];
 295 SUBGOAL_THEN  `(a dot (x:real^N)) * (a' dot x)/ (a dot x) = a' dot x` SUBST1_TAC;
 296 HASH_UNDISCH_TAC 5506 ;
 297 BY (CONV_TAC REAL_FIELD);
 298 BY(REWRITE_TAC[])
 299   ]);;
 300   (* }}} *)
 301
 302 let DOT_EQ_IMP_INEQ = prove_by_refinement(
 303   `!(a:real^N) b a' b'.
 304     (!x. a dot x = b <=> a' dot x = b') /\ (&0 <= b) /\ (&0 < b') ==>
 305    (!x. (a dot x <= b) <=> a' dot x <= b')`,
 306   (* {{{ proof *)
 307   [
 308 REPEAT STRIP_TAC ;
 309 SUBGOAL_THEN `&0 < b` ASSUME_TAC;
 310 HASH_RULE_TAC 2720 (fun t -> (REWRITE_RULE[DOT_RZERO] (SPEC `(vec 0):real^N` t)));
 311 ASM_REAL_ARITH_TAC ;
 312 ASM_CASES_TAC `~(a dot (x:real^N) = &0)`;
 313 ASM_MESON_TAC [DOT_EQ_IMP_INEQ_LEMMA];
 314 ASM_CASES_TAC `~(a' dot (x:real^N) = &0)`;
 315 ASM_MESON_TAC [DOT_EQ_IMP_INEQ_LEMMA];
 316 ASM_REAL_ARITH_TAC
 317   ]);;
 318   (* }}} *)
 319
 320 let affine_facet_hyper = prove_by_refinement(
 321   `!(P:real^N->bool) c a b. c facet_of P /\ polyhedron P /\ (affine hull P = (:real^N)) /\
 322     ~(a = vec 0) /\
 323      P INTER { x | a dot x = b } = c ==>
 324    (affine hull c =  { x | a dot x = b})`,
 325   (* {{{ proof *)
 326   [
 327   REPEAT WEAK_STRIP_TAC;
 328   TYPIFY `{x | a dot x = b} = affine hull {x | a dot x = b}` (C SUBGOAL_THEN SUBST1_TAC);
 329   BY(MESON_TAC [ AFFINE_HULL_EQ; AFFINE_HYPERPLANE ]);
 330   MATCH_MP_TAC AFF_DIM_EQ_AFFINE_HULL;
 331   ASM_SIMP_TAC [ AFF_DIM_HYPERPLANE ];
 332   CONJ_TAC;
 333   EXPAND_TAC "c";
 334   BY(SET_TAC []);
 335   HASH_UNDISCH_TAC 6578;
 336   REWRITE_TAC [ facet_of ];
 337   HASH_UNDISCH_TAC 6209;
 338   REWRITE_TAC [ GSYM AFF_DIM_EQ_FULL ];
 339   DISCH_THEN SUBST1_TAC;
 340   REPEAT WEAK_STRIP_TAC;
 341   ASM_REWRITE_TAC [];
 342   ARITH_TAC
 343   ]);;
 344   (* }}} *)
 345
 346 let POLYHEDRON_MEMBER = prove_by_refinement(
 347   `!(P:real^2->bool) r (x:real^2).  polyhedron P /\ (&0 < r) /\ (!p. norm p < r ==> P p)
 348    /\ (!c. (c facet_of P) ==> (facet_rep_a P c dot x <= facet_rep_b P c )) ==> P x`,
 349   (* {{{ proof *)
 350   [
 351   REPEAT WEAK_STRIP_TAC;
 352   HASH_COPY_TAC 8205;
 353   HASH_UNDISCH_TAC 8205;
 354   REWRITE_TAC [POLYHEDRON_INTER_AFFINE_MINIMAL];
 355   REPEAT WEAK_STRIP_TAC;
 356   SUBGOAL_THEN `affine hull P = (:real^2)` ASSUME_TAC;
 357   MATCH_MP_TAC Packing3.CONTAINS_BALL_AFFINE_HULL;
 358   EXISTS_TAC `(vec 0):real^2`;
 359   EXISTSv_TAC "r";
 360   BY (ASM_REWRITE_TAC [ball;SUBSET;IN_ELIM_THM;DIST_0;IN]);
 361   TYPIFY `P = INTERS f` (C SUBGOAL_THEN ASSUME_TAC);
 362   BY (ASM_MESON_TAC [INTER_UNIV]);
 363   (fun gl -> (MP_TAC (SPECL ( envl gl [`P`;`f`]) (INST_TYPE [`:2`,`:N`] FACET_OF_POLYHEDRON_EXPLICIT ))) gl);
 364   HASH_COPY_TAC 2338;
 365   HASH_UNDISCH_TAC 2338;
 366   DISCH_THEN (fun loc_t -> ONCE_REWRITE_TAC [ GSYM loc_t ]);
 367   ASM_REWRITE_TAC [];
 368   REPEAT WEAK_STRIP_TAC;
 369   REWRITE_TAC [INTERS;IN_ELIM_THM;IN];
 370   X_GENv_TAC "h";
 371   HASH_UNDISCH_TAC 8531;
 372   REWRITE_TAC [ GSYM RIGHT_EXISTS_IMP_THM ; SKOLEM_THM ];
 373   REPEAT WEAK_STRIP_TAC;
 374   (fun gl -> (HASH_RULE_TAC 7519 ( SPECL ( envl gl [`a`;`b`]) )) gl);
 375   ASM_REWRITE_TAC [];
 376   DISCH_TAC;
 377   INTRO_TAC facet_rep_def [`P`];
 378   (fun gl -> ( let asm_3 = snd(List.nth (List.rev (goal_asms gl)) 3 ) in REWRITE_TAC [ asm_3 ]) gl);
 379   DISCH_TAC;
 380   TYPIFY `h` (HASH_RULE_TAC 1064 o SPEC);
 381 (*  (fun gl -> (HASH_RULE_TAC 1064 (SPEC ( env gl `h`))) gl); *)
 382   ASM_REWRITE_TAC [IN];
 383   REPEAT WEAK_STRIP_TAC;
 384   (fun gl -> ( let asm_13 = snd(List.nth (List.rev (goal_asms gl)) 13 ) in ONCE_REWRITE_TAC [ asm_13 ]) gl);
 385   REWRITE_TAC [IN_ELIM_THM];
 386   ABBREV_TAC `(c:real^2->bool) = P INTER { x | a (h:real^2->bool) dot x = b h }`;
 387   TYPIFY `c facet_of P` (C SUBGOAL_THEN ASSUME_TAC);
 388   BY(ASM_MESON_TAC [IN]);
 389   TYPIFY `c` (HASH_RULE_TAC 4778 o SPEC);
 390 (*  (fun gl -> (HASH_RULE_TAC 4778 (SPEC ( env gl `c`))) gl); *)
 391   DISCH_TAC;
 392   TYPIFY `norm (facet_rep_a P c) = &1 /\ &0 < facet_rep_b P c /\ c = P INTER {x | facet_rep_a P c dot x = facet_rep_b P c}` (C SUBGOAL_THEN MP_TAC);
 393   BY(ASM_MESON_TAC [ REAL_ARITH `&0 < r /\ r <= k ==> &0 < k`]);
 394   REPEAT WEAK_STRIP_TAC;
 395   TYPIFY `affine hull c = { x | a h dot x = b h}` (C SUBGOAL_THEN ASSUME_TAC);
 396   MATCH_MP_TAC affine_facet_hyper;
 397   EXISTSv_TAC "P";
 398   BY(ASM_MESON_TAC []);
 399   TYPIFY `affine hull c = { x | facet_rep_a P c dot x = facet_rep_b P c }` (C SUBGOAL_THEN ASSUME_TAC);
 400   MATCH_MP_TAC affine_facet_hyper;
 401   EXISTSv_TAC "P";
 402   BY(ASM_MESON_TAC [ NORM_0; REAL_ARITH `~(&1 = &0)`]);
 403   TYPIFY `a h dot x = b h <=> (facet_rep_a P c dot x = facet_rep_b P c)` (C SUBGOAL_THEN ASSUME_TAC);
 404   HASH_UNDISCH_TAC 6018;
 405   HASH_KILL_TAC 2868;
 406   ASM_REWRITE_TAC [];
 407   ONCE_REWRITE_TAC [ FUN_EQ_THM ];
 408   REWRITE_TAC [ IN_ELIM_THM ];
 409   BY(SIMP_TAC [] );
 410   TYPIFY `P (vec 0)` (C SUBGOAL_THEN ASSUME_TAC);
 411   FIRST_X_ASSUM MATCH_MP_TAC;
 412   BY(ASM_REWRITE_TAC [ NORM_0 ]);
 413   TYPIFY `&0 <= b h` (C SUBGOAL_THEN ASSUME_TAC);
 414   HASH_UNDISCH_TAC 7409;
 415   HASH_UNDISCH_TAC 2868;
 416   DISCH_THEN SUBST1_TAC;
 417   REWRITE_TAC [ INTERS;IN_ELIM_THM;IN ];
 418   (fun gl -> (DISCH_THEN (MP_TAC o (SPEC ( env gl `h`)))) gl);
 419   (fun gl -> ( let asm_8 = snd(List.nth (List.rev (goal_asms gl)) 8 ) in REWRITE_TAC [ asm_8 ]) gl);
 420   (fun gl -> ( let asm_11 = snd(List.nth (List.rev (goal_asms gl)) 11 ) in DISCH_THEN (MP_TAC o (ONCE_REWRITE_RULE [ asm_11 ] ))) gl);
 421   BY(REWRITE_TAC [ IN_ELIM_THM; DOT_RZERO ]);
 422   (fun gl -> (MP_TAC (SPECL ( envl gl [`a h`;`b h`;`facet_rep_a P c`;`facet_rep_b P c`]) (INST_TYPE [`:2`,`:N`] DOT_EQ_IMP_INEQ))) gl);
 423   (fun gl -> ( let asm_17 = snd(List.nth (List.rev (goal_asms gl)) 17 ) in  let asm_23 = snd(List.nth (List.rev (goal_asms gl)) 23 ) in REWRITE_TAC [ asm_23; asm_17 ]) gl);
 424   ANTS_TAC;
 425   HASH_UNDISCH_TAC 6018;
 426   (fun gl -> ( let asm_19 = snd(List.nth (List.rev (goal_asms gl)) 19 ) in ONCE_REWRITE_TAC [ asm_19 ]) gl);
 427   ONCE_REWRITE_TAC [ FUN_EQ_THM ];
 428   REWRITE_TAC [ IN_ELIM_THM ];
 429   BY(MESON_TAC []);
 430   DISCH_THEN (fun loc_t -> REWRITE_TAC [ loc_t ]);
 431   ASM_MESON_TAC []
 432   ]);;
 433   (* }}} *)
 434
 435 let facet_rep_in_poly = prove_by_refinement(
 436   `!(P:real^2->bool) c r. polyhedron P /\ (c facet_of P) /\
 437   (&0 < r) /\ (!p. norm p < r ==> P p) ==>
 438   P (r % facet_rep_a P c)
 439 `,
 440   (* {{{ proof *)
 441   [
 442   REPEAT WEAK_STRIP_TAC;
 443   MATCH_MP_TAC POLYHEDRON_MEMBER;
 444   EXISTSv_TAC "r";
 445   ASM_REWRITE_TAC [];
 446   REPEAT WEAK_STRIP_TAC;
 447   (fun gl -> (ASM_CASES_TAC ( env gl `c' = c`)) gl);
 448   BY(ASM_MESON_TAC [ facet_rep_refl ]);
 449   BY(ASM_MESON_TAC [ facet_rep_in_facet; REAL_ARITH `~(x <= y) ==> (y <= x)`])
 450   ]);;
 451   (* }}} *)
 452
 453 let facet_rep_not_in_facet = prove_by_refinement(
 454   `!(P:real^2->bool) c c' r. polyhedron P /\ (c facet_of P) /\ (c' facet_of P) /\
 455   (&0 < r) /\ (!p. norm p < r ==> P p) /\ (c' (r % facet_rep_a P c)) ==>
 456   (c' = c)`,
 457   (* {{{ proof *)
 458   [
 459   REPEAT WEAK_STRIP_TAC;
 460   MATCH_MP_TAC facet_rep_in_facet;
 461   EXISTSv_TAC "P";
 462   EXISTSv_TAC "r";
 463   ASM_REWRITE_TAC [];
 464   (fun gl -> (MP_TAC (SPECL ( envl gl [`P`;`c'`]) facet_rep_def)) gl);
 465   ASM_REWRITE_TAC [];
 466   REPEAT WEAK_STRIP_TAC;
 467   (fun gl -> ( let asm_9 = snd(List.nth (List.rev (goal_asms gl)) 9 ) in HASH_RULE_TAC 2871 ( ONCE_REWRITE_RULE [ asm_9 ] )) gl);
 468   REWRITE_TAC [ IN_ELIM_THM;INTER ];
 469   REAL_ARITH_TAC
 470   ]);;
 471   (* }}} *)
 472
 473 let facet_arg_lt_pi = prove_by_refinement(
 474   `!(P:real^2->bool) c r. polyhedron P /\ bounded P /\ c facet_of P /\
 475   (&0 < r) /\ (!p. norm p < r ==> P p) ==>
 476   (?c'. c' facet_of P /\ (&0 < Arg ( facet_rep_a P c' / facet_rep_a P c ) /\
 477      Arg (facet_rep_a P c' / facet_rep_a P c) < pi)) `,
 478   (* {{{ proof *)
 479   [
 480   REWRITE_TAC [bounded;IN;ARG_LT_PI];
 481   REPEAT WEAK_STRIP_TAC;
 482   PROOF_BY_CONTR_TAC;
 483   ABBREV_TAC `(p:real^2) = Cx (a + &1) * ii * facet_rep_a P c`;
 484   HASH_RULE_TAC 2054 (REWRITE_RULE [ NOT_EXISTS_THM ]);
 485   DISCH_TAC;
 486   TYPIFY `P (vec 0)` (C SUBGOAL_THEN ASSUME_TAC);
 487   FIRST_X_ASSUM MATCH_MP_TAC;
 488   BY(ASM_REWRITE_TAC [ NORM_0 ]);
 489   SUBGOAL_THEN (`&0 <= a`) ASSUME_TAC;
 490   BY(ASM_MESON_TAC [ NORM_0 ]);
 491   TYPIFY `P p` (C SUBGOAL_THEN ASSUME_TAC);
 492   MATCH_MP_TAC POLYHEDRON_MEMBER;
 493   EXISTSv_TAC "r";
 494   ASM_REWRITE_TAC [];
 495   REPEAT WEAK_STRIP_TAC;
 496   TYPIFY `c'` (HASH_RULE_TAC 7404 o SPEC);
 497   ASM_REWRITE_TAC [];
 498   DISCH_TAC;
 499   MATCH_MP_TAC REAL_LE_TRANS;
 500   EXISTS_TAC `&0`;
 501   MATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`);
 502   CONJ_TAC;
 503   BY(ASM_MESON_TAC [ facet_rep_def; REAL_ARITH `&0 < r /\ r <= x ==> &0 <= x` ]);
 504   REWRITE_TAC [ DOT_RE ];
 505   EXPAND_TAC "p";
 506   REWRITE_TAC [ CNJ_MUL;CNJ_CX;CNJ_II ];
 507   SUBGOAL_THEN `facet_rep_a P c' * Cx (a + &1) * --ii * cnj (facet_rep_a P c) = -- (ii * Cx (a + &1) * facet_rep_a P c'  * cnj (facet_rep_a P c))` SUBST1_TAC;
 508   SIMPLE_COMPLEX_ARITH_TAC;
 509   REWRITE_TAC [ RE_NEG;IM_MUL_CX;RE_MUL_II;REAL_ARITH ` -- -- x = x`;REAL_ARITH `a * u <= &0 <=> &0 <= a * (-- u)` ];
 510   MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2;
 511   ASM_SIMP_TAC [ REAL_ARITH `&0 <= a ==> &0 <= a + &1`];
 512   REWRITE_TAC [ REAL_ARITH `(&0 <= -- x <=> ~(&0 < x))` ];
 513   BY(ASM_MESON_TAC [ IM_COMPLEX_DIV_GT_0 ]);
 514   TYPIFY `p` (HASH_RULE_TAC 8984 o SPEC);
 515   ASM_REWRITE_TAC [];
 516   EXPAND_TAC "p";
 517   REWRITE_TAC [ COMPLEX_NORM_MUL ];
 518   REWRITE_TAC [ COMPLEX_NORM_MUL;COMPLEX_NORM_II; COMPLEX_NORM_CX; ];
 519   (fun gl -> (MP_TAC (SPECL ( envl gl [`P`;`c`]) facet_rep_def)) gl);
 520   ASM_REWRITE_TAC [];
 521   REPEAT WEAK_STRIP_TAC;
 522   HASH_UNDISCH_TAC 8903;
 523   ASM_REWRITE_TAC [];
 524   (CONV_TAC REAL_FIELD)
 525   ]);;
 526   (* }}} *)
 527
 528 let eus_cos  = prove_by_refinement(
 529   `!phi psi. &0 <= psi /\ psi <= phi /\ phi <= &2 * pi - psi ==>
 530     cos phi <= cos psi`,
 531   (* {{{ proof *)
 532 [
 533 REPEAT STRIP_TAC ;
 534 DISJ_CASES_TAC (REAL_ARITH `phi <= pi \/ (pi <= phi)`);
 535 MATCH_MP_TAC COS_MONO_LE;
 536 ASM_REWRITE_TAC [];
 537 ABBREV_TAC `phi' = &2 * pi - phi`;
 538 HASH_UNDISCH_TAC 6556 ;
 539     DISCH_THEN (fun t -> (REPEAT (POP_ASSUM MP_TAC) THEN REWRITE_TAC[REWRITE_RULE[REAL_ARITH `x - y = u <=> (y = x - u)`] t]));
 540 REWRITE_TAC [REAL_ARITH `pi <= &2 * pi - phi' <=> phi' <= pi`;GSYM Trigonometry2.COS_SUM_2PI];
 541 REPEAT STRIP_TAC ;
 542 MATCH_MP_TAC COS_MONO_LE;
 543 ASM_REAL_ARITH_TAC
 544 ]);;
 545   (* }}} *)
 546
 547 let insert_v = prove_by_refinement(
 548   `!P c c' r v psi. polyhedron P /\ c facet_of P /\ c' facet_of P /\
 549    (&0 < r) /\ (!p. norm p < r ==> P p) /\
 550    Arg(v / facet_rep_a P c) = psi /\
 551     &0 < psi /\
 552    psi < pi / &2 /\
 553    Arg (facet_rep_a P c' / facet_rep_a P c) =    &2 * psi  /\
 554    (!c''. (c'' facet_of P /\ Arg (facet_rep_a P c'' / facet_rep_a P c) < &2 * psi) ==> (c'' = c)) /\
 555    norm v = r / cos psi ==>
 556    (P v)`,
 557   (* {{{ proof *)
 558   [
 559   REPEAT WEAK_STRIP_TAC;
 560   MATCH_MP_TAC POLYHEDRON_MEMBER;
 561   EXISTSv_TAC "r";
 562   ASM_REWRITE_TAC [];
 563   REPEAT WEAK_STRIP_TAC;
 564   REWRITE_TAC [ DOT_RE ];
 565   ONCE_REWRITE_TAC [ ARG ];
 566   ASM_REWRITE_TAC [ RE_MUL_CX ; COMPLEX_NORM_MUL;COMPLEX_NORM_CNJ;RE_CEXP;RE_MUL_II;IM_MUL_II;IM_CX;RE_CX ];
 567   REWRITE_TAC [ REAL_ARITH `-- &0 = &0`;REAL_EXP_0 ];
 568   TYPIFY `~(v = Cx (&0))` (C SUBGOAL_THEN ASSUME_TAC);
 569   REWRITE_TAC [ GSYM COMPLEX_VEC_0 ];
 570   DISCH_TAC;
 571   HASH_UNDISCH_TAC 5247;
 572   ASM_REWRITE_TAC [NORM_0];
 573   MATCH_MP_TAC (REAL_ARITH `&0 < x ==> ~(&0 = x)`);
 574   REWRITE_TAC [ Calc_derivative.invert_den_lt ];
 575   MATCH_MP_TAC REAL_LT_MUL;
 576   ASM_REWRITE_TAC [];
 577   BY(ASM_SIMP_TAC [ COS_POS_PI2 ]);
 578   ASM_SIMP_TAC [ GSYM ARG_CNJ ];
 579   MATCH_MP_TAC REAL_LE_TRANS;
 580   EXISTSv_TAC "r";
 581   MATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`);
 582   CONJ_TAC;
 583   BY(ASM_MESON_TAC [ facet_rep_def ]);
 584   SUBGOAL_THEN `norm (facet_rep_a P c'') = &1` SUBST1_TAC;
 585   BY (ASM_MESON_TAC [ facet_rep_def ]);
 586   TYPED_ABBREV_TAC `(phi:real) = Arg (facet_rep_a P c'' / v)`;
 587   REWRITE_TAC [ real_div; REAL_ARITH `(&1 * r * v) * &1 * u = r * u * v` ];
 588   REWRITE_TAC [ REAL_ARITH `r * x <= r <=> &0 <= r * (&1 - x)` ];
 589   MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2;
 590   CONJ_TAC;
 591   ASM_REAL_ARITH_TAC;
 592   REWRITE_TAC [ REAL_ARITH `&0 <= &1 - x * inv y <=> x / y <= &1`];
 593   MATCH_MP_TAC Trigonometry2.REAL_LE_LDIV;
 594   SUBGOAL_THEN `&0 < cos psi` ASSUME_TAC;
 595   ASM_SIMP_TAC [ COS_POS_PI2 ];
 596   ASM_REWRITE_TAC [];
 597   MATCH_MP_TAC eus_cos;
 598   CONJ_TAC;
 599   ASM_REAL_ARITH_TAC;
 600   (fun gl -> (ASM_CASES_TAC ( env gl `c'' = c`)) gl);
 601   EXPAND_TAC "phi";
 602   HASH_KILL_TAC 2447;
 603   ASM_REWRITE_TAC [];
 604   MP_TAC ARG_INV;
 605   REWRITE_TAC [ GSYM ARG_EQ_0 ];
 606   ONCE_REWRITE_TAC [ GSYM COMPLEX_INV_DIV ];
 607   DISCH_TAC;
 608   TYPIFY `Arg (inv (v/ facet_rep_a P c)) = &2 * pi - Arg (v / facet_rep_a P c)` (C SUBGOAL_THEN SUBST1_TAC);
 609   FIRST_X_ASSUM MATCH_MP_TAC;
 610   MATCH_MP_TAC( REAL_ARITH `&0 < psi ==> ~(psi = &0)` );
 611   BY(ASM_SIMP_TAC[]);
 612   (fun gl -> ( let asm_5 = snd(List.nth (List.rev (goal_asms gl)) 5 ) in REWRITE_TAC [ asm_5 ]) gl);
 613   HASH_UNDISCH_TAC 8776;
 614   HASH_UNDISCH_TAC 4801;
 615   MP_TAC PI_POS;
 616   BY(REAL_ARITH_TAC);
 617   TYPIFY `c''` (HASH_RULE_TAC 6343 o SPEC);
 618   ASM_REWRITE_TAC [ REAL_ARITH `~(x < y) <=> (y <= x)`];
 619   SUBGOAL_THEN `!c. c facet_of P ==> ~(facet_rep_a P c = Cx (&0))` ASSUME_TAC;
 620   REWRITE_TAC [ GSYM COMPLEX_VEC_0 ];
 621   REPEAT WEAK_STRIP_TAC;
 622   BY(ASM_MESON_TAC [ NORM_0; facet_rep_def; REAL_ARITH`~(&0 = &1)` ]);
 623   SUBGOAL_THEN `!x y. x / y = Cx (&0) <=> (x = Cx (&0) \/ y = Cx (&0))` ASSUME_TAC;
 624   BY(REWRITE_TAC [ COMPLEX_ENTIRE;complex_div;COMPLEX_INV_EQ_0 ]);
 625   TYPED_ABBREV_TAC `(z:complex) = facet_rep_a P c'' / facet_rep_a P c`;
 626   TYPED_ABBREV_TAC `w = v / facet_rep_a P c`;
 627   DISCH_TAC;
 628   SUBGOAL_THEN ( `Arg z = Arg w + Arg (z/ w)` ) ASSUME_TAC;
 629   MATCH_MP_TAC ARG_LE_DIV_SUM;
 630   EXPAND_TAC "w";
 631   HASH_UNDISCH_TAC 8513;
 632   EXPAND_TAC "z";
 633   HASH_KILL_TAC 7462;
 634   ASM_SIMP_TAC [];
 635   HASH_UNDISCH_TAC 8776;
 636   REAL_ARITH_TAC;
 637   SUBGOAL_THEN `phi = Arg (z / w)` ASSUME_TAC;
 638   EXPAND_TAC "z";
 639   EXPAND_TAC "w";
 640   EXPAND_TAC "phi";
 641   AP_TERM_TAC;
 642   REWRITE_TAC [ complex_div ;COMPLEX_INV_MUL;COMPLEX_INV_INV];
 643   SUBGOAL_THEN `(facet_rep_a P c'' * inv (facet_rep_a P c)) * inv v * facet_rep_a P c = facet_rep_a P c'' * inv v * (inv (facet_rep_a P c) * facet_rep_a P c)` SUBST1_TAC;
 644   SIMPLE_COMPLEX_ARITH_TAC;
 645   BY(ASM_SIMP_TAC [ COMPLEX_MUL_RID;COMPLEX_MUL_LINV ] );
 646   ASM_REWRITE_TAC [];
 647   EXPAND_TAC "psi";
 648   HASH_UNDISCH_TAC 8513;
 649   HASH_UNDISCH_TAC 6318;
 650   EXPAND_TAC "psi";
 651   MP_TAC (SPEC `(z:complex)` ARG);
 652   REAL_ARITH_TAC
 653   ]);;
 654   (* }}} *)
 655
 656 let facet_rep_a_uniq = prove_by_refinement(
 657   `!(P:real^2->bool) c1 c2 r. polyhedron P /\ c1 facet_of P /\ c2 facet_of P /\
 658     (&0 < r ) /\  (!p. norm p < r ==> P p) /\
 659     (?s. (&0 < s) /\ facet_rep_a P c1 = s % facet_rep_a P c2) ==> (c1 = c2)
 660       `,
 661   (* {{{ proof *)
 662   [
 663   REPEAT WEAK_STRIP_TAC;
 664   SUBGOAL_THEN `norm (facet_rep_a P c1) = s` ASSUME_TAC;
 665   ASM_REWRITE_TAC [ NORM_MUL ];
 666   ASM_SIMP_TAC [ REAL_ARITH `&0 < s ==> (abs s = s)` ];
 667   SUBGOAL_THEN `norm (facet_rep_a P c2) = &1` SUBST1_TAC;
 668   ASM_MESON_TAC [ facet_rep_def ];
 669   BY (REAL_ARITH_TAC );
 670   SUBGOAL_THEN `norm (facet_rep_a P c1) = &1` ASSUME_TAC;
 671   BY (ASM_MESON_TAC [ facet_rep_def ] );
 672   HASH_UNDISCH_TAC 1250;
 673   SUBGOAL_THEN `s = &1` SUBST1_TAC;
 674   ASM_MESON_TAC [];
 675   REWRITE_TAC [ VECTOR_MUL_LID ];
 676   (fun gl -> (MP_TAC (SPECL ( envl gl [`P`;`c1`]) facet_rep_def)) gl);
 677   (fun gl -> (MP_TAC (SPECL ( envl gl [`P`;`c2`]) facet_rep_def)) gl);
 678   ASM_REWRITE_TAC [];
 679   (fun gl -> (MP_TAC (SPECL ( envl gl [`P`;`facet_rep_a P c1`;`facet_rep_b P c1`;`facet_rep_b P c2`]) facet_rep_uniq)) gl);
 680   ASM_REWRITE_TAC [];
 681   REPEAT WEAK_STRIP_TAC;
 682   HASH_RULE_TAC 1397 (MATCH_MP ( TAUT `(a ==> (b /\ c)) ==> (a ==> c)`));
 683   DISCH_THEN MATCH_MP_TAC;
 684   ASM_SIMP_TAC [];
 685   ASM_REWRITE_TAC [];
 686   MATCH_MP_TAC (TAUT (`a /\ b ==> b /\ a`));
 687   CONJ_TAC;
 688   HASH_UNDISCH_TAC 3107;
 689   BY(DISCH_THEN ACCEPT_TAC);
 690   HASH_UNDISCH_TAC 119;
 691   ASM_REWRITE_TAC []
 692   ]);;
 693   (* }}} *)
 694
 695 let poly_sort_fn = new_definition `poly_sort_fn P u c1 c2 =
 696   ((c1 facet_of P) /\ (c2 facet_of P) /\
 697  (Arg (facet_rep_a P c1 / u) <= Arg (facet_rep_a P c2 / u)))`;;
 698
 699 let poly_sort_antisym = prove_by_refinement(
 700   `!P u c1 c2 r. (polyhedron P) /\ (&0 < r) /\ (!p. (norm p < r)==> (P p))
 701    /\ poly_sort_fn P u c1 c2 /\  poly_sort_fn P u c2 c1 /\  ~(u = Cx (&0))
 702    ==> (c1 = c2)`,
 703   (* {{{ proof *)
 704   [
 705   REWRITE_TAC [ poly_sort_fn ];
 706   REPEAT WEAK_STRIP_TAC;
 707   TYPIFY `Arg (facet_rep_a P c1 / u) = Arg (facet_rep_a P c2 / u)` (C SUBGOAL_THEN ASSUME_TAC);
 708   ASM_REAL_ARITH_TAC;
 709   HASH_KILL_TAC 5764;
 710   HASH_KILL_TAC 6109;
 711   TYPIFY `!c. c facet_of P ==> ~(facet_rep_a P c = Cx (&0))` (C SUBGOAL_THEN ASSUME_TAC);
 712   BY(ASM_MESON_TAC [ NORM_0; COMPLEX_VEC_0; facet_rep_def; REAL_ARITH `~(&0 = &1)` ]);
 713   PROOF_BY_CONTR_TAC;
 714   HASH_UNDISCH_TAC 8621;
 715   ASM_SIMP_TAC [ ARG_EQ ; ARG_0_DIV ];
 716   REWRITE_TAC [ NOT_EXISTS_THM ];
 717   GEN_TAC;
 718   MATCH_MP_TAC (TAUT `(a ==> ~b ) ==> ~(a /\ b)`);
 719   DISCH_TAC;
 720   SUBGOAL_THEN `facet_rep_a P c1 / u = Cx x * facet_rep_a P c2 / u <=> facet_rep_a P c1 = Cx x * facet_rep_a P c2` SUBST1_TAC;
 721   REWRITE_TAC [ complex_div ];
 722   HASH_UNDISCH_TAC 9092;
 723   BY(SIMP_TAC [ COMPLEX_MUL_ASSOC;COMPLEX_EQ_MUL_RCANCEL;COMPLEX_INV_EQ_0 ]);
 724   REWRITE_TAC [ GSYM COMPLEX_CMUL ];
 725   DISCH_TAC;
 726   ASM_MESON_TAC [facet_rep_a_uniq]
 727   ]);;
 728   (* }}} *)
 729
 730 let poly_sort_trans = prove_by_refinement(
 731   `!P u c1 c2 c3 r. polyhedron P /\ (&0 < r) /\ (!p. norm p < r ==> P p) /\
 732     ~(u = Cx (&0)) /\
 733     poly_sort_fn P u c1 c2 /\ poly_sort_fn P u c2 c3 ==>
 734     poly_sort_fn P u c1 c3`,
 735   (* {{{ proof *)
 736   [
 737   REWRITE_TAC [ poly_sort_fn ];
 738   REPEAT WEAK_STRIP_TAC;
 739   ASM_REWRITE_TAC [];
 740   ASM_REAL_ARITH_TAC
 741   ]);;
 742   (* }}} *)
 743
 744 let POLY_SORT_LEMMA = prove_by_refinement(
 745   `!P n s r u.  (s = { c | c facet_of P }) /\ polyhedron P /\ (&0 < r) /\
 746      (!p. norm p < r ==> P p) /\ ~(u = Cx (&0)) /\ (s HAS_SIZE n) ==>
 747     (?f. s = IMAGE f (1..n) /\  (!j k.
 748                                    j IN 1..n /\ k IN 1..n /\ j < k
 749                                    ==> ~(poly_sort_fn P u (f k) (f j))))`,
 750   (* {{{ proof *)
 751   [
 752   REPEAT WEAK_STRIP_TAC;
 753   MP_TAC (SPEC `poly_sort_fn P u` (INST_TYPE [`:(real^2->bool)`,`:A`] TOPOLOGICAL_SORT));
 754   ANTS_TAC;
 755   ASM_MESON_TAC [poly_sort_antisym;poly_sort_trans];
 756   (fun gl -> (DISCH_THEN (MP_TAC o (SPECL ( envl gl [`n`;`s`])))) gl);
 757   ASM_MESON_TAC []
 758   ]);;
 759   (* }}} *)
 760
 761 let POLY_SORT = prove_by_refinement(
 762   `!P n s r u.  (s = { c | c facet_of P }) /\ polyhedron P /\ (&0 < r) /\
 763      (!p. norm p < r ==> P p) /\ ~(u = Cx (&0)) /\ (s HAS_SIZE n) ==>
 764     (?f. s = IMAGE f (1..n) /\
 765   (!j k. j IN 1..n /\ k IN 1..n /\ j < k
 766       ==> (Arg (facet_rep_a P (f j) / u) < Arg (facet_rep_a P (f k) / u))))`,
 767   (* {{{ proof *)
 768   [
 769   REPEAT WEAK_STRIP_TAC;
 770   (fun gl -> (MP_TAC (SPECL ( envl gl [`P`;`n`;`s`;`r`;`u`]) POLY_SORT_LEMMA)) gl);
 771   ASM_REWRITE_TAC [];
 772   REPEAT WEAK_STRIP_TAC;
 773   EXISTSv_TAC "f";
 774   ASM_REWRITE_TAC [];
 775   REPEAT WEAK_STRIP_TAC;
 776   (fun gl -> (HASH_RULE_TAC 9718 (SPECL ( envl gl [`j`;`k`]))) gl);
 777   ASM_REWRITE_TAC [ poly_sort_fn ];
 778   TYPIFY `!i. (i IN 1..n) ==> (f i facet_of P)` (C SUBGOAL_THEN ASSUME_TAC);
 779   REPEAT WEAK_STRIP_TAC;
 780   HASH_UNDISCH_TAC 8348;
 781   ONCE_REWRITE_TAC [ FUN_EQ_THM ];
 782   REWRITE_TAC [ IN_ELIM_THM;IMAGE; ];
 783   BY(ASM_MESON_TAC []);
 784   ASM_SIMP_TAC [];
 785   MATCH_MP_TAC (REAL_ARITH `~(a = b) ==> (~(b <= a) ==> (a < b))`);
 786   DISCH_TAC;
 787   TYPIFY `f j = f k` (C SUBGOAL_THEN ASSUME_TAC);
 788   MATCH_MP_TAC poly_sort_antisym;
 789   EXISTSv_TAC "P";
 790   EXISTSv_TAC "u";
 791   EXISTSv_TAC "r";
 792   ASM_REWRITE_TAC [poly_sort_fn; REAL_ARITH `x <= x`];
 793   HASH_UNDISCH_TAC 8348;
 794   ONCE_REWRITE_TAC [ FUN_EQ_THM ];
 795   REWRITE_TAC [IN;IN_ELIM_THM;IMAGE];
 796   BY(ASM_MESON_TAC [IN]);
 797   TYPIFY `INJ f (1..n) s  = SURJ f (1..n) s` (C SUBGOAL_THEN ASSUME_TAC);
 798   MATCH_MP_TAC INJ_IFF_SURJ;
 799   BY(ASM_MESON_TAC [ HAS_SIZE_NUMSEG_1; HAS_SIZE ]);
 800   TYPIFY `SURJ f (1..n) s` (C SUBGOAL_THEN ASSUME_TAC);
 801   BY(ASM_REWRITE_TAC [Misc_defs_and_lemmas.IMAGE_SURJ]);
 802   HASH_UNDISCH_TAC 7609;
 803   ASM_REWRITE_TAC [];
 804   REWRITE_TAC [INJ;IMAGE;DE_MORGAN_THM];
 805   DISJ2_TAC;
 806   ASM_MESON_TAC [ ARITH_RULE `j < k ==> ~((j:num) = k)`]
 807   ]);;
 808   (* }}} *)
 809
 810 let POLY_SORT_BIJ = prove_by_refinement(
 811   `!P n s r u.  (s = { c | c facet_of P }) /\ polyhedron P /\ (&0 < r) /\
 812      (!p. norm p < r ==> P p) /\ ~(u = Cx (&0)) /\ (s HAS_SIZE n) ==>
 813     (?f. s = IMAGE f (1..n) /\ BIJ f (1..n) s /\
 814   (!j k. j IN 1..n /\ k IN 1..n /\ j < k
 815       ==> (Arg (facet_rep_a P (f j) / u) < Arg (facet_rep_a P (f k) / u))))`,
 816   (* {{{ proof *)
 817   [
 818   REPEAT WEAK_STRIP_TAC;
 819   (fun gl -> (MP_TAC (SPECL ( envl gl [`P`;`n`;`s`;`r`;`u`]) POLY_SORT)) gl);
 820   ASM_REWRITE_TAC [];
 821   REPEAT WEAK_STRIP_TAC;
 822   EXISTSv_TAC "f";
 823   ASM_REWRITE_TAC [BIJ;Misc_defs_and_lemmas.IMAGE_SURJ;INJ;IN_IMAGE];
 824   CONJ_TAC;
 825   BY(MESON_TAC []);
 826   REPEAT WEAK_STRIP_TAC;
 827   REWRITE_TAC [ ARITH_RULE `(x = y) <=> ~(x < (y:num)) /\ ~(y < x)` ];
 828   ASM_MESON_TAC [ REAL_ARITH `(x = y) ==> ~( x < y)` ]
 829   ]);;
 830   (* }}} *)
 831
 832 let facet_rep_nz = prove_by_refinement(
 833   `!P c. polyhedron P /\ c facet_of P ==> ~(facet_rep_a P c = Cx (&0))`,
 834   (* {{{ proof *)
 835   [
 836   MESON_TAC [ COMPLEX_VEC_0; NORM_0 ; REAL_ARITH `~(&0= &1)`; facet_rep_def]
 837   ]);;
 838   (* }}} *)
 839
 840 let bisector_point_exists = prove_by_refinement(
 841   ` !P c c' r. ?v. !psi. (polyhedron P /\ c facet_of P /\ c' facet_of P /\ &0 < r /\
 842     (!p. norm p < r ==> P p) /\
 843     psi = Arg (facet_rep_a P c' / facet_rep_a P c) / &2 /\
 844     (!c''. c'' facet_of P /\
 845             Arg (facet_rep_a P c'' / facet_rep_a P c) < &2 * psi
 846             ==> c'' = c) /\
 847     psi < pi/ &2 /\ ~(c' = c)) ==>
 848     (P v /\ norm v = r * inv (cos (psi)) /\ Arg ( v/ facet_rep_a P c) = psi /\
 849     Arg (facet_rep_a P c' / v) = psi)`,
 850   (* {{{ proof *)
 851   [
 852   REPEAT WEAK_STRIP_TAC;
 853   TYPED_ABBREV_TAC `psi = Arg (facet_rep_a P c' / facet_rep_a P c) / &2`;
 854   TYPED_ABBREV_TAC `(u:real^2) = facet_rep_a P c`;
 855   TYPED_ABBREV_TAC `(v:real^2) = Cx (r * inv (cos (psi))) * cexp (ii * (Cx psi)) * u`;
 856   EXISTSv_TAC "v";
 857   REPEAT WEAK_STRIP_TAC;
 858   MATCH_MP_TAC (TAUT `b /\ (b ==> c) /\ ( b /\ c ==> d) /\ ( b /\ c /\ d ==> a) ==> a /\ b /\ c /\ d `);
 859   SUBGOAL_THEN `&0 <= psi` ASSUME_TAC;
 860     HASH_KILL_TAC 8647;
 861     EXPAND_TAC "psi";
 862     BY(MESON_TAC [ ARG ; REAL_ARITH `&0 <= x ==> &0 <= x/ &2`]);
 863   CONJ_TAC;
 864     EXPAND_TAC "v";
 865     REWRITE_TAC [COMPLEX_NORM_MUL;COMPLEX_NORM_CX;NORM_CEXP_II;REAL_ABS_MUL];
 866     EXPAND_TAC "u";
 867     ASM_SIMP_TAC [facet_rep_def; Trigonometry2.LT_IMP_ABS_REFL ];
 868     SUBGOAL_THEN `abs(inv(cos psi)) = inv (cos psi)` SUBST1_TAC;
 869       REWRITE_TAC [ ( Trigonometry2.ABS_REFL);REAL_LE_INV_EQ];
 870       MATCH_MP_TAC Trigonometry.ZSKECZV;
 871       MP_TAC PI_POS;
 872       BY(ASM_REAL_ARITH_TAC);
 873     BY(REAL_ARITH_TAC);
 874   SUBGOAL_THEN `&0 < r * inv (cos psi)` ASSUME_TAC;
 875     MATCH_MP_TAC REAL_LT_MUL;
 876     ASM_REWRITE_TAC [ REAL_LT_INV_EQ ];
 877     MATCH_MP_TAC COS_POS_PI;
 878     MP_TAC PI_POS;
 879     ASM_REAL_ARITH_TAC;
 880   CONJ_TAC;
 881     DISCH_TAC;
 882     EXPAND_TAC "v";
 883     REWRITE_TAC [ complex_div;GSYM COMPLEX_MUL_ASSOC ];
 884     SUBGOAL_THEN ( `u * inv u = Cx (&1)` ) SUBST1_TAC;
 885       MATCH_MP_TAC COMPLEX_MUL_RINV;
 886       BY(ASM_MESON_TAC [ facet_rep_def ; NORM_0 ; COMPLEX_VEC_0 ; REAL_ARITH `~(&0 = &1)` ]);
 887     ASM_SIMP_TAC [ARG_MUL_CX];
 888     REWRITE_TAC [COMPLEX_MUL_RID];
 889     MATCH_MP_TAC ARG_UNIQUE;
 890     EXISTS_TAC `&1`;
 891     ASM_REWRITE_TAC [COMPLEX_MUL_LID;REAL_ARITH `&0 < &1`];
 892     MP_TAC PI_POS;
 893     BY(ASM_REAL_ARITH_TAC);
 894   CONJ_TAC;
 895     DISCH_TAC;
 896     (fun gl -> (MP_TAC (SPECL ( envl gl [`(v:complex) / u`;`facet_rep_a P c' / (u:complex)`]) ARG_LE_DIV_SUM)) gl);
 897     ANTS_TAC;
 898       REWRITE_TAC [ ARG_0_DIV ];
 899       MATCH_MP_TAC (TAUT `(a /\ b) /\ c ==> a /\ b /\ c`);
 900       CONJ_TAC;
 901         ASM_MESON_TAC [ NORM_0; REAL_ARITH `~(&0 < &0)`; facet_rep_def; REAL_ARITH `~(&0 = &1)` ; COMPLEX_VEC_0 ];
 902       BY(ASM_REAL_ARITH_TAC);
 903     TYPIFY `facet_rep_a P c' / u / (v/ u) = facet_rep_a P c' / v` (C SUBGOAL_THEN (argthen SUBST1_TAC ASM_REAL_ARITH_TAC));
 904     REWRITE_TAC [ complex_div ; GSYM COMPLEX_MUL_ASSOC ];
 905     AP_TERM_TAC;
 906     REWRITE_TAC [ COMPLEX_INV_MUL;COMPLEX_INV_INV];
 907     SUBGOAL_THEN `(inv u * u = Cx (&1)) ==> (inv (u:complex) * inv v * u = inv v) ` MATCH_MP_TAC;
 908       SIMPLE_COMPLEX_ARITH_TAC;
 909     MATCH_MP_TAC COMPLEX_MUL_LINV;
 910     BY(ASM_MESON_TAC [ facet_rep_def; NORM_0 ; COMPLEX_VEC_0 ; REAL_ARITH `~(&0 = &1)` ]);
 911   REPEAT WEAK_STRIP_TAC;
 912   MATCH_MP_TAC insert_v;
 913   EXISTSv_TAC "c";
 914   EXISTSv_TAC "c'";
 915   EXISTSv_TAC "r";
 916   EXISTSv_TAC "psi";
 917   ASM_REWRITE_TAC [];
 918   SUBCONJ_TAC;
 919     ASM_SIMP_TAC [ (REAL_ARITH `&0 <= psi ==> (&0 < psi <=> ~(psi = &0))`)];
 920     DISCH_TAC;
 921     HASH_UNDISCH_TAC 1934;
 922     ASM_REWRITE_TAC [];
 923     EXPAND_TAC "u";
 924     REWRITE_TAC [ (REAL_ARITH `x / &2 = &0 <=> x = &0`)];
 925     REWRITE_TAC [ ARG_EQ_0; REAL_EXISTS;DE_MORGAN_THM;NOT_EXISTS_THM ];
 926     MATCH_MP_TAC (TAUT `(b ==> a) ==> (a \/ ~b)`);
 927     REPEAT WEAK_STRIP_TAC;
 928     HASH_UNDISCH_TAC 2684;
 929     ASM_REWRITE_TAC [];
 930     DISCH_TAC;
 931     SUBGOAL_THEN `!u v. u = v ==> (u * facet_rep_a P c = v * facet_rep_a P c)` MP_TAC;
 932       REWRITE_TAC [ COMPLEX_EQ_MUL_RCANCEL ];
 933       BY(MESON_TAC []);
 934     DISCH_THEN (fun loc_u -> FIRST_X_ASSUM (fun loc_t -> MP_TAC (MATCH_MP loc_u loc_t)));
 935     REWRITE_TAC [ complex_div ; GSYM COMPLEX_MUL_ASSOC ];
 936     ASM_SIMP_TAC [ COMPLEX_MUL_LINV ; facet_rep_nz; COMPLEX_MUL_RID ];
 937     EXPAND_TAC "u";
 938     REWRITE_TAC [GSYM COMPLEX_CMUL];
 939     HASH_RULE_TAC 8014 ( REWRITE_RULE[ RE_CX]);
 940     DISCH_TAC;
 941     DISCH_TAC;
 942     SUBGOAL_THEN `&0 < x` ASSUME_TAC;
 943       ASM_SIMP_TAC [(REAL_ARITH `&0 <= x ==> (&0 < x <=> ~(x = &0))`)];
 944       DISCH_TAC;
 945       HASH_UNDISCH_TAC 487;
 946       ASM_REWRITE_TAC [ VECTOR_MUL_LZERO; COMPLEX_VEC_0 ];
 947       BY(ASM_MESON_TAC [ facet_rep_nz ]);
 948     BY(ASM_MESON_TAC [ facet_rep_a_uniq]);
 949   FULL_EXPAND_TAC "u";
 950   FULL_EXPAND_TAC "psi";
 951   ASM_REWRITE_TAC [ real_div ];
 952   ASM_REAL_ARITH_TAC
 953   ]);;
 954   (* }}} *)
 955
 956 let bisector_point = new_specification ["bisector_point"] (REWRITE_RULE[SKOLEM_THM] bisector_point_exists);;
 957
 958 let RCONE_LINEAR_INVARIANT = prove_by_refinement(
 959   `!(f:real^M->real^N) v a.
 960    linear f /\ (!y. ?x. f x = y) /\ (!x. norm (f x) = norm x)
 961   ==>   rcone_gt (vec 0) (f v) a    = IMAGE f (rcone_gt (vec 0) v a)`,
 962   (* {{{ proof *)
 963   [
 964   REWRITE_TAC [rcone_gt;rconesgn; VECTOR_SUB_RZERO; DIST_0];
 965   ONCE_REWRITE_TAC [FUN_EQ_THM];
 966   REWRITE_TAC [IMAGE;IN_ELIM_THM;IN];
 967   MESON_TAC[ PRESERVES_NORM_PRESERVES_DOT ]
 968   ]);;
 969   (* }}} *)
 970
 971 let FCHANGED_LINEAR_INVARIANT = prove_by_refinement(
 972   `!(f:real^M->real^N) c. linear f /\ (!x y. (f x = f y) ==> x = y)
 973     ==> fchanged (IMAGE f c) = IMAGE f (fchanged c)`,
 974   (* {{{ proof *)
 975   [
 976   REPEAT WEAK_STRIP_TAC;
 977   REWRITE_TAC [Polyhedron.fchanged];
 978   ONCE_REWRITE_TAC [FUN_EQ_THM];
 979   REWRITE_TAC[ IN_ELIM_THM];
 980   (fun gl -> (MP_TAC (ISPECL ( envl gl [`f`;`c`]) RELATIVE_INTERIOR_INJECTIVE_LINEAR_IMAGE )) gl);
 981   ASM_REWRITE_TAC [];
 982   DISCH_THEN SUBST1_TAC;
 983   GEN_TAC;
 984   EQ_TAC;
 985     REWRITE_TAC [IN_ELIM_THM;IN;IMAGE];
 986     REPEAT WEAK_STRIP_TAC;
 987     EXISTS_TAC `(t % x'):real^M`;
 988     ASM_SIMP_TAC [ LINEAR_CMUL ];
 989     BY(ASM_MESON_TAC []);
 990   REWRITE_TAC [ X_IN IN_IMAGE ];
 991   DISCH_THEN (MP_TAC o (REWRITE_RULE [IN_ELIM_THM]));
 992   REPEAT WEAK_STRIP_TAC;
 993   EXISTS_TAC `(f:real^M->real^N) v1`;
 994   EXISTSv_TAC "t";
 995   ASM_SIMP_TAC [ LINEAR_CMUL ];
 996   ASM_MESON_TAC [IN_IMAGE;IN_ELIM_THM;IN]
 997   ]);;
 998   (* }}} *)
 999
1000 let BALL_LINEAR_INVARIANT = prove_by_refinement(
1001   `!(f:real^M->real^M)  r. linear f /\ (!x. norm (f x) = norm x ) /\ (!y. ?x. f x = y)
1002     ==> IMAGE f (ball (vec 0,r)) = (ball (vec 0,r))`,
1003   (* {{{ proof *)
1004   [
1005   REPEAT WEAK_STRIP_TAC;
1006   ONCE_REWRITE_TAC [FUN_EQ_THM];
1007   REWRITE_TAC[ X_IN IN_IMAGE; X_IN IN_BALL_0 ];
1008   ASM_MESON_TAC []
1009   ]);;
1010   (* }}} *)
1011
1012 let cos_acs_pi6 = prove_by_refinement(
1013   `!h. &1 <= h /\ h <= h0 ==>
1014     cos (acs (h/ &2) - pi/ &6) = h * sqrt3 / #4.0 + sqrt(&1- (h/ &2) pow 2) / &2`,
1015   (* {{{ proof *)
1016   [
1017 REWRITE_TAC[COS_SUB;COS_PI6;SIN_PI6;Sphere.h0;Sphere.sqrt3];
1018 REPEAT STRIP_TAC;
1019   SUBGOAL_THEN `-- &1 <= h/ &2 /\ h/ &2 <= &1` MP_TAC;
1020 ASM_REAL_ARITH_TAC;
1021 REPEAT STRIP_TAC;
1022 ASM_SIMP_TAC[SIN_ACS;COS_ACS];
1023 REAL_ARITH_TAC
1024   ]);;
1025   (* }}} *)
1026
1027 let regular_spherical_polygon_area_asnFnhk = prove_by_refinement(
1028   `!h k . (3 <= k /\ &1 <= h /\ h <= h0) ==>
1029   (regular_spherical_polygon_area (h * sqrt3 / #4.0 + sqrt (&1 - (h/ &2) pow 2) / &2) (&k) =
1030      &2 * pi - &2 * asnFnhk h (&k) (&1) (&1) (&1) (&1))`,
1031   (* {{{ proof *)
1032   [
1033 REWRITE_TAC[Sphere.regular_spherical_polygon_area;Sphere.asnFnhk;Sphere.h0]
1034   ]);;
1035   (* }}} *)
1036
1037 let regular_spherical_polygon_area_797 = prove_by_refinement(
1038   `!h k . (3 <= k) ==>
1039   (regular_spherical_polygon_area (cos #0.797) (&k) =
1040      &2 * pi - &2 * (&k) * asn (cos #0.797 * sin (pi / &k)))`,
1041   (* {{{ proof *)
1042   [
1043 REWRITE_TAC[Sphere.regular_spherical_polygon_area;Sphere.asnFnhk;Sphere.h0]
1044   ]);;
1045   (* }}} *)
1046
1047 let BIEFJHU_explicit = prove_by_refinement(
1048   `!h k. (pack_ineq_def_a /\ &1 <= h /\ h <= h0 /\ 3 <= k) ==>
1049    (#0.591 - #0.0331 * (&k) + #0.506 * lfun h) <=
1050     max (&0) (regular_spherical_polygon_area
1051      (h * sqrt3 / #4.0 + sqrt (&1 - (h/ &2) pow 2) / &2) (&k))
1052    `,
1053   (* {{{ proof *)
1054   [
1055 REWRITE_TAC[pack_ineq_def_a;Sphere.ineq;Sphere.lfun_y1;Sphere.h0];
1056 REPEAT STRIP_TAC;
1057 ASM_CASES_TAC `&34 <= &k`;
1058 HASH_UNDISCH_TAC 4600 ;
1059     DISCH_THEN (MP_TAC o (SPECL [`h:real`;`&1`;`&1`;`&1`;`&1`;`&1`]));
1060 MP_TAC (REAL_MAX_MAX);
1061 BY(ASM_REAL_ARITH_TAC);
1062 HASH_UNDISCH_TAC 3073 ;
1063     DISCH_THEN (MP_TAC o (SPECL [`h:real`;`(&k)`;`&1`;`&1`;`&1`;`&1`]));
1064 ASM_SIMP_TAC[regular_spherical_polygon_area_asnFnhk;Sphere.h0;REAL_ARITH `&1 <= &1 /\ #3.0 = &3`];
1065 MP_TAC (REAL_MAX_MAX);
1066 HASH_RULE_TAC 415 (ONCE_REWRITE_RULE[GSYM REAL_OF_NUM_LE]);
1067 ASM_REWRITE_TAC [REAL_ARITH `#1.0 = &1`];
1068 ASM_SIMP_TAC [REAL_ARITH `~(&34 <= &k) ==> &k <= #34.0`];
1069 ASM_REAL_ARITH_TAC
1070   ]);;
1071   (* }}} *)
1072
1073 let UKBRPFE_explicit = prove_by_refinement(
1074   `!k. (pack_ineq_def_a /\ 3 <= k) ==>
1075    (#0.591 - #0.0331 * (&k) + #0.506 * lfun (&1) + &1 <=
1076     max (&0) (regular_spherical_polygon_area (cos #0.797) (&k)))`,
1077   (* {{{ proof *)
1078   [
1079 REWRITE_TAC[pack_ineq_def_a;Sphere.ineq;Sphere.lfun_y1;Sphere.h0;Sphere.asn797k];
1080 REPEAT STRIP_TAC;
1081 ASM_SIMP_TAC [regular_spherical_polygon_area_797];
1082 HASH_RULE_TAC 6953 (SPECL[`&k`;`&1`;`&1`;`&1`;`&1`;`&1`]);
1083 HASH_RULE_TAC 415 (ONCE_REWRITE_RULE[GSYM REAL_OF_NUM_LE;REAL_ARITH `&3 = #3.0`]);
1084 HASH_RULE_TAC 1319 (SPEC `&1`);
1085 MP_TAC (REAL_MAX_MAX);
1086 REAL_ARITH_TAC
1087   ]);;
1088   (* }}} *)
1089
1090 let DLWCHEM_sum = prove_by_refinement(
1091   `!h k n. pack_ineq_def_a /\
1092    (12 < n) /\ (!i. (i < n) ==> (3 <= k i) /\ (&1 <= h i) /\ (h i <= h0) ) /\
1093    (sum (0..(n-1)) (\i. &(k i)) <= (&6 * &n - &12)) /\
1094    (sum (0..(n-1))
1095       (\i. max (&0) (regular_spherical_polygon_area
1096          ((h i * sqrt3 / #4.0 + sqrt (&1 - (h i/ &2) pow 2)/ &2) ) (&(k i)) ))
1097       <= &4 * pi) /\
1098    (&12 < sum (0..(n-1)) (\i. lfun (h i)))
1099  ==> (n < 16)`,
1100   (* {{{ proof *)
1101   [
1102 REPEAT STRIP_TAC;
1103   SUBGOAL_THEN `sum (0..(n-1)) (\i. (#0.591 - #0.0331 * (&(k i)) + #0.506 * lfun (h i))) <= sum(0..(n-1)) (\i. max (&0) (regular_spherical_polygon_area ((h i * sqrt3 / #4.0 + sqrt (&1 - (h i/ &2) pow 2)/ &2) ) (&(k i)) ))` ASSUME_TAC;
1104 MATCH_MP_TAC SUM_LE_NUMSEG;
1105 ASM_SIMP_TAC [ARITH_RULE `(12 < n) ==> (0 <= i /\ i <= n-1 <=> i < n)`];
1106 REPEAT STRIP_TAC;
1107 MP_TAC (SPECL [`(h:num->real) i`;`(k:num->num) i`] BIEFJHU_explicit);
1108 ASM_SIMP_TAC [];
1109   SUBGOAL_THEN `#0.591 * &n - #0.0331 * (&6 * &n - &12) + #0.506 * &12 <= sum (0..(n-1)) (\i. (#0.591 - #0.0331 * (&(k i)) + #0.506 * lfun (h i)))` ASSUME_TAC;
1110 REWRITE_TAC[SUM_ADD_NUMSEG;SUM_SUB_NUMSEG;SUM_CONST_NUMSEG;SUM_LMUL];
1111 ASM_SIMP_TAC [ARITH_RULE `12 < n ==> (n-1 + 1 ) - 0= n `];
1112 ASM_REAL_ARITH_TAC;
1113 SUBGOAL_THEN `#0.591 * &n - #0.0331 * (&6 * &n - &12) + #0.506 * &12 <= &4 * pi` MP_TAC;
1114 ASM_REAL_ARITH_TAC;
1115 SUBGOAL_THEN `pi < #3.1416` MP_TAC;
1116 REWRITE_TAC [Flyspeck_constants.bounds];
1117 ONCE_REWRITE_TAC[GSYM REAL_OF_NUM_LT];
1118 REAL_ARITH_TAC
1119   ]);;
1120   (* }}} *)
1121
1122 let XULJEPR_sum = prove_by_refinement(
1123   `!h k n. ( pack_ineq_def_a /\
1124     (12 < n) /\ (h 0 = &1) /\
1125    (!i. i < n ==> 3 <= k i /\ &1 <= h i /\ h i <= h0) /\
1126 sum (0..n - 1) (\i. &(k i)) <= &6 * &n - &12 /\
1127 max (&0) (regular_spherical_polygon_area (cos #0.797) (&(k 0))) + sum (1..n - 1)
1128          (\i. max (&0)
1129               (regular_spherical_polygon_area
1130                (h i * sqrt3 / #4.0 + sqrt (&1 - (h i / &2) pow 2) / &2)
1131               (&(k i)))) <=
1132          &4 * pi /\
1133          &12 < sum (0..n - 1) (\i. lfun (h i)) ==> F
1134   )`,
1135   (* {{{ proof *)
1136   [
1137 REPEAT STRIP_TAC;
1138   SUBGOAL_THEN `&1 + sum (0..(n-1)) (\i. (#0.591 - #0.0331 * (&(k i)) + #0.506 * lfun (h i))) <= max (&0) (regular_spherical_polygon_area (cos #0.797) (&(k 0))) +      sum (1..n - 1)      (\i. max (&0)           (regular_spherical_polygon_area            (h i * sqrt3 / #4.0 + sqrt (&1 - (h i / &2) pow 2) / &2)           (&(k i))))` ASSUME_TAC;
1139 ASM_SIMP_TAC [ARITH_RULE `0 <= (n-1)/\ 0 + 1 = 1`;SUM_CLAUSES_LEFT;];
1140 REWRITE_TAC [REAL_ARITH `&1 + u + v = (u+ &1) + v`];
1141 MATCH_MP_TAC (REAL_ARITH `a <= b /\ c <= d ==> (a + c) <= (b + d)`);
1142 CONJ_TAC;
1143 MP_TAC (SPEC `(k:num->num) 0` UKBRPFE_explicit);
1144 ANTS_TAC;
1145 ASM_MESON_TAC[ARITH_RULE `12 < n ==> 0 < n`];
1146 REAL_ARITH_TAC;
1147 MATCH_MP_TAC SUM_LE_NUMSEG;
1148 ASM_SIMP_TAC [ARITH_RULE `(12 < n) ==> (1 <= i /\ i <= n-1 <=> 1 <=i /\ i < n)`];
1149 REPEAT STRIP_TAC;
1150 MP_TAC (SPECL [`(h:num->real) i`;`(k:num->num) i`] BIEFJHU_explicit);
1151 BY(ASM_SIMP_TAC []);
1152   SUBGOAL_THEN `&1 + #0.591 * &n - #0.0331 * (&6 * &n - &12) + #0.506 * &12 <= &1 + sum (0..(n-1)) (\i. (#0.591 - #0.0331 * (&(k i)) + #0.506 * lfun (h i)))` ASSUME_TAC;
1153 MATCH_MP_TAC (REAL_ARITH `a <= b ==> &1 + a <= &1 + b`);
1154 REWRITE_TAC[SUM_ADD_NUMSEG;SUM_SUB_NUMSEG;SUM_CONST_NUMSEG;SUM_LMUL];
1155 ASM_SIMP_TAC [ARITH_RULE `12 < n ==> (n-1 + 1 ) - 0= n `];
1156 BY(ASM_REAL_ARITH_TAC);
1157 SUBGOAL_THEN `&1 + #0.591 * &n - #0.0331 * (&6 * &n - &12) + #0.506 * &12 <= &4 * pi` MP_TAC;
1158 BY(ASM_REAL_ARITH_TAC);
1159 SUBGOAL_THEN `pi < #3.1416` MP_TAC;
1160 REWRITE_TAC [Flyspeck_constants.bounds];
1161 SUBGOAL_THEN `&13 <= &n` MP_TAC;
1162 UNDISCH_TAC `12 < n`;
1163 REWRITE_TAC[ REAL_OF_NUM_LE];
1164 ARITH_TAC;
1165 REAL_ARITH_TAC
1166   ]);;
1167   (* }}} *)
1168
1169 let REAL_CONVEX_ON_SECOND_SECANT = prove_by_refinement(
1170   `!f f'  f'' s.
1171   is_realinterval s /\
1172          ~(?a. s = {a}) /\
1173          (!x. x IN s ==> (f has_real_derivative f' x) (atreal x within s)) /\
1174          (!x. x IN s ==> (f' has_real_derivative f'' x) (atreal x within s)) /\
1175          (!x. x IN s ==> &0 <= f'' x)
1176     ==> (!x y. x IN s /\ y IN s ==> f y - f x <= f' y * (y - x))`,
1177   (* {{{ proof *)
1178   [
1179 REPEAT STRIP_TAC ;
1180 SUBGOAL_THEN `f real_convex_on s` ASSUME_TAC;
1181 ASM_MESON_TAC [REAL_CONVEX_ON_SECOND_DERIVATIVE];
1182 ASM_MESON_TAC [REAL_CONVEX_ON_SECANT_DERIVATIVE]
1183   ]);;
1184   (* }}} *)
1185
1186 let asn_sin_t' = Calc_derivative.differentiate
1187   `\x. x - asn(sin x * t)` `x:real` `real_interval [&0,  pi]`;;
1188
1189 let asn_sin_t'' = Calc_derivative.differentiate
1190   `\x. &1 - (cos x * t) * inv (sqrt (&1 - (sin x * t) pow 2))` `x:real` `real_interval [&0,  pi]`;;
1191
1192 let asn_sin_t''_alt = prove_by_refinement(
1193   `!x t alpha. abs(sin x * t) < &1 /\ cos alpha = sin x * t ==>
1194     derived_form T (\x. &1 - (cos x * t) * inv (sqrt (&1 - (sin x * t) pow 2))) (t * (&1 - t pow 2) * sin x * inv (abs(sin alpha) pow 3)) (x:real) (real_interval [&0, pi])` ,
1195   (* {{{ proof *)
1196   [
1197 REPEAT STRIP_TAC ;
1198 MP_TAC asn_sin_t'';
1199 REWRITE_TAC [Calc_derivative.derived_form];
1200 HASH_UNDISCH_TAC 8283 ;
1201 FIRST_X_ASSUM (fun t -> (SUBST1_TAC o GSYM) t THEN ASSUME_TAC (GSYM t));
1202 DISCH_TAC;
1203 SUBGOAL_THEN `~(sqrt (&1 - cos alpha pow 2) = &0) /\ &0 < &1 - cos alpha pow 2 /\  (--((cos x * t) *              (--(&2 * cos alpha pow 1 * cos x * t) *               inv (&2 * sqrt (&1 - cos alpha pow 2))) *              --inv (sqrt (&1 - cos alpha pow 2) pow 2) +              (--sin x * t) * inv (sqrt (&1 - cos alpha pow 2))) =   (t * (&1 - t pow 2) * sin x * inv (abs(sin alpha) pow 3)))` (fun t -> MP_TAC t THEN MESON_TAC[]);
1204 SUBGOAL_THEN `&0 < &1 - cos alpha  pow 2` ASSUME_TAC;
1205 REWRITE_TAC [REAL_ARITH `&0 < &1 - x pow 2 <=> x pow 2 < &1 pow 2`];
1206 ASM_REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS;REAL_ARITH `abs (&1) = &1`];
1207 ASM_REWRITE_TAC [];
1208 CONJ_TAC;
1209 ASM_SIMP_TAC [ (SQRT_EQ_0); REAL_ARITH `&0 < u ==> &0 <= u`];
1210 BY(ASM_REAL_ARITH_TAC);
1211 SUBGOAL_THEN `sqrt (&1 - cos alpha pow 2) = abs(sin alpha)` SUBST1_TAC;
1212 REWRITE_TAC[REWRITE_RULE [REAL_ARITH `(x + y = &1) <=> ( &1 - y = x)`] (SPEC`alpha:real` SIN_CIRCLE)];
1213 REWRITE_TAC [POW_2_SQRT_ABS];
1214 MATCH_MP_TAC (Calc_derivative.rational_identity `--((cos x * t) *    (--(&2 * cos alpha pow 1 * cos x * t) * inv (&2 * abs (sin alpha))) *    --inv (abs (sin alpha) pow 2) +    (--sin x * t) * inv (abs (sin alpha))) = t * (&1 - t pow 2) * sin x * inv (abs(sin alpha) pow 3)`);
1215 REWRITE_TAC [REAL_ARITH `~(&2= &0) /\ ~(&1 = &0)`;REAL_ABS_ZERO];
1216 CONJ_TAC;
1217 HASH_UNDISCH_TAC 754 ;
1218 REWRITE_TAC [REWRITE_RULE[REAL_ARITH `x + y = &1 <=> &1 - y = x`] (SPEC `alpha:real` SIN_CIRCLE)];
1219 REWRITE_TAC [Trigonometry2.NOT_ZERO_EQ_POW2_LT];
1220 MP_TAC (SPEC `x:real` SIN_CIRCLE);
1221 MP_TAC (SPEC `alpha:real` SIN_CIRCLE);
1222 HASH_UNDISCH_TAC 3350 ;
1223 SUBST1_TAC (SPEC `sin(alpha)` (GSYM REAL_POW2_ABS));
1224 TYPED_ABBREV_TAC `u = abs (sin alpha)`;
1225 CONV_TAC REAL_FIELD
1226   ]);;
1227   (* }}} *)
1228
1229 let real_interval_not_sing = prove_by_refinement(
1230   `!a b. (a < b) ==> ~(?c. real_interval [a,b] = {c})`,
1231   (* {{{ proof *)
1232   [
1233 REWRITE_TAC [real_interval];
1234 REPEAT STRIP_TAC ;
1235 HASH_UNDISCH_TAC 5180 ;
1236 REWRITE_TAC[FUN_EQ_THM;IN;IN_ELIM_THM;X_IN IN_SING];
1237 STRIP_TAC ;
1238 FIRST_X_ASSUM (fun t -> MP_TAC (SPEC `a:real` t) THEN MP_TAC (SPEC `b:real` t));
1239 ASM_REAL_ARITH_TAC
1240   ]);;
1241   (* }}} *)
1242
1243 let g_convex  = prove_by_refinement(
1244   `!t. (&0 < t /\ t < &1) ==> (? s f'  f''.
1245    s = real_interval [&0,  pi] /\
1246   is_realinterval s /\
1247          ~(?a. s = {a}) /\
1248          (!x. x IN s ==> ((\x. x - asn(sin x * t)) has_real_derivative f' x) (atreal x within s)) /\
1249          (!x. x IN s ==> (f' has_real_derivative f'' x) (atreal x within s)) /\
1250          (!x. x IN s ==> &0 <= f'' x))
1251   `,
1252   (* {{{ proof *)
1253   [
1254 REPEAT STRIP_TAC;
1255 EXISTS_TAC `real_interval [&0, pi]`;
1256 REWRITE_TAC [IS_REALINTERVAL_INTERVAL];
1257 EXISTS_TAC `(\x. &1 - (cos x * t) * inv (sqrt (&1 - (sin x * t) pow 2)))`;
1258 EXISTS_TAC `\x. (t * (&1 - t pow 2) * sin x * inv (abs(sin (acs (sin x * t))) pow 3))`;
1259 CONJ_TAC;
1260 MATCH_MP_TAC real_interval_not_sing;
1261 REWRITE_TAC [PI_POS];
1262 SUBGOAL_THEN `!x. abs(sin x * t) < &1` ASSUME_TAC;
1263 GEN_TAC;
1264 REWRITE_TAC [REAL_ABS_MUL];
1265 ASM_SIMP_TAC [REAL_ARITH `&0 < t ==> abs t = t`];
1266 MATCH_MP_TAC (REAL_ARITH `(t < &1) /\ (&0 <= t - u * t) ==> u * t < &1`);
1267 ASM_REWRITE_TAC [REAL_ARITH `t - u * t = t * (&1 - u)`;];
1268 MATCH_MP_TAC REAL_LE_MUL;
1269 MP_TAC (SPEC `x:real` SIN_BOUND);
1270 BY(ASM_REAL_ARITH_TAC);
1271 SUBGOAL_THEN `!x. cos (acs (sin x * t)) = sin x * t` ASSUME_TAC;
1272 GEN_TAC ;
1273 MATCH_MP_TAC COS_ACS;
1274 FIRST_X_ASSUM (MP_TAC o (SPEC `x:real`));
1275 BY(REAL_ARITH_TAC);
1276 CONJ_TAC;
1277 REPEAT STRIP_TAC ;
1278 MP_TAC asn_sin_t';
1279 ASM_REWRITE_TAC [Calc_derivative.derived_form];
1280 CONJ_TAC;
1281 REPEAT STRIP_TAC ;
1282 REPEAT (FIRST_X_ASSUM (ASSUME_TAC o (SPEC `x:real`)));
1283 MP_TAC (SPECL[`x:real`;`t:real`;`acs (sin x * t)`] asn_sin_t''_alt);
1284 ASM_REWRITE_TAC [Calc_derivative.derived_form];
1285 REPEAT STRIP_TAC ;
1286 BETA_TAC;
1287 REPEAT (MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC);
1288 ASM_REAL_ARITH_TAC ;
1289 REWRITE_TAC[REAL_ARITH `&1 - t pow 2 = (&1 - t) + t * (&1-t)`];
1290 MATCH_MP_TAC (REAL_ARITH `&0 < x /\ &0 < y ==> &0 <= x + y`);
1291 CONJ_TAC THEN (TRY (MATCH_MP_TAC REAL_LT_MUL)) THEN ASM_REAL_ARITH_TAC;
1292 HASH_UNDISCH_TAC 2464 ;
1293 REWRITE_TAC [IN;IN_ELIM_THM;real_interval;SIN_POS_PI_LE];
1294 REWRITE_TAC [REAL_LE_INV_EQ;];
1295 MATCH_MP_TAC REAL_POW_LE;
1296 REWRITE_TAC [REAL_ABS_POS]
1297   ]);;
1298   (* }}} *)
1299
1300 let GOTCJAH_convex_sum = prove_by_refinement(
1301   `!n t bet u. 0 < n /\ u <= &n * pi /\ &0 <= u /\
1302   &0 < t /\ t < &1 /\  sum (0..(n-1)) bet = u /\
1303   (!i. i < n ==> &0 <= bet i /\ bet i <= pi) ==>
1304   (u - &n * asn (sin (u/ &n) * t)) <= sum (0..(n-1)) (\i. bet i - asn (sin (bet i) * t))`,
1305   (* {{{ proof *)
1306   [
1307 REPEAT STRIP_TAC ;
1308 MP_TAC (SPEC `t:real` g_convex);
1309 ASM_REWRITE_TAC [];
1310 REPEAT STRIP_TAC ;
1311 MP_TAC (SPECL [`\x. x - asn(sin x * t)`;`f':real->real`;`f'':real->real`;`s:real->bool`] REAL_CONVEX_ON_SECOND_SECANT);
1312 ASM_REWRITE_TAC [real_interval;IN_ELIM_THM];
1313 REWRITE_TAC [REAL_ARITH `u - v <= c * (y - x) <=> u + c * (x- y) <= v`];
1314 DISCH_TAC ;
1315 TYPED_ABBREV_TAC `m = u / &n`;
1316 SUBGOAL_THEN `&0 <= m /\ m <= pi` ASSUME_TAC;
1317 EXPAND_TAC "m";
1318 HASH_UNDISCH_TAC 5908 ;
1319 HASH_UNDISCH_TAC 3476 ;
1320 REWRITE_TAC[GSYM REAL_OF_NUM_LT];
1321 HASH_UNDISCH_TAC 9033 ;
1322 SIMP_TAC [REAL_LE_DIV;REAL_ARITH `&0 < v ==> &0 <= v`];
1323 SIMP_TAC [REAL_LE_LDIV_EQ];
1324 REAL_ARITH_TAC ;
1325 SUBGOAL_THEN `sum (0..n-1) (\i. m - asn (sin m * t) + f' m * (bet i - m)) <= sum (0..n-1) (\i. bet i - asn (sin (bet i) * t))` ASSUME_TAC;
1326 MATCH_MP_TAC SUM_LE_NUMSEG;
1327 BETA_TAC;
1328 ASM_SIMP_TAC [ARITH_RULE `0 < n ==> (0 <= i /\ i <= n-1 <=> i < n)`];
1329 MATCH_MP_TAC REAL_LE_TRANS;
1330 EXISTS_TAC `sum (0..n - 1) (\i. m - asn (sin m * t) + f' m * (bet i - m))`;
1331 ASM_REWRITE_TAC [];
1332 ASM_REWRITE_TAC[SUM_ADD_NUMSEG;SUM_SUB_NUMSEG;SUM_CONST_NUMSEG;SUM_LMUL];
1333 ASM_SIMP_TAC [ARITH_RULE `0 < n ==> (n - 1 + 1) - 0 = n`];
1334 EXPAND_TAC "m";
1335 SUBGOAL_THEN `&n * u/ &n = u` (fun t -> SUBST1_TAC t THEN REAL_ARITH_TAC);
1336 HASH_UNDISCH_TAC 3476 ;
1337 REWRITE_TAC[GSYM REAL_OF_NUM_LT];
1338 CONV_TAC REAL_FIELD
1339   ]);;
1340   (* }}} *)
1341
1342 let dih_dot = prove_by_refinement(
1343   `!(u:real^3) v w. ~(u = vec 0) /\ ((w- u) dot v = &0) /\ ((w - u) dot u = &0) ==>
1344    dihV (vec 0) u v w = pi / &2`,
1345   (* {{{ proof *)
1346   [
1347 REPEAT STRIP_TAC ;
1348 MP_TAC (SPECL [`vec 0:real^3`;`u:real^3`;`v:real^3`;`w:real^3`]  Hvihvec.HVIHVEC);
1349 ASM_REWRITE_TAC [VECTOR_SUB_RZERO;LET_DEF;LET_END_DEF];
1350 DISCH_THEN SUBST1_TAC;
1351 REWRITE_TAC [GSYM ORTHOGONAL_VECTOR_ANGLE;orthogonal];
1352 SUBGOAL_THEN `(u:real^3) cross w = u cross (w - u)` SUBST1_TAC;
1353 REWRITE_TAC [CROSS_RADD;VECTOR_SUB;CROSS_RNEG;CROSS_REFL];
1354 REWRITE_TAC [GSYM VECTOR_SUB;VECTOR_SUB_RZERO];
1355 ONCE_REWRITE_TAC [DOT_SYM];
1356 ONCE_REWRITE_TAC [GSYM CROSS_TRIPLE];
1357 ONCE_REWRITE_TAC [CROSS_SKEW];
1358 REWRITE_TAC [CROSS_LAGRANGE;VECTOR_SUB;DOT_LADD;DOT_LNEG;DOT_LMUL];
1359 MATCH_MP_TAC (REAL_FIELD `a = &0 /\ b = &0 ==> -- ((c * a) + -- (d * b)) = &0`);
1360 ONCE_REWRITE_TAC [DOT_SYM];
1361 ASM_REWRITE_TAC [GSYM VECTOR_SUB]
1362   ]);;
1363   (* }}} *)
1364
1365 let abs_1_prod = prove_by_refinement(
1366   `!x y. abs x <= &1 /\ abs y <= &1 ==> abs (x * y) <= &1`,
1367   (* {{{ proof *)
1368   [
1369 REWRITE_TAC [REAL_ABS_MUL;REAL_ARITH `(x * y <= &1 <=> &0 <= &1 - x * y) /\ (&1 - x * y) = y * (&1-x) + x * (&1-y) + (&1 - x) * (&1-y)` ];
1370 REPEAT STRIP_TAC ;
1371 MATCH_MP_TAC (REAL_ARITH `&0 <= a /\ &0 <= b /\ &0 <= c ==> &0 <= a + b + c`);
1372 REPEAT ((TRY CONJ_TAC) THEN (TRY (MATCH_MP_TAC REAL_LE_MUL)) THEN (TRY ASM_REAL_ARITH_TAC))
1373   ]);;
1374   (* }}} *)
1375
1376 let sloc2_ortho = prove_by_refinement(
1377   `!(va:real^3) vb vc.  ~(coplanar {vec 0, va,vb,vc}) /\ (dihV (vec 0) vc va vb = pi / &2)
1378    ==>
1379     (let bet = dihV (vec 0) vb vc va in
1380      let alp = dihV (vec 0) va vb vc in
1381      let t = cos (arcV (vec 0) vb vc) in
1382        (cos alp = sin bet * t))`,
1383   (* {{{ proof *)
1384   [
1385 REPEAT STRIP_TAC ;
1386 MP_TAC (SPECL [`(vec 0):real^3`;`vc:real^3`;`vb:real^3`;`va:real^3`] (INST_TYPE [(`:3`,`:N`)] Trigonometry2.NLVWBBW));
1387 REPEAT    LET_TAC;
1388 SUBGOAL_THEN  `~collinear {((vec 0):real^3), va , vc } /\  ~collinear {vec 0, va, vb} /\  ~collinear {vec 0, vc, vb}` ASSUME_TAC;
1389 ASM_MESON_TAC [NOT_COPLANAR_NOT_COLLINEAR;SET_RULE `{vec 0, (va:real^3),vb,vc } = {vec 0 ,va,vc,vb} /\ {vec 0,va,vb,vc } =  {vec 0 ,va,vb,vc}  /\  {vec 0,va,vb,vc } =  {vec 0 ,vc,vb,va}`  ];
1390 ASM_REWRITE_TAC [];
1391 SUBGOAL_THEN `al = pi/ &2` SUBST1_TAC;
1392 ASM_MESON_TAC [DIHV_SYM];
1393 REWRITE_TAC [SIN_PI2;COS_PI2;REAL_ARITH `&1 * x = x /\ &0 * x = &0 /\ x + &0 = x`];
1394 SUBGOAL_THEN `ga = alp:real` SUBST1_TAC;
1395 ASM_MESON_TAC [DIHV_SYM];
1396   DISCH_THEN (SUBST1_TAC o GSYM);
1397 SUBGOAL_THEN `be = bet:real` SUBST1_TAC;
1398 ASM_MESON_TAC [DIHV_SYM];
1399 SUBGOAL_THEN `t = cos c` SUBST1_TAC;
1400 ASM_MESON_TAC [Trigonometry2.ARC_SYM];
1401 REAL_ARITH_TAC
1402   ]);;
1403   (* }}} *)
1404
1405 let vol_solid_triangle_ortho = prove_by_refinement(
1406   `!(u:real^3) v w. ~(coplanar {vec 0, u , v, w}) /\
1407   ((w- u) dot v = &0) /\ ((w - u) dot u = &0) ==>
1408     (let bet = dihV (vec 0) v u w in
1409     let t = cos (arcV (vec 0) v u) in
1410       (&3 * vol_solid_triangle (vec 0) u v w (&1) = bet - asn (sin bet * t)))
1411   `,
1412   (* {{{ proof *)
1413   [
1414 REPEAT STRIP_TAC ;
1415 REWRITE_TAC [vol_solid_triangle];
1416 REPEAT    LET_TAC;
1417 REWRITE_TAC [REAL_ARITH `&3 * x * &1 pow 3 / &3 = x`];
1418 SUBGOAL_THEN `a231 = bet:real` SUBST1_TAC;
1419 EXPAND_TAC "bet";
1420 EXPAND_TAC "a231";
1421 REWRITE_TAC [DIHV_SYM];
1422 SUBGOAL_THEN `abs(sin bet * t) <= &1` ASSUME_TAC;
1423 MATCH_MP_TAC abs_1_prod;
1424 EXPAND_TAC "t";
1425 REWRITE_TAC [COS_BOUND;SIN_BOUND];
1426 SUBGOAL_THEN `~((u:real^3) = vec 0)` ASSUME_TAC;
1427 STRIP_TAC ;
1428 HASH_UNDISCH_TAC 5227 ;
1429 ASM_REWRITE_TAC [INSERT_INSERT;COPLANAR_3];
1430 SUBGOAL_THEN `a123 = pi / &2` SUBST1_TAC;
1431 EXPAND_TAC "a123";
1432 MATCH_MP_TAC dih_dot;
1433 ASM_REWRITE_TAC [];
1434 SUBGOAL_THEN `asn (sin bet * t) = pi / &2 - acs( sin bet * t)` SUBST1_TAC;
1435 MATCH_MP_TAC ASN_ACS;
1436 ASM_REWRITE_TAC [REAL_ARITH `-- &1 <= x /\ x <= &1 <=> abs x <= &1`];
1437 SUBGOAL_THEN `a312 = acs (sin bet * t)` (fun t -> SUBST1_TAC t THEN REAL_ARITH_TAC);
1438 EXPAND_TAC "a312";
1439 MATCH_MP_TAC COS_INJ_PI;
1440 ASM_SIMP_TAC [COS_ACS;ACS_BOUNDS;DIHV_RANGE;REAL_ARITH `abs y <= &1 ==> -- &1 <= y /\ y <= &1`];
1441 EXPAND_TAC "a312";
1442 MP_TAC (SPECL [`u:real^3`;`v:real^3`;`w:real^3`] dih_dot);
1443 ASM_REWRITE_TAC [];
1444 DISCH_TAC ;
1445 MP_TAC (SPECL [`w:real^3`;`v:real^3`;`u:real^3`] sloc2_ortho);
1446 ANTS_TAC;
1447 ASM_MESON_TAC [SET_RULE `{vec 0, (w:real^3), v ,u} = {vec 0,u,v,w}`;DIHV_SYM];
1448 REPEAT  LET_TAC;
1449 ASM_REWRITE_TAC [];
1450 ASM_MESON_TAC [DIHV_SYM]
1451   ]);;
1452   (* }}} *)
1453
1454 let inj_int_ball = Pack1.inj_map3;;
1455
1456 let INJ_IMAGE = prove_by_refinement(
1457   `!a b. INJ (f:A->B) a b ==> IMAGE f a SUBSET b`,
1458   (* {{{ proof *)
1459   [
1460 REWRITE_TAC [INJ;IMAGE;SUBSET;IN_ELIM_THM;IN];
1461 MESON_TAC []
1462   ]);;
1463   (* }}} *)
1464
1465 let INJ_CARD = prove_by_refinement(
1466   `!a b f. FINITE b /\ INJ (f:A->B) a b ==> (FINITE a /\ CARD a <= CARD b)`,
1467   (* {{{ proof *)
1468   [
1469 REPEAT GEN_TAC;
1470 STRIP_TAC ;
1471 SUBGOAL_THEN `FINITE (a:A->bool)` ASSUME_TAC;
1472 MATCH_MP_TAC (INST_TYPE [(`:B`,`:B`)]Misc_defs_and_lemmas.FINITE_INJ);
1473 ASM_MESON_TAC [];
1474 ASM_REWRITE_TAC [];
1475 SUBGOAL_THEN `CARD (IMAGE (f:A->B) a) <= CARD (b:B->bool)` ASSUME_TAC;
1476 MATCH_MP_TAC CARD_SUBSET;
1477 ASM_SIMP_TAC [INJ_IMAGE];
1478 SUBGOAL_THEN `CARD a = CARD (IMAGE (f:A->B) a)` (fun t->SUBST1_TAC t THEN ASM_REWRITE_TAC[]);
1479 MATCH_MP_TAC Misc_defs_and_lemmas.BIJ_CARD;
1480 EXISTS_TAC `f:A->B`;
1481 ASM_REWRITE_TAC [BIJ;Misc_defs_and_lemmas.IMAGE_SURJ];
1482 HASH_UNDISCH_TAC 4678 ;
1483 REWRITE_TAC [INJ;IMAGE];
1484 SET_TAC[]
1485   ]);;
1486   (* }}} *)
1487
1488 let card_packing_ball = prove_by_refinement(
1489   `!r. (&0 <= r) ==> ?n. !(S:real^3->bool).
1490    packing S /\ S SUBSET (ball ((vec 0),r)) ==> (FINITE S /\ (CARD S) <= n)`,
1491   (* {{{ proof *)
1492   [
1493 REPEAT STRIP_TAC ;
1494 TYPED_ABBREV_TAC `r_int_ball = (sqrt (&8 * r pow 2 + &6))`;
1495 TYPED_ABBREV_TAC `b = &4 / &3 * pi * (r_int_ball + sqrt (&3)) pow 3`;
1496 MP_TAC (SPEC `b:real` REAL_ARCH_SIMPLE);
1497 STRIP_TAC;
1498 EXISTS_TAC `n:num`;
1499 GEN_TAC ;
1500 STRIP_TAC ;
1501 MATCH_MP_TAC (MESON[REAL_LE_TRANS;REAL_OF_NUM_LE] `a /\ (&c <= b) /\ (b <= &n) ==> a /\ (c <= n)`);
1502 ASM_REWRITE_TAC[];
1503 MP_TAC (SPECL [`(vec 0):real^3`;`r:real`;`S:real^3->bool`] inj_int_ball);
1504 ASM_REWRITE_TAC [];
1505 SUBGOAL_THEN `S INTER ball (vec 0,r) = (S:real^3->bool)` SUBST1_TAC;
1506 HASH_UNDISCH_TAC 3742 ;
1507 BY(SET_TAC[]);
1508 MP_TAC (SPECL [`(vec 0):real^3`;`r_int_ball:real`] Vol1.WQZISRI);
1509 ANTS_TAC;
1510 EXPAND_TAC "r_int_ball";
1511 MATCH_MP_TAC SQRT_POS_LE;
1512 MATCH_MP_TAC (REAL_ARITH `&0 <= a ==> &0 <= &8 * a + &6`);
1513 REWRITE_TAC [REAL_LE_POW_2];
1514 REPEAT DISCH_TAC;
1515 SUBGOAL_THEN `FINITE (S:real^3->bool) /\ CARD S <= CARD (int_ball (vec 0) r_int_ball)` ASSUME_TAC;
1516 MATCH_MP_TAC INJ_CARD;
1517 EXISTS_TAC `map3 (vec 0)`;
1518 ASM_REWRITE_TAC [];
1519 ASM_REWRITE_TAC [];
1520 ASM_MESON_TAC [REAL_LE_TRANS;REAL_OF_NUM_LE]
1521   ]);;
1522   (* }}} *)
1523
1524 let card_packing_annulus = prove_by_refinement(
1525   `?n. !(S:real^3->bool).
1526    packing S /\ S SUBSET ball_annulus ==> (FINITE S /\ (CARD S) <= n)`,
1527   (* {{{ proof *)
1528   [
1529 SUBGOAL_THEN `ball_annulus SUBSET ball((vec 0),(&2 * h0 + &1))` ASSUME_TAC;
1530 REWRITE_TAC [Pack_defs.ball_annulus;cball;ball;SUBSET;DIFF;IN_ELIM_THM];
1531 REAL_ARITH_TAC ;
1532 MP_TAC (SPEC `&2 * h0 + &1` card_packing_ball);
1533 ANTS_TAC;
1534 REWRITE_TAC [Sphere.h0];
1535 REAL_ARITH_TAC ;
1536 REPEAT STRIP_TAC ;
1537 EXISTS_TAC `n:num`;
1538 GEN_TAC ;
1539 STRIP_TAC ;
1540 FIRST_X_ASSUM (MATCH_MP_TAC);
1541 ASM_MESON_TAC [SUBSET_TRANS]
1542   ]);;
1543   (* }}} *)
1544
1545 (* Almost identical to
1546 Packing3.REAL_FINITE_MAX_EXISTS
1547 *)
1548
1549 let FINITE_MAX_EXISTS = prove_by_refinement(
1550   `!(s:num->bool). ~(s = {}) /\ FINITE s ==>
1551     (?a. (s a) /\ (!b. s b ==> (b <= a)))`,
1552   (* {{{ proof *)
1553   [
1554   REPEAT STRIP_TAC;
1555   MP_TAC (SPEC `(<):num->num->bool` (INST_TYPE [(`:num`,`:A`)]TOPOLOGICAL_SORT));
1556   ANTS_TAC;
1557     BY(ARITH_TAC);
1558   REWRITE_TAC [HAS_SIZE];
1559   DISCH_THEN (MP_TAC o (SPECL [`CARD (s:num->bool)`;`(s:num->bool)`]));
1560   ASM_REWRITE_TAC [];
1561   REPEAT STRIP_TAC;
1562   EXISTS_TAC `(f:num->num) (CARD (s:num->bool))`;
1563   HASH_UNDISCH_TAC 3729;
1564   TYPED_ABBREV_TAC `c = CARD (s:num->bool)`;
1565   DISCH_THEN SUBST1_TAC;
1566   REWRITE_TAC [IMAGE;IN_ELIM_THM];
1567   CONJ_TAC;
1568     EXISTS_TAC `c:num`;
1569     REWRITE_TAC [IN_NUMSEG];
1570     BY(ASM_MESON_TAC [ARITH_RULE `~(c = 0) ==> (1 <= c) /\ (c <= c)`;CARD_EQ_0]);
1571   REPEAT STRIP_TAC;
1572   HASH_RULE_TAC 6034 (REWRITE_RULE[ARITH_RULE `~((a:num) < b) <=> (b <= a)`]);
1573   ASM_REWRITE_TAC [];
1574   ASM_CASES_TAC `(x = c:num)`;
1575     ASM_REWRITE_TAC [];
1576     BY(ARITH_TAC);
1577   DISCH_THEN MATCH_MP_TAC;
1578   HASH_UNDISCH_TAC 3080;
1579   HASH_UNDISCH_TAC 2978;
1580   HASH_UNDISCH_TAC 8866;
1581   REWRITE_TAC [IN_NUMSEG];
1582   ASM_MESON_TAC [ARITH_RULE `~(c = 0) ==> (1 <= c) /\ (c <= c) /\ (~(x=c) /\ (x <= c) ==> x < c)`;CARD_EQ_0]
1583   ]);;
1584   (* }}} *)
1585
1586 let NOT_EMPTY_IMAGE = prove
1587 ( ` !(S:A -> bool) (f:A->B). ~( S = {}) ==> ~( IMAGE f S = {})`, SET_TAC[]);;
1588
1589 let PACKING_INSERT = prove_by_refinement(
1590   `!v S. packing S /\ ~(S v) /\ (!w. S w ==> (&2 <= dist(v,w))) ==> (packing (v INSERT S))`,
1591   (* {{{ proof *)
1592   [
1593 REWRITE_TAC [Sphere.packing;INSERT;IN;IN_ELIM_THM];
1594 MESON_TAC [DIST_SYM]
1595   ]);;
1596   (* }}} *)
1597
1598 let weak_saturation = prove_by_refinement(
1599   `!W S r. &2 <= r /\ r <= &2 * h0 /\ S SUBSET W /\ packing W /\ W SUBSET ball_annulus
1600     /\ (!v w. S v /\ W w /\ dist(v,w) < r ==> (v = w)  ) ==>
1601     (?V. V SUBSET ball_annulus /\ packing V /\
1602       weakly_saturated V r (&2 * h0) /\ FINITE V /\ (W SUBSET V) /\
1603        (!v w. S v /\ V w /\ dist(v,w)< r ==> (v = w)))
1604        `,
1605   (* {{{ proof *)
1606   [
1607 REPEAT STRIP_TAC ;
1608 TYPED_ABBREV_TAC `WW = { V | W SUBSET V /\ packing V /\ V SUBSET ball_annulus /\ (!v w. S v /\ V w /\ dist(v,w) < r ==> (v = w) ) }`;
1609 SUBGOAL_THEN `(WW (W:real^3->bool)):bool` ASSUME_TAC;
1610 EXPAND_TAC "WW";
1611 REWRITE_TAC [IN_ELIM_THM];
1612 ASM_REWRITE_TAC [SUBSET_REFL];
1613 SUBGOAL_THEN `?n. !V. ((WW (V:real^3->bool)):bool) ==> FINITE V /\  CARD V <= n` (fun t -> MP_TAC t THEN STRIP_TAC);
1614 EXPAND_TAC "WW";
1615 REWRITE_TAC [IN_ELIM_THM];
1616 MP_TAC card_packing_annulus;
1617 STRIP_TAC ;
1618 EXISTS_TAC `n:num`;
1619 GEN_TAC ;
1620 ASM_MESON_TAC [];
1621 SUBGOAL_THEN `FINITE (IMAGE CARD (WW:(real^3->bool)->bool))` (MP_TAC);
1622 MATCH_MP_TAC FINITE_SUBSET;
1623 EXISTS_TAC `{ k | k <= (n:num)}`;
1624 REWRITE_TAC [FINITE_NUMSEG_LE];
1625 REWRITE_TAC [IMAGE;SUBSET;IN_ELIM_THM;IN];
1626 ASM_MESON_TAC [];
1627 DISCH_TAC ;
1628 SUBGOAL_THEN `~(IMAGE CARD (WW:(real^3->bool)->bool) = {})` ASSUME_TAC;
1629 MATCH_MP_TAC NOT_EMPTY_IMAGE;
1630 REWRITE_TAC [GSYM MEMBER_NOT_EMPTY;IN];
1631 ASM_MESON_TAC [];
1632 SUBGOAL_THEN `(?a. ((IMAGE CARD (WW:(real^3->bool)->bool)) a) /\ (!b. (IMAGE CARD WW) b ==> (b <= a)))` MP_TAC;
1633 MATCH_MP_TAC FINITE_MAX_EXISTS;
1634 ASM_REWRITE_TAC [ETA_AX];
1635 REWRITE_TAC [IMAGE;IN_ELIM_THM;IN];
1636 REPEAT STRIP_TAC ;
1637 EXISTS_TAC `x:real^3->bool`;
1638 SUBGOAL_THEN `W SUBSET x /\ x SUBSET ball_annulus /\ packing x /\ FINITE x /\ (!(v:real^3) w. S v /\ x w /\ dist (v,w) < r ==> v = w)` (fun t -> MP_TAC t THEN STRIP_TAC);
1639 ASM_SIMP_TAC [];
1640 HASH_UNDISCH_TAC 2672 ;
1641 EXPAND_TAC "WW";
1642 REWRITE_TAC [IN_ELIM_THM;IN];
1643 MESON_TAC [];
1644 ASM_REWRITE_TAC [Tarjjuw.weakly_saturated];
1645 REPEAT STRIP_TAC ;
1646 REWRITE_TAC [IN];
1647 ASM_CASES_TAC `(x (v:real^3)):bool`;
1648 EXISTS_TAC `v:real^3`;
1649 ASM_REWRITE_TAC [];
1650 CONJ_TAC ;
1651 DISCH_TAC ;
1652 HASH_UNDISCH_TAC 7486 ;
1653 ASM_REWRITE_TAC [DIST_REFL];
1654 REAL_ARITH_TAC ;
1655 ASM_REWRITE_TAC [DIST_REFL];
1656 ASM_REAL_ARITH_TAC;
1657 MATCH_MP_TAC (MESON[] `( (!u. x u ==> ~(b u)) ==> F) ==> (?u. x u /\ b u)`);
1658 DISCH_TAC ;
1659 TYPED_ABBREV_TAC `y = (v:real^3) INSERT x`;
1660 SUBGOAL_THEN `!u. x (u:real^3) ==> r <= dist (u,v)` ASSUME_TAC;
1661 REPEAT STRIP_TAC ;
1662 HASH_RULE_TAC 3271 (SPEC `u:real^3`);
1663 ASM_REWRITE_TAC [DE_MORGAN_THM];
1664 DISCH_THEN DISJ_CASES_TAC;
1665 HASH_UNDISCH_TAC 1666 ;
1666 HASH_UNDISCH_TAC 7625 ;
1667 EXPAND_TAC "u";
1668 REWRITE_TAC [SUBSET;Pack_defs.ball_annulus;DIFF;IN;ball;IN_ELIM_THM];
1669 MESON_TAC [DIST_REFL;REAL_ARITH `(&0 < &2)`];
1670 ASM_REAL_ARITH_TAC ;
1671 ASM_CASES_TAC `CARD (y:(real^3->bool)) <= CARD (x:(real^3->bool))`;
1672 HASH_UNDISCH_TAC 3148 ;
1673 HASH_UNDISCH_TAC 7827 ;
1674 EXPAND_TAC "y";
1675 HASH_UNDISCH_TAC 4093 ;
1676 SIMP_TAC [CARD_CLAUSES;IN];
1677 STRIP_TAC ;
1678 STRIP_TAC ;
1679 MESON_TAC [Hypermap.LT_PLUS;ARITH_RULE `~(x <= y) <=> y < (x:num)`];
1680 HASH_UNDISCH_TAC 9017 ;
1681 HASH_UNDISCH_TAC 5378 ;
1682 ASM_REWRITE_TAC [];
1683 DISCH_THEN (MATCH_MP_TAC);
1684 EXISTS_TAC `y:real^3->bool`;
1685 REWRITE_TAC [];
1686 EXPAND_TAC "WW";
1687 REWRITE_TAC [IN_ELIM_THM];
1688 SUBGOAL_THEN `!w. (y w <=> (x w \/ (w = (v:real^3))))` ASSUME_TAC;
1689 GEN_TAC ;
1690 HASH_UNDISCH_TAC 3490 ;
1691 ONCE_REWRITE_TAC [FUN_EQ_THM];
1692 REWRITE_TAC [INSERT;IN_ELIM_THM;IN];
1693 MESON_TAC [];
1694 SUBGOAL_THEN `W SUBSET (y:real^3->bool)` ASSUME_TAC;
1695 HASH_UNDISCH_TAC 7323 ;
1696 HASH_UNDISCH_TAC 646 ;
1697 REWRITE_TAC [SUBSET;IN];
1698 MESON_TAC [];
1699 ASM_REWRITE_TAC [];
1700 SUBGOAL_THEN `packing (y:real^3->bool)` ASSUME_TAC;
1701 EXPAND_TAC "y";
1702 MATCH_MP_TAC PACKING_INSERT;
1703 ASM_REWRITE_TAC [];
1704 REPEAT STRIP_TAC ;
1705 MATCH_MP_TAC REAL_LE_TRANS;
1706 EXISTS_TAC `r:real`;
1707 ASM_SIMP_TAC [];
1708 ONCE_REWRITE_TAC [DIST_SYM];
1709 ASM_SIMP_TAC [];
1710 ASM_REWRITE_TAC [];
1711 CONJ_TAC ;
1712 EXPAND_TAC "y";
1713 ASM_REWRITE_TAC [INSERT_SUBSET];
1714 ASM_REWRITE_TAC [Pack_defs.ball_annulus;IN;DIFF;cball;ball;IN_ELIM_THM];
1715 ASM_REAL_ARITH_TAC ;
1716 REPEAT STRIP_TAC ;
1717 FIRST_X_ASSUM MATCH_MP_TAC;
1718 ASM_REWRITE_TAC [];
1719 HASH_UNDISCH_TAC 8971 ;
1720 ASM_REWRITE_TAC [];
1721 HASH_RULE_TAC 7974 (SPEC `v':real^3`);
1722 REWRITE_TAC [REAL_ARITH `x <= y <=> ~(y < x)`];
1723 HASH_UNDISCH_TAC 7323 ;
1724 HASH_UNDISCH_TAC 5872 ;
1725 HASH_UNDISCH_TAC 5644 ;
1726 REWRITE_TAC [SUBSET;IN;IN_ELIM_THM];
1727 MESON_TAC []
1728   ]);;
1729   (* }}} *)
1730
1731 let RADIAL_NORM_LINEAR_INVARIANT = prove_by_refinement(
1732    `!(f:real^M->real^N) s r. linear f /\ (!x. norm (f x) = norm x ) /\ (!y. ?x. f x = y)
1733      ==> radial r (vec 0) (IMAGE f s) = radial r (vec 0) s`,
1734    (* {{{ proof *)
1735   [
1736   REWRITE_TAC [Sphere.radial; VECTOR_ADD_LID ];
1737   REPEAT WEAK_STRIP_TAC;
1738   MATCH_MP_TAC (TAUT `(a <=> b) /\( (a <=> b) ==> (c <=>d)) ==> (a /\ c <=> b /\ d)`);
1739   STRIP_TAC;
1740     REWRITE_TAC [Trigonometry1.DIST_L_ZERO;ball;SUBSET;IMAGE;IN_ELIM_THM];
1741     BY(ASM_MESON_TAC[]);
1742   REPEAT WEAK_STRIP_TAC;
1743   REWRITE_TAC[Geomdetail.EQ_EXPAND];
1744   CONJ_TAC;
1745     REPEAT WEAK_STRIP_TAC;
1746     HASH_RULE_TAC 7266 (SPEC `(f:real^M->real^N) u`);
1747     REWRITE_TAC[IN;IMAGE;IN_ELIM_THM];
1748     ANTS_TAC;
1749       BY(ASM_MESON_TAC[IN]);
1750     STRIP_TAC;
1751     HASH_RULE_TAC 503 (SPEC `(t:real)`);
1752     ASM_REWRITE_TAC[];
1753     REPEAT WEAK_STRIP_TAC;
1754     SUBGOAL_THEN `x = t % (u:real^M)` MP_TAC;
1755       BY(ASM_MESON_TAC[linear;PRESERVES_NORM_INJECTIVE;IN]);
1756     BY(ASM_MESON_TAC[IN]);
1757   REPEAT WEAK_STRIP_TAC;
1758   HASH_UNDISCH_TAC 662;
1759   REWRITE_TAC[IN;IMAGE;IN_ELIM_THM];
1760   WEAK_STRIP_TAC;
1761   BY(ASM_MESON_TAC[IN;linear])
1762   ] );;
1763   (* }}} *)
1764
1765 let linear_inter_normball = prove_by_refinement(
1766   `!(f:real^M->real^N) s r. linear f /\ (!x. norm (f x) = norm x ) ==>
1767    ( IMAGE f s INTER normball (vec 0) r = IMAGE f (s INTER normball (vec 0) r))`,
1768   (* {{{ proof *)
1769   [
1770   REPEAT WEAK_STRIP_TAC;
1771   ONCE_REWRITE_TAC[FUN_EQ_THM];
1772   GEN_TAC;
1773   REWRITE_TAC[IMAGE;INTER;normball;DIST_0;IN;IN_ELIM_THM];
1774   Tactics_jordan.NAME_CONFLICT_TAC;
1775   BY(ASM_MESON_TAC[])
1776   ]);;
1777   (* }}} *)
1778
1779 let sol0_linear = prove_by_refinement(
1780   `!(f:real^3->real^3) s.  linear f /\ (!x. norm (f x) = norm x) /\  (!y. ?x. f x = y)==>
1781     ( (?r. r > &0 /\
1782          measurable (IMAGE f s INTER normball (vec 0) r) /\
1783          radial r (vec 0) (IMAGE f s INTER normball (vec 0) r)) <=>
1784    (?r. r > &0 /\
1785          measurable (s INTER normball (vec 0) r) /\
1786          radial r (vec 0) (s INTER normball (vec 0) r)))`,
1787   (* {{{ proof *)
1788   [
1789   BY(ASM_MESON_TAC[linear_inter_normball;RADIAL_NORM_LINEAR_INVARIANT;PRESERVES_NORM_INJECTIVE;MEASURABLE_LINEAR_IMAGE_EQ])
1790   ]);;
1791   (* }}} *)
1792
1793 let sol0_linear_r = prove_by_refinement(
1794   `!(f:real^3->real^3) s r.  linear f /\ (!x. norm (f x) = norm x) /\  (!y. ?x. f x = y) /\ (r > &0) ==>
1795     ((
1796          measurable (IMAGE f s INTER normball (vec 0) r) /\
1797          radial r (vec 0) (IMAGE f s INTER normball (vec 0) r)) <=>
1798    (
1799          measurable (s INTER normball (vec 0) r) /\
1800          radial r (vec 0) (s INTER normball (vec 0) r)))`,
1801   (* {{{ proof *)
1802   [
1803   BY(ASM_MESON_TAC[linear_inter_normball;RADIAL_NORM_LINEAR_INVARIANT;PRESERVES_NORM_INJECTIVE;MEASURABLE_LINEAR_IMAGE_EQ])
1804   ]);;
1805   (* }}} *)
1806
1807 let dropout_pad2d3d = prove_by_refinement(
1808   `!x. dropout 3 (pad2d3d x) = x`,
1809   (* {{{ proof *)
1810   [
1811   ONCE_REWRITE_TAC[CART_EQ];
1812   REWRITE_TAC[dropout;pad2d3d];
1813   REPEAT WEAK_STRIP_TAC;
1814   ASM_SIMP_TAC[LAMBDA_BETA;DIMINDEX_2;DIMINDEX_3];
1815   ASSUME_TAC (ARITH_RULE `i <= 2==> i<3` );
1816   SUBGOAL_THEN `i + 1 <= dimindex(:3) /\ i <= dimindex(:3)` ASSUME_TAC;
1817     BY(ASM_MESON_TAC[DIMINDEX_3;DIMINDEX_2;ARITH_RULE `i<=2 ==> i+1 <= 3 /\ i <= 3`]);
1818   COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA;DIMINDEX_2;DIMINDEX_3];
1819   BY(ASM_MESON_TAC[DIMINDEX_3;DIMINDEX_2])
1820   ]);;
1821   (* }}} *)
1822
1823 let pad2d3d_dropout = prove_by_refinement(
1824   `!x . (x$3= &0) ==> (pad2d3d (dropout 3 x) = x)`,
1825   (* {{{ proof *)
1826   [
1827   ONCE_REWRITE_TAC[CART_EQ];
1828   REWRITE_TAC[dropout;pad2d3d];
1829   REPEAT WEAK_STRIP_TAC;
1830   ASM_SIMP_TAC[LAMBDA_BETA;DIMINDEX_2;DIMINDEX_3];
1831   COND_CASES_TAC;
1832     BY(ASM_SIMP_TAC[LAMBDA_BETA;DIMINDEX_2;DIMINDEX_3;ARITH_RULE `i < 3 ==> i<= 2`]);
1833   BY(ASM_MESON_TAC[DIMINDEX_3;ARITH_RULE `~(i<3) /\ (i <= 3) ==> (i=3)`])
1834   ]);;
1835   (* }}} *)
1836
1837 let pad2d3d_dropout_lemma = prove_by_refinement(
1838   `!(A:A->bool) P h . (!x.  x IN A ==> P x) /\ (!x. P x ==> h x = x) ==>
1839     (IMAGE h A = A)`,
1840   (* {{{ proof *)
1841   [
1842     SET_TAC[]
1843   ]);;
1844   (* }}} *)
1845
1846 let pad2d3d_dot_v = prove_by_refinement(
1847   `!x y.  (pad2d3d x dot pad2d3d y = x dot y)`,
1848   (* {{{ proof *)
1849   [
1850   BY(ASM_SIMP_TAC[GSYM LINEAR_SUB;LINEAR_PAD2D3D;DOT_NORM_NEG;NORM_PAD2D3D])
1851   ]);;
1852   (* }}} *)
1853
1854 let pad_in = prove_by_refinement(
1855   `!x A. (!u. u IN A ==> u$3 = &0) ==> ((pad2d3d x IN A) <=> (x IN (IMAGE (dropout 3) A)))`,
1856   (* {{{ proof *)
1857   [
1858   REPEAT WEAK_STRIP_TAC;
1859   REWRITE_TAC[IN;IN_ELIM_THM;IMAGE];
1860   BY(ASM_MESON_TAC[dropout_pad2d3d;pad2d3d_dropout;IN])
1861   ]);;
1862   (* }}} *)
1863
1864 let pad2d3d_facet = prove_by_refinement(
1865   `!P n. polyhedron (P:real^3->bool) /\
1866     (!u. u IN P ==> u$3 = &0) /\ { c | c facet_of P } HAS_SIZE n ==>
1867     {d | (d:real^2->bool) facet_of (IMAGE (dropout 3) P) } HAS_SIZE n`,
1868   (* {{{ proof *)
1869   [
1870   REPEAT WEAK_STRIP_TAC;
1871   MATCH_MP_TAC (ISPEC `{c | c facet_of (P:real^3->bool)}` BIJECTIONS_HAS_SIZE);
1872   ASM_REWRITE_TAC[IN_ELIM_THM];
1873   EXISTS_TAC `(IMAGE (dropout 3)): (real^3->bool)->real^2->bool`;
1874   EXISTS_TAC `(IMAGE (pad2d3d)): (real^2->bool)->real^3->bool`;
1875   REWRITE_TAC[GSYM IMAGE_o];
1876   SUBGOAL_THEN `!(A:real^3->bool). (A SUBSET P) ==> IMAGE(pad2d3d o dropout 3) A = A` ASSUME_TAC;
1877     HASH_UNDISCH_TAC 5723;
1878     REWRITE_TAC[IMAGE;IMAGE_o;SUBSET;IN_ELIM_THM];
1879     BY(SET_TAC[pad2d3d_dropout]);
1880   SUBGOAL_THEN `!(B:real^2->bool). IMAGE (dropout 3 o pad2d3d) B = B` ASSUME_TAC;
1881     REWRITE_TAC[IMAGE;IMAGE_o;SUBSET;IN_ELIM_THM];
1882     BY(SET_TAC[dropout_pad2d3d]);
1883   REPEAT STRIP_TAC;
1884         SUBGOAL_THEN `IMAGE pad2d3d (IMAGE (dropout 3) (x:real^3->bool)) facet_of (IMAGE pad2d3d (IMAGE (dropout 3) (P:real^3->bool)))` MP_TAC;
1885           REWRITE_TAC[GSYM IMAGE_o];
1886           BY(ASM_MESON_TAC[FACET_OF_IMP_SUBSET;SUBSET_REFL]);
1887         BY(ASM_MESON_TAC[FACET_OF_LINEAR_IMAGE;PRESERVES_NORM_INJECTIVE;LINEAR_PAD2D3D;NORM_PAD2D3D]);
1888       BY(ASM_MESON_TAC[FACET_OF_IMP_SUBSET]);
1889     BY(ASM_MESON_TAC[SUBSET_REFL;IMAGE_o;FACET_OF_LINEAR_IMAGE;PRESERVES_NORM_INJECTIVE;LINEAR_PAD2D3D;NORM_PAD2D3D]);
1890   BY(ASM_MESON_TAC[])
1891    ]);;
1892   (* }}} *)
1893
1894 let ARG_SCALE = prove_by_refinement(
1895   `!u w r. (&0 < r) ==> (Arg ((Cx r * u)/w) = Arg (u/w)) /\ (Arg (u/ (Cx r * w)) = Arg (u/w)) `,
1896   (* {{{ proof *)
1897   [
1898   REPEAT WEAK_STRIP_TAC;
1899   ASM_CASES_TAC `w = Cx (&0)`;
1900     BY(ASM_REWRITE_TAC[complex_div;COMPLEX_MUL_RZERO;COMPLEX_MUL_LZERO;COMPLEX_INV_0]);
1901   SUBGOAL_THEN `~(Cx r * w = Cx(&0))` ASSUME_TAC;
1902     BY(ASM_SIMP_TAC[COMPLEX_ENTIRE;CX_INJ;REAL_ARITH `&0 < r ==> ~(r = &0)`]);
1903   ASM_SIMP_TAC [Ysskqoy.ARG_CNJ;CNJ_CX;CNJ_MUL];
1904   BY(ASM_MESON_TAC[ARG_MUL_CX;COMPLEX_MUL_AC])
1905   ]);;
1906   (* }}} *)
1907
1908 let complex_frac_cancel = prove_by_refinement(
1909   `!a b (c:complex).  ~(b = Cx (&0)) ==> (a/b)/(c/b) = a / c`,
1910   (* {{{ proof *)
1911   [
1912   REPEAT WEAK_STRIP_TAC;
1913   ONCE_REWRITE_TAC[ complex_div];
1914   REWRITE_TAC[COMPLEX_INV_DIV];
1915   REWRITE_TAC[complex_div];
1916   MATCH_MP_TAC (prove(`(b' * b) *(a * (c:complex)) = d ==> (a * b' ) * (b * c) = d`,SIMPLE_COMPLEX_ARITH_TAC));
1917   BY(ASM_SIMP_TAC[COMPLEX_MUL_LINV;COMPLEX_MUL_LID])
1918   ]);;
1919   (* }}} *)
1920
1921
1922 let REAL_CX0 = prove_by_refinement(
1923   `!z. real z /\ Re z = &0 ==> (z = Cx (&0))`,
1924   (* {{{ proof *)
1925   [
1926   REPEAT WEAK_STRIP_TAC;
1927   BY(ASM_MESON_TAC[COMPLEX_NORM_ZERO;REAL_NORM;REAL_ARITH `abs (&0) = &0`])
1928   ]);;
1929   (* }}} *)
1930
1931
1932 let ARG_INV_ALT = prove_by_refinement(
1933   `!u x y. ~(u = Cx (&0)) /\ ~(x = Cx(&0)) /\ ~(y = Cx(&0)) /\ ~(Arg (x/u) = Arg(y/u))
1934   ==> (Arg(x/y) = &2*pi - Arg(y/x))`,
1935   (* {{{ proof *)
1936   [
1937   REPEAT STRIP_TAC;
1938   MP_TAC (SPEC `(y/(x:complex))` ARG_INV);
1939   REWRITE_TAC[COMPLEX_INV_DIV];
1940   DISCH_THEN MATCH_MP_TAC;
1941   REPEAT WEAK_STRIP_TAC;
1942   HASH_UNDISCH_TAC 5488;
1943   REWRITE_TAC[];
1944   ONCE_REWRITE_TAC[EQ_SYM_EQ];
1945   ASM_SIMP_TAC[ARG_EQ;Ysskqoy.ARG_0_DIV];
1946   EXISTS_TAC `Re (y/x)`;
1947   SUBCONJ_TAC;
1948     MATCH_MP_TAC (REAL_ARITH `&0 <= x /\ ~(x = &0) ==> &0 < x`);
1949     REPEAT STRIP_TAC;
1950       BY(ASM_REWRITE_TAC[]);
1951     MP_TAC (SPEC `(y:complex/x)` REAL_CX0);
1952     BY(ASM_SIMP_TAC[Ysskqoy.ARG_0_DIV]);
1953   HASH_RULE_TAC 3423 (REWRITE_RULE[REAL]);
1954   DISCH_THEN SUBST1_TAC;
1955   DISCH_TAC;
1956   REWRITE_TAC[ complex_div];
1957   MATCH_MP_TAC (prove(`d=(b' *b)*(a*c) ==> d = (a *b')*b * (c:complex)`,SIMPLE_COMPLEX_ARITH_TAC));
1958   BY(ASM_SIMP_TAC[COMPLEX_MUL_LINV;COMPLEX_MUL_LID])
1959   ]);;
1960   (* }}} *)
1961
1962 let ARG_ORDER = prove_by_refinement(
1963   `!u h n.
1964     ~(u = Cx (&0)) /\
1965     (!i. (i IN 1..n) ==> ~(h i = Cx (&0))) /\
1966      (!i j. (i IN 1..n) /\ (j IN 1..n) /\ (i < j) ==> Arg (h i/ u) < Arg (h j/ u)) /\ (h (n+1) = h 1) ==>
1967     (!i j. (i IN 1..n) /\ (j IN 1..n) /\ ~(i=j) ==> Arg (h (i+1) / h i) <= Arg (h j/ h i))
1968      `,
1969   (* {{{ proof *)
1970   [
1971   REWRITE_TAC[ARITH_RULE `~(i = j) <=> (i < j) \/ (j < (i:num))`];
1972   REPEAT GEN_TAC;
1973   REPEAT DISCH_TAC;
1974   SUBGOAL_THEN `!i. i IN 1..n ==> ~(h (i+1) = Cx (&0))` ASSUME_TAC;
1975     REPEAT WEAK_STRIP_TAC;
1976     ASM_CASES_TAC `i=(n:num)`;
1977       BY(ASM_MESON_TAC[IN_NUMSEG;ARITH_RULE `((n=0) ==> ~(1 <= n)) /\ (~(n=0) ==> (1 <= 1 /\ 1 <= n))`]);
1978     BY(ASM_MESON_TAC[IN_NUMSEG;ARITH_RULE `~(i=n) /\ (i <= n) /\ (1 <= i) ==> (1 <= (i+1) /\ (i+1) <= n)`]);
1979   REPEAT (FIRST_X_ASSUM MP_TAC);
1980   REPEAT WEAK_STRIP_TAC;
1981     FIRST_ASSUM (fun t -> MP_TAC (SPECL [`i+1`;`j:num`] t));
1982     FIRST_X_ASSUM (fun t -> MP_TAC (SPECL [`i:num`;`(i+1):num`] t));
1983     ANTS_TAC;
1984       BY(ASM_MESON_TAC[IN_NUMSEG;ARITH_RULE `i < i + 1`;ARITH_RULE `(i < j /\ j <=n ==> i+1 <=n)/\ (1 <= i+1)`]);
1985     DISCH_TAC;
1986     ASM_REWRITE_TAC[];
1987     DISCH_TAC;
1988     SUBGOAL_THEN `Arg (h (i+1) / u) <= Arg (h j / u)` ASSUME_TAC;
1989       ASM_CASES_TAC `i+1 < j`;
1990         BY(ASM_MESON_TAC [REAL_ARITH `a  < (b:real) ==> a <= b`;IN_NUMSEG;ARITH_RULE `1 <= i+1 /\ (i+1 < j /\ j<= n ==> i+1 <= n)`]);
1991       BY(ASM_MESON_TAC[ARITH_RULE `i < j /\ ~(i+1 < j) ==> (i+1=j)`;REAL_ARITH `a <= a`]);
1992     SUBGOAL_THEN `Arg (h (i+1)/ u) = Arg (h i/ u) + Arg ((h(i+1)/u)/(h (i:num)/u))` MP_TAC;
1993       MATCH_MP_TAC ARG_LE_DIV_SUM;
1994       ASM_SIMP_TAC[Ysskqoy.ARG_0_DIV];
1995       HASH_UNDISCH_TAC 6821;
1996       BY(REAL_ARITH_TAC);
1997     ASM_SIMP_TAC [complex_frac_cancel];
1998     DISCH_TAC;
1999     SUBGOAL_THEN `Arg (h (j:num)/u) = Arg (h i/u) + Arg( (h j/u)/(h i/u))` MP_TAC;
2000       MATCH_MP_TAC ARG_LE_DIV_SUM;
2001       ASM_SIMP_TAC[Ysskqoy.ARG_0_DIV];
2002       REPEAT (FIRST_X_ASSUM MP_TAC);
2003       BY(REAL_ARITH_TAC);
2004     ASM_SIMP_TAC [complex_frac_cancel];
2005     REPEAT (FIRST_X_ASSUM MP_TAC);
2006     BY(REAL_ARITH_TAC);
2007   COMMENT "1 goal: case j<i";
2008   ASM_CASES_TAC `i = (n:num)`;
2009     SUBGOAL_THEN `Arg (h i/ u) = Arg (h 1 / u) + Arg ((h i/u)/(h 1 /u))` MP_TAC;
2010       MATCH_MP_TAC ARG_LE_DIV_SUM;
2011       ASM_SIMP_TAC[Ysskqoy.ARG_0_DIV];
2012       CONJ_TAC;
2013         BY(ASM_MESON_TAC[]);
2014       ASM_CASES_TAC `n=1`;
2015         ASM_REWRITE_TAC[];
2016         BY(REAL_ARITH_TAC);
2017       MATCH_MP_TAC (arith `a:real < b ==> a <= b`);
2018       FIRST_X_ASSUM MATCH_MP_TAC;
2019       HASH_UNDISCH_TAC 88;
2020       ASM_REWRITE_TAC[];
2021       REWRITE_TAC[IN_NUMSEG];
2022       HASH_UNDISCH_TAC 4;
2023       BY(ARITH_TAC);
2024     ASM_SIMP_TAC [complex_frac_cancel];
2025     SUBGOAL_THEN `Arg (h (i:num)/u) = Arg( h j/u) + (Arg ((h i/u)/(h j/u)))` MP_TAC;
2026       MATCH_MP_TAC ARG_LE_DIV_SUM;
2027       ASM_SIMP_TAC[Ysskqoy.ARG_0_DIV];
2028       BY(ASM_MESON_TAC[arith `(a:real < b) ==> (a <= b)`]);
2029     ASM_SIMP_TAC [complex_frac_cancel];
2030     DISCH_TAC;
2031     SUBGOAL_THEN `Arg (h 1/u) <= Arg (h j /u)` MP_TAC;
2032       ASM_CASES_TAC `j = 1`;
2033         ASM_REWRITE_TAC[];
2034         BY(REAL_ARITH_TAC);
2035       MATCH_MP_TAC (arith `a:real < b ==> a <= b`);
2036       FIRST_X_ASSUM MATCH_MP_TAC;
2037       BY(ASM_MESON_TAC[IN_NUMSEG;arith `1 <=1`;arith `1 <=j /\ ~(j=1)==> (1 < j)`]);
2038     REPEAT WEAK_STRIP_TAC;
2039     MP_TAC (SPECL [`u:complex`;`(h 1):complex`;`(h:num->complex) n`] ARG_INV_ALT);
2040     ANTS_TAC;
2041       CONJ_TAC;
2042         BY(ASM_MESON_TAC[]);
2043       CONJ_TAC;
2044         BY(ASM_MESON_TAC[]);
2045       CONJ_TAC;
2046         BY(ASM_MESON_TAC[]);
2047       MATCH_MP_TAC (arith `(a:real < b) ==> ~(a = b)`);
2048       FIRST_X_ASSUM MATCH_MP_TAC;
2049       REPEAT (FIRST_X_ASSUM MP_TAC);
2050       REWRITE_TAC[IN_NUMSEG];
2051       BY(ARITH_TAC);
2052     DISCH_TAC;
2053     MP_TAC (SPECL [`u:complex`;`(h (j:num)):complex`;`(h:num->complex) i`] ARG_INV_ALT);
2054     ANTS_TAC;
2055       CONJ_TAC;
2056         BY(ASM_MESON_TAC[]);
2057       CONJ_TAC;
2058         BY(ASM_MESON_TAC[]);
2059       CONJ_TAC;
2060         BY(ASM_MESON_TAC[]);
2061       MATCH_MP_TAC (arith `(a:real < b) ==> ~(a = b)`);
2062       BY(ASM_SIMP_TAC[]);
2063     REPEAT (FIRST_X_ASSUM MP_TAC);
2064     REPLICATE_TAC 8 (DISCH_TAC);
2065     DISCH_THEN SUBST1_TAC;
2066     BY(REAL_ARITH_TAC);
2067   COMMENT "last case";
2068   SUBGOAL_THEN `i+1 <=n /\ i+1 IN 1..n` MP_TAC;
2069     REPEAT (FIRST_X_ASSUM MP_TAC);
2070     REWRITE_TAC[IN_NUMSEG];
2071     BY(ARITH_TAC);
2072   REPEAT WEAK_STRIP_TAC;
2073   MP_TAC (SPECL [`u:complex`;`(h (i:num)):complex`;`(h:num->complex) j`] ARG_INV_ALT);
2074   ANTS_TAC;
2075     CONJ_TAC;
2076       BY(ASM_MESON_TAC[]);
2077     CONJ_TAC;
2078       BY(ASM_MESON_TAC[]);
2079     CONJ_TAC;
2080       BY(ASM_MESON_TAC[]);
2081     MATCH_MP_TAC (arith `(b:real < a) ==> ~(a = b)`);
2082     BY(ASM_SIMP_TAC[]);
2083   SUBGOAL_THEN `Arg (h (i+1)/u) = Arg (h i /u) + Arg ((h (i+1)/u)/(h i /u))` MP_TAC;
2084     MATCH_MP_TAC ARG_LE_DIV_SUM;
2085     ASM_SIMP_TAC[Ysskqoy.ARG_0_DIV];
2086     MATCH_MP_TAC (arith `a:real < b ==> a <= b`);
2087     FIRST_X_ASSUM MATCH_MP_TAC;
2088     ASM_REWRITE_TAC[];
2089     BY(ARITH_TAC);
2090   ASM_SIMP_TAC [complex_frac_cancel];
2091   SUBGOAL_THEN `Arg (h i/u) = Arg (h (j:num) /u) + Arg ((h i/u)/(h j /u))` MP_TAC;
2092     MATCH_MP_TAC ARG_LE_DIV_SUM;
2093     ASM_SIMP_TAC[Ysskqoy.ARG_0_DIV];
2094     MATCH_MP_TAC (arith `a:real < b ==> a <= b`);
2095     FIRST_X_ASSUM MATCH_MP_TAC;
2096     BY(ASM_REWRITE_TAC[]);
2097   ASM_SIMP_TAC [complex_frac_cancel];
2098   MP_TAC (ISPEC `(h:num->complex) j/ u` ARG);
2099   MP_TAC (ISPEC `(h:num->complex) (i+1)/ u` ARG);
2100   BY(REAL_ARITH_TAC)
2101   ]);;
2102   (* }}} *)
2103
2104 let POLYSORT_BIJ2 = prove_by_refinement(
2105   `!P n s r u.
2106           s = {c | c facet_of P} /\
2107           bounded P /\
2108           polyhedron P /\
2109           &0 < r /\
2110           (!p. norm p < r ==> P p) /\
2111           ~(u = Cx (&0)) /\
2112           s HAS_SIZE n
2113           ==> (?f. s = IMAGE f (1..n) /\
2114                    BIJ f (1..n) s /\
2115                    (!i k. (i IN 1..n) /\ (k IN 1..n) /\ ~(i=k) ==>
2116                          (Arg (facet_rep_a P (f (i+1))/facet_rep_a P (f i))) <=
2117                 (Arg (facet_rep_a P (f k)/ facet_rep_a P (f i)))) /\
2118                    (!i. i IN 1..n ==> Arg (facet_rep_a P (f (i+1)) / facet_rep_a P (f i)) < pi) /\
2119                    (f (n+1) = f 1) /\
2120                    (!j k.
2121                         j IN 1..n /\ k IN 1..n /\ j < k
2122                         ==> Arg (facet_rep_a P (f j) / u) <
2123                             Arg (facet_rep_a P (f k) / u)))`,
2124   (* {{{ proof *)
2125   [
2126   REPEAT WEAK_STRIP_TAC;
2127   MP_TAC (SPECL[`P:real^2->bool`;`n:num`;`s:(real^2->bool)->bool`;`r:real`;`u:real^2`] POLY_SORT_BIJ);
2128   ASM_REWRITE_TAC[];
2129   REPEAT WEAK_STRIP_TAC;
2130   EXISTS_TAC `\i. if (i IN 1..n) then (f i) else ((f:num->(real^2->bool)) 1)`;
2131   BETA_TAC;
2132   SUBCONJ_TAC;
2133     HASH_UNDISCH_TAC 8348;
2134     REWRITE_TAC[IMAGE];
2135     DISCH_THEN SUBST1_TAC;
2136     ONCE_REWRITE_TAC[FUN_EQ_THM];
2137     REWRITE_TAC[IN_ELIM_THM];
2138     BY(MESON_TAC[]);
2139   DISCH_TAC;
2140   SUBCONJ_TAC;
2141     HASH_UNDISCH_TAC 8330;
2142     REWRITE_TAC[BIJ;INJ;SURJ;IN;IN_ELIM_THM];
2143     BY(MESON_TAC[]);
2144   DISCH_TAC;
2145   MATCH_MP_TAC (TAUT `c /\ d /\ a /\ b ==> a /\ b /\ c /\ d`);
2146   SUBGOAL_THEN `~(n+1 IN 1..n)` ASSUME_TAC;
2147     BY(REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC);
2148   SUBCONJ_TAC;
2149     BY(ASM_MESON_TAC[]);
2150   DISCH_TAC;
2151   SUBCONJ_TAC;
2152     BY(ASM_MESON_TAC[]);
2153   DISCH_TAC;
2154   SUBCONJ_TAC;
2155     REPEAT WEAK_STRIP_TAC;
2156     MP_TAC (SPECL [`u:real^2`;`\(i:num). facet_rep_a P (if i IN 1..n then f i else f 1)`;`n:num`] ARG_ORDER);
2157     ANTS_TAC;
2158       ASM_SIMP_TAC[];
2159       REPEAT WEAK_STRIP_TAC;
2160       FIRST_X_ASSUM MP_TAC;
2161       REWRITE_TAC[];
2162       MATCH_MP_TAC facet_rep_nz;
2163       ASM_REWRITE_TAC[];
2164       HASH_UNDISCH_TAC 8330;
2165       REWRITE_TAC[BIJ;INJ;SURJ;IN_ELIM_THM];
2166       HASH_UNDISCH_TAC 6240;
2167       BY(MESON_TAC[]);
2168     BETA_TAC;
2169     DISCH_THEN MATCH_MP_TAC;
2170     BY(ASM_REWRITE_TAC[]);
2171   DISCH_TAC;
2172   COMMENT "down to last subgoal";
2173   REPEAT WEAK_STRIP_TAC;
2174   MP_TAC(SPECL [`P:real^2->bool`;`if (i IN 1..n) then ((f i):real^2->bool) else f 1`;`r:real`] facet_arg_lt_pi);
2175   ASM_REWRITE_TAC[];
2176   ANTS_TAC;
2177     HASH_UNDISCH_TAC 8348;
2178     ONCE_REWRITE_TAC[FUN_EQ_THM];
2179     REWRITE_TAC[IMAGE;IN_ELIM_THM];
2180     BY(ASM_MESON_TAC[]);
2181   REPEAT WEAK_STRIP_TAC;
2182   SUBGOAL_THEN `?j. j IN 1..n /\ c' = (f j):real^2->bool` MP_TAC;
2183     HASH_RULE_TAC 8348 (REWRITE_RULE[FUN_EQ_THM]);
2184     REWRITE_TAC[IMAGE;IN_ELIM_THM];
2185     BY(ASM_MESON_TAC[]);
2186   REPEAT WEAK_STRIP_TAC;
2187   FIRST_X_ASSUM (fun t -> MP_TAC (SPECL [`i:num`;`j:num`] t));
2188   ASM_REWRITE_TAC[];
2189   ASM_CASES_TAC `i=j:num`;
2190     ASM_REWRITE_TAC[];
2191     HASH_UNDISCH_TAC 9883;
2192     ASM_REWRITE_TAC[];
2193     MATCH_MP_TAC (arith `(b = &0) ==> (&0 < b ==> a)`);
2194     REWRITE_TAC[GSYM (SPEC `1` ARG_NUM)];
2195     AP_TERM_TAC;
2196     MATCH_MP_TAC COMPLEX_DIV_REFL;
2197     MATCH_MP_TAC facet_rep_nz;
2198     ASM_REWRITE_TAC[];
2199     HASH_UNDISCH_TAC 8330;
2200     REWRITE_TAC[BIJ;INJ;SURJ;IN_ELIM_THM];
2201     HASH_UNDISCH_TAC 7957;
2202     BY(MESON_TAC[]);
2203   ASM_REWRITE_TAC[];
2204   HASH_UNDISCH_TAC 3495;
2205   ASM_REWRITE_TAC[];
2206   BY(REAL_ARITH_TAC)
2207   ]);;
2208   (* }}} *)
2209
2210 (* ========================================================================== *)
2211 (* EUSOTYP Lemmas *)
2212
2213 (*
2214    The lemma is phrased in terms of Arg rather than polar cycle, because of
2215    a lack of good supporting libraries for polar cycle.
2216
2217    The orthogonality conclusion (4) has been put into separate lemmas:
2218    COS_ARG_VECTOR_ANGLE relating Arg to vector_angle,
2219    SEC_DOT the orthogonality statement in terms of vector_angle.
2220 *)
2221 (* ========================================================================== *)
2222
2223 let EUSOTYP_concl_old =  `!(P:real^2 -> bool) s n r c0 u. polyhedron P /\ bounded P /\
2224     s = { c | c facet_of P } /\
2225     c0 facet_of P /\
2226     u = facet_rep_a P c0 /\
2227     s HAS_SIZE n /\
2228     (&0 < r ) /\
2229   (!p. norm p < r ==> P p) ==>
2230     (?(g:num->real^2).
2231        (!i. i IN 1..(2 * n) ==> (P (g i)) /\ ~(g i = vec 0)) /\
2232        (!j k. j IN 1..(2 * n) /\ k IN 1..(2*n) /\ (j < k) ==>
2233           Arg ( g j/ u) < Arg (g k /  u)) /\
2234        (!l i j k psi. (l IN 1..n /\ i = 2 * l -1 /\ j = 2 *l /\ k = (2 * l +1) MOD (2*n)
2235            /\ psi = Arg( (g k)/(g i) ) / &2)
2236            ==> (norm (g i) = r) /\
2237             norm (g j) = r * inv (cos (psi)) /\
2238            Arg (g j/ g i) = psi /\
2239            Arg (g k/ g j) = psi /\
2240                psi < pi/ &2 ))
2241         `;;
2242
2243 let EMPTY_NOT_EXISTS_IN = prove_by_refinement(
2244   `(a:A->bool) = {} <=> ~(?x. x IN a)`,
2245   (* {{{ proof *)
2246   [
2247   SET_TAC[]
2248   ]);;
2249   (* }}} *)
2250
2251 let EUSOTYP_simple = prove_by_refinement(
2252   `!(P:real^2->bool) s r n u2.
2253      (polyhedron P) /\ (bounded P) /\ (s = {c | c facet_of P}) /\ s HAS_SIZE n /\
2254     (&0 < r) /\ ~(u2 = vec 0) /\ (!p2. norm p2 < r ==> p2 IN P) ==>
2255    (?g h.  (!i. i IN 1..n ==> g i IN P /\ norm (g i) = r) /\
2256           g (n + 1) = g 1 /\
2257      (!j k.           j IN 1..n /\ k IN 1..n /\ j < k
2258           ==> Arg ( (g j) / u2) < Arg ( (g k) / u2)) /\
2259     (!i. i IN 1..n ==> h i IN P /\
2260               norm (h i) = r * inv (cos (Arg ( (g (i + 1)) /  (g i)) / &2))) /\
2261      (!i. i IN 1..n
2262           ==> Arg ( (h i) /  (g i)) = Arg ( (g (i + 1)) /  (g i)) / &2 /\
2263               Arg ( (g (i + 1)) /  (h i)) = Arg ( (g (i + 1)) /  (g i)) / &2) /\
2264      (!i. i IN 1..n
2265           ==> g i dot (h i - g i) = &0 /\ g (i + 1) dot (h i - g (i + 1)) = &0) /\
2266       (1 < n) /\
2267      (!i. i IN 1..n ==> ~(g i = Cx(&0)))  /\
2268      (!i. i IN 1..n ==> ~(h i = Cx(&0))) /\
2269       (!i. (i IN 1..n ==> Arg ( g(i+1)/ g(i)) < pi)) )`,
2270   (* {{{ proof *)
2271   [
2272   REPEAT WEAK_STRIP_TAC;
2273   MP_TAC (SPECL [`P:real^2->bool`;`n:num`;`{ c | (c:real^2->bool) facet_of P}`;`r:real`;`u2:real^2`] POLYSORT_BIJ2);
2274   ASM_REWRITE_TAC[GSYM COMPLEX_VEC_0];
2275   ANTS_TAC;
2276     BY(BY(ASM_MESON_TAC[IN]));
2277   REPEAT WEAK_STRIP_TAC;
2278   EXISTS_TAC `\(i:num).  r % facet_rep_a P (f i)`;
2279   BETA_TAC;
2280   EXISTS_TAC `\(i:num).  bisector_point P (f i) (f (i+1)) r`;
2281   SUBGOAL_THEN `!i. i IN 1..n ==> (f i) facet_of (P:real^2->bool)` ASSUME_TAC;
2282     HASH_UNDISCH_TAC 8348;
2283     BY(BY(SET_TAC[]));
2284   SUBCONJ_TAC;
2285     ASM_SIMP_TAC[Trigonometry2.LT_IMP_ABS_REFL;NORM_MUL];
2286     REPEAT STRIP_TAC;
2287       REWRITE_TAC[IN];
2288       MATCH_MP_TAC facet_rep_in_poly;
2289       BY(BY(ASM_MESON_TAC[IN]));
2290     BY(BY(ASM_MESON_TAC[facet_rep_def;REAL_ARITH `r * &1 = r`]));
2291   DISCH_TAC;
2292   CONJ_TAC;
2293     BY(BY(ASM_REWRITE_TAC[]));
2294   BETA_TAC;
2295   SUBGOAL_THEN `!i. (i IN 1..n ==> ~(facet_rep_a P (f i) = Cx (&0)))` ASSUME_TAC;
2296     GEN_TAC;
2297     DISCH_TAC;
2298     MATCH_MP_TAC facet_rep_nz;
2299     ASM_REWRITE_TAC[];
2300     FIRST_X_ASSUM MATCH_MP_TAC;
2301     BY(BY(ASM_REWRITE_TAC[]));
2302   REWRITE_TAC[COMPLEX_CMUL];
2303   SUBGOAL_THEN `!v u. Arg(((Cx r)*v)/u) = Arg (v/u)` ASSUME_TAC;
2304     REPEAT GEN_TAC;
2305     BY(BY(ASM_SIMP_TAC[complex_div;ARG_MUL_CX;arith `((a:complex)*b) * c = a * b * c`]));
2306   ASM_SIMP_TAC[];
2307   SUBGOAL_THEN `!v u. Arg(v/(Cx r * u)) = Arg (v/u)` ASSUME_TAC;
2308     REPEAT GEN_TAC;
2309     ASM_SIMP_TAC[complex_div;COMPLEX_INV_MUL];
2310     BY(BY(ASM_SIMP_TAC[arith `(a:complex)*(inv (Cx t) * c) = (a * c)/(Cx t)`;ARG_DIV_CX]));
2311   ASM_SIMP_TAC[];
2312   COMMENT "three conjuncts left + 3 new ones";
2313   SUBGOAL_THEN `?x''. x'' facet_of (P:real^2->bool)` MP_TAC;
2314     COMMENT "new insert";
2315     SUBGOAL_THEN `?c. ~(c = {}) /\ ~(c = (P:real^2->bool)) /\ (c face_of P)` ASSUME_TAC;
2316       MP_TAC (ISPEC `P:real^2->bool` (REWRITE_RULE [GSYM FACE_OF_SING ] EXTREME_POINT_EXISTS_CONVEX ));
2317       ANTS_TAC;
2318         REWRITE_TAC[EMPTY_NOT_EXISTS_IN];
2319         BY(ASM_MESON_TAC[NORM_0; POLYTOPE_IMP_CONVEX ; POLYTOPE_IMP_COMPACT; POLYTOPE_EQ_BOUNDED_POLYHEDRON ]);
2320       REPEAT WEAK_STRIP_TAC;
2321       (fun gl -> (EXISTS_TAC ( env gl`{x}`)) gl);
2322       ASM_REWRITE_TAC[];
2323       CONJ_TAC;
2324         BY(SET_TAC[]);
2325       HASH_COPY_TAC 1412;
2326       FIRST_X_ASSUM (MP_TAC o (SPEC `Cx (r/ &2)`));
2327       FIRST_X_ASSUM (MP_TAC o (SPEC `Cx (&0)`));
2328       ASM_SIMP_TAC [ COMPLEX_NORM_CX; arith `&0 < r ==> abs(r/ &2) < r`;arith `&0 < r ==> abs(&0)<r`];
2329       HASH_UNDISCH_TAC 6412;
2330       BY(SET_TAC[ CX_INJ; arith `&0 < r ==> ~(&0 = r/ &2)`]);
2331     FIRST_X_ASSUM (MP_TAC);
2332     BY(ASM_MESON_TAC[FACE_OF_POLYHEDRON_SUBSET_FACET]);
2333   WEAK_STRIP_TAC;
2334   COMMENT "1 < n";
2335   SUBGOAL_THEN `1<n` ASSUME_TAC;
2336     PROOF_BY_CONTR_TAC;
2337     SUBGOAL_THEN `{ c | (c:real^2->bool) facet_of P} HAS_SIZE 1 \/ { c | (c:real^2->bool) facet_of P} HAS_SIZE 0` MP_TAC;
2338       BY(BY(ASM_MESON_TAC[arith `~(1 < n) ==> (n=0) \/ (n = 1)`]));
2339     REWRITE_TAC[HAS_SIZE_1_EXISTS;HAS_SIZE_0];
2340     REWRITE_TAC[EXISTS_UNIQUE;IN_ELIM_THM;EMPTY_NOT_EXISTS_IN];
2341     REWRITE_TAC[DE_MORGAN_THM];
2342     ROT_TAC;
2343     CONJ_TAC;
2344       BY(ASM_MESON_TAC[]);
2345     MP_TAC (SPECL [`P:real^2->bool`;`(x'':real^2->bool)`;`r:real`] facet_arg_lt_pi);
2346     ANTS_TAC;
2347       ASM_REWRITE_TAC[];
2348       BY(BY(ASM_MESON_TAC[IN]));
2349     REPEAT WEAK_STRIP_TAC;
2350     (fun gl -> (SUBGOAL_THEN ( env gl`c' =x''`) MP_TAC) gl);
2351       BY(BY(ASM_MESON_TAC[]));
2352     DISCH_TAC;
2353     HASH_UNDISCH_TAC 9078;
2354     ASM_REWRITE_TAC[];
2355     SUBGOAL_THEN `~(facet_rep_a P x'' = Cx (&0))` MP_TAC;
2356       DISCH_TAC;
2357       BY(ASM_MESON_TAC[ facet_rep_def; COMPLEX_NORM_CX; arith `~(abs(&0) = &1)`]);
2358     SIMP_TAC[COMPLEX_DIV_REFL];
2359     REWRITE_TAC[ARG_NUM];
2360     BY(BY(REAL_ARITH_TAC));
2361   COMMENT "end 1 < n";
2362   ASM_REWRITE_TAC[];
2363   COMMENT "end 1 < n";
2364   COMMENT "end insert";
2365   SUBGOAL_THEN `!i. (i IN 1..n) ==> (P (bisector_point P (f i) (f (i + 1)) r) /\       norm (bisector_point P (f i) (f (i + 1)) r) =      r *      inv (cos (Arg (facet_rep_a P (f (i + 1)) / facet_rep_a P (f i)) / &2)) /\      Arg (bisector_point P (f i) (f (i + 1)) r / facet_rep_a P (f i)) =      Arg (facet_rep_a P (f (i + 1)) / facet_rep_a P (f i)) / &2 /\      Arg (facet_rep_a P (f (i + 1)) / bisector_point P (f i) (f (i + 1)) r) =      Arg (facet_rep_a P (f (i + 1)) / facet_rep_a P (f i)) / &2)` ASSUME_TAC;
2366     GEN_TAC;
2367     DISCH_TAC;
2368     MATCH_MP_TAC bisector_point;
2369     ASM_REWRITE_TAC[];
2370     SUBCONJ_TAC;
2371       BY(BY(ASM_SIMP_TAC[]));
2372     DISCH_TAC;
2373     SUBCONJ_TAC;
2374       ASM_CASES_TAC `i+1 IN 1..n`;
2375         BY(BY(ASM_SIMP_TAC[]));
2376       MP_TAC (prove(`i IN 1..n /\ (~(i+1 IN 1..n)) ==> ((i=n) /\ (1 IN 1..n))`, REWRITE_TAC [IN_NUMSEG] THEN ARITH_TAC));
2377       ASM_REWRITE_TAC[];
2378       REPEAT WEAK_STRIP_TAC;
2379       ASM_REWRITE_TAC[];
2380       BY(BY(ASM_SIMP_TAC[]));
2381     DISCH_TAC;
2382     CONJ_TAC;
2383       BY(BY(ASM_MESON_TAC[IN]));
2384     REWRITE_TAC[arith `&2 * x / &2 = x`;arith `x / &2 < y / &2 <=> x < y`];
2385     ASM_SIMP_TAC[];
2386     SUBCONJ_TAC;
2387       REPEAT WEAK_STRIP_TAC;
2388       SUBGOAL_THEN `(?k. k IN 1..n /\ (c'' = (f:num->real^2->bool) k))` MP_TAC;
2389         HASH_UNDISCH_TAC 3856;
2390         HASH_UNDISCH_TAC 8330;
2391         REWRITE_TAC[BIJ;INJ;SURJ];
2392         BY(BY(SET_TAC[]));
2393       REPEAT WEAK_STRIP_TAC;
2394       BY(BY(ASM_MESON_TAC[arith `(a:real < b) ==> ~(b <= a)`]));
2395     DISCH_TAC;
2396     ASM_CASES_TAC `(i+1) IN 1..n`;
2397       BY(BY(ASM_MESON_TAC[arith `i < i+1`;arith `(a:real < b) ==> ~(a = b)`]));
2398     MP_TAC (prove(`i IN 1..n /\ (~(i+1 IN 1..n)) ==> ((i=n) /\ (1 IN 1..n))`, REWRITE_TAC [IN_NUMSEG] THEN ARITH_TAC));
2399     ASM_REWRITE_TAC[];
2400     REPEAT WEAK_STRIP_TAC;
2401     COMMENT "1 < n";
2402     BY(BY(ASM_MESON_TAC[arith `i < i+1`;arith `(a:real < b) ==> ~(a = b)`]));
2403   COMMENT "1 goal, 5 conjuncts, bisector point now read in ";
2404   ASM_SIMP_TAC[];
2405   CONJ_TAC;
2406     BY(BY(ASM_MESON_TAC[IN]));
2407   COMMENT "nonzero bisector";
2408   SUBGOAL_THEN `!i. (i IN 1..n) ==> ~(norm (bisector_point P (f i) (f (i+1)) r)  = &0)` MP_TAC;
2409     ASM_SIMP_TAC[REAL_ENTIRE;arith `&0 < r ==> ~(r = &0)`];
2410     REWRITE_TAC[REAL_INV_EQ_0];
2411     GEN_TAC;
2412     DISCH_TAC;
2413     MATCH_MP_TAC Taylor_atn.cos_nz;
2414     MATCH_MP_TAC (arith `&0 <= x /\ x < pi /\ (&0 < pi) ==>abs(x/ &2) < pi/ &2`);
2415     REWRITE_TAC[ARG;PI_POS];
2416     BY(BY(ASM_SIMP_TAC[]));
2417   REWRITE_TAC[COMPLEX_NORM_ZERO];
2418   DISCH_TAC;
2419   COMMENT "nonzero bisector";
2420   CONJ_TAC;
2421     GEN_TAC;
2422     DISCH_TAC;
2423     COMMENT "nonzero bisector was here";
2424     CONJ_TAC THEN MATCH_MP_TAC Ysskqoy.SEC_DOT THEN EXISTS_TAC `r:real`;
2425       EXISTS_TAC ` (Arg (facet_rep_a P (f (i + 1)) / facet_rep_a P (f i)) / &2)`;
2426       ASM_SIMP_TAC[];
2427       REWRITE_TAC[ARG;arith `&0 <= x/ &2 <=> &0 <= x`;COMPLEX_NORM_MUL;COMPLEX_NORM_CX;arith `x/ &2 < y/ &2 <=> x < y`];
2428       ASM_SIMP_TAC[Trigonometry2.LT_IMP_ABS_REFL;facet_rep_def;arith `r * &1 = r`];
2429       ONCE_REWRITE_TAC[VECTOR_ANGLE_SYM];
2430       SUBGOAL_THEN `cos (Arg ( (bisector_point P (f i) (f (i + 1)) r)/ (Cx r * facet_rep_a P (f i))))= cos  (vector_angle (bisector_point P (f i) (f (i + 1)) r)  (Cx r * facet_rep_a P (f i)))` (SUBST1_TAC o GSYM);
2431         MATCH_MP_TAC Ysskqoy.COS_ARG_VECTOR_ANGLE;
2432         BY(BY(ASM_SIMP_TAC[COMPLEX_ENTIRE;CX_INJ;arith `&0 < r ==> ~(r = &0)`]));
2433       AP_TERM_TAC;
2434       BY(BY(ASM_MESON_TAC[]));
2435     EXISTS_TAC ` (Arg (facet_rep_a P (f (i + 1)) / facet_rep_a P (f i)) / &2)`;
2436     ASM_SIMP_TAC[];
2437     REWRITE_TAC[ARG;arith `&0 <= x/ &2 <=> &0 <= x`;COMPLEX_NORM_MUL;COMPLEX_NORM_CX;arith `x/ &2 < y/ &2 <=> x < y`];
2438     SUBGOAL_THEN `(f (i+1)) facet_of (P:real^2->bool)` ASSUME_TAC;
2439       ASM_CASES_TAC `i+1 IN 1..n`;
2440         BY(BY(ASM_MESON_TAC[]));
2441       MP_TAC (prove(`i IN 1..n /\ (~(i+1 IN 1..n)) ==> ((i=n) /\ (1 IN 1..n))`, REWRITE_TAC [IN_NUMSEG] THEN ARITH_TAC));
2442       ASM_REWRITE_TAC[];
2443       BY(BY(ASM_MESON_TAC[]));
2444     ASM_SIMP_TAC[Trigonometry2.LT_IMP_ABS_REFL;facet_rep_def;arith `r * &1 = r`];
2445     SUBGOAL_THEN `cos (Arg ( ( (Cx r * facet_rep_a P (f (i + 1)))/ (bisector_point P (f i) (f (i + 1)) r)) ) ) =     cos (vector_angle (Cx r * facet_rep_a P (f (i + 1))) (bisector_point P (f i) (f (i + 1)) r))` (SUBST1_TAC o GSYM);
2446       MATCH_MP_TAC Ysskqoy.COS_ARG_VECTOR_ANGLE;
2447       ASM_SIMP_TAC[COMPLEX_ENTIRE;CX_INJ;arith `&0 < r ==> ~(r = &0)`];
2448       ASM_CASES_TAC `i+1 IN 1..n`;
2449         BY(BY(ASM_SIMP_TAC[]));
2450       MP_TAC (prove(`i IN 1..n /\ (~(i+1 IN 1..n)) ==> ((i=n) /\ (1 IN 1..n))`, REWRITE_TAC [IN_NUMSEG] THEN ARITH_TAC));
2451       BY(BY(ASM_MESON_TAC[]));
2452     AP_TERM_TAC;
2453     BY(BY(ASM_MESON_TAC[]));
2454   ROT_TAC;
2455   CONJ_TAC;
2456     BY(ASM_REWRITE_TAC[ COMPLEX_VEC_0 ]);
2457   GEN_TAC;
2458   DISCH_TAC;
2459   BY(ASM_SIMP_TAC[ COMPLEX_VEC_0 ; COMPLEX_ENTIRE ; CX_INJ ;arith `&0 < r ==> ~(r = &0)`])
2460   ]);;
2461   (* }}} *)
2462
2463 let pad2d3d_SUB = prove_by_refinement(
2464   `!x y. pad2d3d x - pad2d3d y = pad2d3d (x - y)`,
2465   (* {{{ proof *)
2466   [
2467  REPEAT GEN_TAC;
2468   REWRITE_TAC[VECTOR_ARITH `(u:real^A) - (v:real^A) = (u + (-- &1) % v)`];
2469   BY(MESON_TAC[LINEAR_PAD2D3D;linear])
2470   ]);;
2471   (* }}} *)
2472
2473
2474 let EUSOTYP_general = prove_by_refinement(
2475   `!P A n s r u0 u1 u2.
2476     polyhedron P /\ bounded P /\ P SUBSET A /\
2477     s = { c | c facet_of P } /\
2478     s HAS_SIZE n /\
2479     (&0 < r ) /\
2480     ~(u2= u0) /\
2481     ~(u1 = u0) /\
2482     (u0 IN P) /\  (u2 IN A) /\
2483     (!v. v IN A  <=> (v - u0) dot (u1 - u0) = &0) /\
2484     (!p. dist (p, u0) < r /\ p IN A ==> p IN P) ==>
2485     (?g h.
2486        (!i. i IN 1..n ==> ((g i ) IN P) /\ dist(g i , u0) = r) /\
2487        (g (n+1) = g 1) /\
2488        (!i. i IN 1..n ==> ((h i) IN P) /\
2489           norm(h i - u0) = r* inv(cos ((azim u0 u1 (g i) (g (i+1)))/ &2))) /\
2490        (!j k. j IN 1..n /\ k IN 1..n /\ (j < k) ==>
2491           azim u0 u1 u2 (g j) < azim u0 u1 u2 (g k)) /\
2492        (!i. i IN 1..n  ==>
2493            azim u0 u1 (g i) (h i) = (azim u0 u1 (g i) (g (i+1)))/ &2  /\
2494             azim u0 u1 (h i) (g (i+1)) = (azim u0 u1 (g i) (g (i+1)))/ &2) /\
2495       (!i. i IN 1..n ==> (((g i - u0) dot (h i - g i) = &0) /\ ((g (i+1) - u0) dot (h i - g (i+1)) = &0))) /\
2496             (1 < n) /\
2497      (!i. i IN 1..n ==> ~(g i = u0))  /\
2498      (!i. i IN 1..n ==> ~(h i = u0)) /\
2499       (!i. (i IN 1..n ==> azim u0 u1 (g i) (g (i+1)) < pi))
2500       )`,
2501   (* {{{ proof *)
2502   [
2503   REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `u0:real^3`;
2504   REPEAT GEN_TAC THEN GEOM_BASIS_MULTIPLE_TAC 3 `u1:real^3`;
2505   X_GEN_TAC `u1:real`;
2506   GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`];
2507   STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO];
2508   ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; VECTOR_SUB_RZERO; DIST_0];
2509   ASM_SIMP_TAC[VECTOR_MUL_EQ_0; DOT_BASIS; DOT_RMUL; REAL_ENTIRE;BASIS_NONZERO; REAL_LT_IMP_NZ; DIMINDEX_3; ARITH];
2510   POP_ASSUM(K ALL_TAC);
2511   REWRITE_TAC[AZIM_ARG];
2512   REPEAT GEN_TAC;
2513   REPEAT DISCH_TAC;
2514   SUBGOAL_THEN `(u2:real^3)$3 = &0` (fun t-> (REPEAT (POP_ASSUM MP_TAC)) THEN MP_TAC t);
2515     BY(BY(ASM_MESON_TAC[]));
2516   SPEC_TAC (`u2:real^3`,`u2:real^3`);
2517   PAD2D3D_TAC;
2518   GEN_TAC;
2519   REPEAT WEAK_STRIP_TAC;
2520   SUBGOAL_THEN `!v. (v:real^3) IN P ==> v$3 = &0` ASSUME_TAC;
2521     HASH_UNDISCH_TAC 6277;
2522     HASH_UNDISCH_TAC 4709;
2523     BY(BY(SET_TAC[]));
2524   TYPED_ABBREV_TAC `(A':real^2->bool) = IMAGE(dropout 3) (A:real^3->bool)`;
2525   TYPED_ABBREV_TAC `(P':real^2->bool) = IMAGE(dropout 3) (P:real^3->bool)`;
2526   SUBGOAL_THEN `linear ((dropout 3):real^3->real^2)` ASSUME_TAC;
2527     MATCH_MP_TAC LINEAR_DROPOUT;
2528     REWRITE_TAC[DIMINDEX_2;DIMINDEX_3];
2529     BY(BY(ARITH_TAC));
2530   SUBGOAL_THEN `polyhedron P' /\ bounded P' /\ (!p2. norm (p2:real^2) < r ==> p2 IN P')` MP_TAC;
2531     EXPAND_TAC "P'";
2532     CONJ_TAC;
2533       MATCH_MP_TAC POLYHEDRON_LINEAR_IMAGE;
2534       BY(BY(ASM_REWRITE_TAC[]));
2535     CONJ_TAC;
2536       MATCH_MP_TAC BOUNDED_LINEAR_IMAGE;
2537       BY(BY(ASM_REWRITE_TAC[]));
2538     REPEAT WEAK_STRIP_TAC;
2539     ASM_SIMP_TAC [GSYM pad_in];
2540     FIRST_X_ASSUM MATCH_MP_TAC;
2541     ASM_REWRITE_TAC[NORM_PAD2D3D];
2542     SPEC_TAC (`p2:real^2`,`p2:real^2`);
2543     BY(BY(REWRITE_TAC[GSYM QUANTIFY_PAD2D3D_THM]));
2544   COMMENT "1 goal";
2545   REPEAT WEAK_STRIP_TAC;
2546   SUBGOAL_THEN `{d | (d:real^2->bool) facet_of P'} HAS_SIZE n` ASSUME_TAC;
2547     EXPAND_TAC "P'";
2548     MATCH_MP_TAC pad2d3d_facet;
2549     BY(BY(ASM_MESON_TAC[]));
2550   COMMENT "A";
2551   MP_TAC (SPECL [`P':real^2->bool`;`{d | d facet_of (P':real^2->bool)}`;`r:real`;`n:num`;`u2:real^2`] EUSOTYP_simple);
2552   ASM_SIMP_TAC[];
2553   REPEAT WEAK_STRIP_TAC;
2554   EXISTS_TAC `\(i:num). pad2d3d (g i)`;
2555   EXISTS_TAC `\(i:num). pad2d3d (h i)`;
2556   BETA_TAC;
2557   ASM_SIMP_TAC[dropout_pad2d3d;NORM_PAD2D3D;pad2d3d_dot_v;pad2d3d_SUB];
2558   SUBGOAL_THEN `!w. pad2d3d w IN P <=> w IN P'` ASSUME_TAC;
2559     GEN_TAC;
2560     BY(BY(ASM_MESON_TAC[pad_in]));
2561   BY(BY(ASM_MESON_TAC[pad_in; INJECTIVE_PAD2D3D ; COMPLEX_VEC_0 ]))
2562   ]);;
2563   (* }}} *)
2564
2565 let AZIM_SUM_LE = prove_by_refinement(
2566   `!x y z w1 w2 w3.
2567     ~(collinear {x,y,z}) /\ ~(collinear {x,y,w1}) /\ ~(collinear {x,y,w2}) /\
2568    ~(collinear {x,y,w3}) /\
2569     azim x y z w1 <= azim x y z w2 /\
2570     azim x y z w2 <= azim x y z w3 ==>
2571    (azim x y w1 w3 = azim x y w1 w2 + azim x y w2 w3)`,
2572   (* {{{ proof *)
2573   [
2574   REPEAT WEAK_STRIP_TAC;
2575   SUBGOAL_THEN `azim x y z w3 = azim x y z w1 + azim x y w1 w3` ASSUME_TAC;
2576     MATCH_MP_TAC Fan.sum4_azim_fan;
2577     ASM_REWRITE_TAC[];
2578     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
2579   SUBGOAL_THEN `azim x y z w2 = azim x y z w1 + azim x y w1 w2` ASSUME_TAC;
2580     MATCH_MP_TAC Fan.sum4_azim_fan;
2581     BY(ASM_REWRITE_TAC[]);
2582   SUBGOAL_THEN `azim x y z w3 = azim x y z w2 + azim x y w2 w3` ASSUME_TAC;
2583     MATCH_MP_TAC Fan.sum4_azim_fan;
2584     BY(ASM_REWRITE_TAC[]);
2585   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
2586   ]);;
2587   (* }}} *)
2588
2589 let AZIM_NN = prove_by_refinement(
2590   `!x y z u. &0 <= azim x y z u`,
2591   (* {{{ proof *)
2592   [
2593   MESON_TAC[azim]
2594   ]);;
2595   (* }}} *)
2596
2597
2598 let AZIM_BASE_SHIFT_LT = prove_by_refinement(
2599   `!x y z z' w1 w2 w3.
2600     ~(collinear {x,y,z}) /\ ~(collinear {x,y,z'}) /\ ~(collinear {x,y,w1}) /\
2601     ~(collinear {x,y,w2}) /\ ~(collinear {x,y,w3}) /\
2602     azim x y z w1 < azim x y z w2 /\
2603     azim x y z w2 < azim x y z w3 /\
2604     azim x y z' w1 < azim x y z' w3 ==>
2605    (azim x y z' w1 < azim x y z' w2 /\ azim x y z' w2 < azim x y z' w3)
2606 `,
2607   (* {{{ proof *)
2608   [
2609   REPEAT WEAK_STRIP_TAC;
2610   SUBGOAL_THEN `azim x y w1 w3 = azim x y w1 w2 + azim x y w2 w3` ASSUME_TAC;
2611     MATCH_MP_TAC AZIM_SUM_LE;
2612     EXISTS_TAC `z:real^3`;
2613     ASM_REWRITE_TAC[];
2614     BY((REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
2615   REWRITE_TAC[arith `a < b <=> ~(b <= a)`];
2616   CONJ_TAC THEN WEAK_STRIP_TAC;
2617     SUBGOAL_THEN `azim x y w2 w3 = azim x y w2 w1 + azim x y w1 w3` ASSUME_TAC;
2618       MATCH_MP_TAC AZIM_SUM_LE;
2619       EXISTS_TAC `z':real^3`;
2620       ASM_REWRITE_TAC[];
2621       BY((REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
2622     SUBGOAL_THEN `azim x y w1 w2 = &0 /\ azim x y w2 w1 = &0` (MP_TAC);
2623       BY(ASM_MESON_TAC[AZIM_NN;arith `a = b + c /\ c = e + a /\ &0 <= b /\ &0 <= e ==> (b = &0 /\ e = &0)`]);
2624     STRIP_TAC;
2625     SUBGOAL_THEN `azim x y z w2 = azim x y z w1 + azim x y w1 w2` ASSUME_TAC;
2626       MATCH_MP_TAC Fan.sum4_azim_fan;
2627       ASM_REWRITE_TAC[];
2628       BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
2629     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
2630   COMMENT "1 left";
2631   SUBGOAL_THEN `azim x y w1 w2 = azim x y w1 w3 + azim x y w3 w2` ASSUME_TAC;
2632     MATCH_MP_TAC AZIM_SUM_LE;
2633     EXISTS_TAC `z':real^3`;
2634     ASM_REWRITE_TAC[];
2635     BY((REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
2636   SUBGOAL_THEN `azim x y w2 w3 = &0 /\ azim x y w3 w2 = &0` (MP_TAC);
2637     BY(ASM_MESON_TAC[AZIM_NN;arith `a = b + c /\ b = a + c' /\ &0 <= c /\ &0 <= c' ==> (c = &0 /\ c' = &0)`]);
2638   STRIP_TAC;
2639   SUBGOAL_THEN `azim x y z w3 = azim x y z w2 + azim x y w2 w3` ASSUME_TAC;
2640     MATCH_MP_TAC Fan.sum4_azim_fan;
2641     ASM_REWRITE_TAC[];
2642     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
2643   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
2644   ]);;
2645   (* }}} *)
2646
2647
2648 let AZIM_COMP_LT = prove_by_refinement(
2649   `!x y z u v. &0 < azim x y z u /\  azim x y z u < azim x y z v ==>
2650      azim x y v z < azim x y u z `,
2651   (* {{{ proof *)
2652   [
2653   REPEAT WEAK_STRIP_TAC;
2654   ONCE_REWRITE_TAC[Rogers.AZIM_COMPL_EXT];
2655   BY(REPEAT COND_CASES_TAC THEN (REPEAT (FIRST_X_ASSUM MP_TAC)) THEN REAL_ARITH_TAC)
2656   ]);;
2657   (* }}} *)
2658
2659 let AZIM_COMP_LE = prove_by_refinement(
2660   `!x y z u v. &0 < azim x y z u /\  azim x y z u <= azim x y z v ==>
2661      azim x y v z <= azim x y u z `,
2662   (* {{{ proof *)
2663   [
2664   REPEAT WEAK_STRIP_TAC;
2665   ONCE_REWRITE_TAC[Rogers.AZIM_COMPL_EXT];
2666   BY(REPEAT COND_CASES_TAC THEN (REPEAT (FIRST_X_ASSUM MP_TAC)) THEN REAL_ARITH_TAC)
2667   ]);;
2668   (* }}} *)
2669
2670 let AZIM_COMP2_LE = prove_by_refinement(
2671   `!x y z u v. &0 < azim x y u z /\  &0 < azim x y v z /\ azim x y u z <= azim x y v z ==>
2672      azim x y z v <= azim x y z u `,
2673   (* {{{ proof *)
2674   [
2675   REPEAT WEAK_STRIP_TAC;
2676   ONCE_REWRITE_TAC[Rogers.AZIM_COMPL_EXT];
2677   BY(REPEAT COND_CASES_TAC THEN (REPEAT (FIRST_X_ASSUM MP_TAC)) THEN REAL_ARITH_TAC)
2678   ]);;
2679   (* }}} *)
2680
2681 let AZIM_COMP2_LT = prove_by_refinement(
2682   `!x y z u v. &0 < azim x y u z /\  &0 < azim x y v z /\ azim x y u z < azim x y v z ==>
2683      azim x y z v < azim x y z u `,
2684   (* {{{ proof *)
2685   [
2686   REPEAT WEAK_STRIP_TAC;
2687   ONCE_REWRITE_TAC[Rogers.AZIM_COMPL_EXT];
2688   BY(REPEAT COND_CASES_TAC THEN (REPEAT (FIRST_X_ASSUM MP_TAC)) THEN REAL_ARITH_TAC)
2689   ]);;
2690   (* }}} *)
2691
2692 let WEDGE_ORDER_DISJOINT = prove_by_refinement(
2693   `!x y z n g.
2694      ~(collinear {x,y,z}) /\
2695     (!i. i IN 1..n ==> ~(collinear {x,y, g i})) /\
2696      (g (n+1) = g 1) /\
2697         (!j k. j IN 1..n /\ k IN 1..n /\ (j < k) ==>
2698           azim x y z (g j) < azim x y z (g k))
2699     ==>
2700     (!j k. j IN 1..n /\ k IN 1..n /\ ~(j = k) ==>
2701        wedge x y (g j) (g (j+1)) INTER wedge x y (g k) (g (k+1)) = {})
2702          `,
2703   (* {{{ proof *)
2704   [
2705   REPEAT GEN_TAC;
2706   DISCH_TAC;
2707   MATCH_MP_TAC WLOG_LT;
2708   REWRITE_TAC[];
2709   CONJ_TAC;
2710     BY(SET_TAC[]);
2711   GEN_TAC;
2712   X_GEN_TAC `k:num`;
2713   FIRST_X_ASSUM MP_TAC;
2714   REPEAT WEAK_STRIP_TAC;
2715   REWRITE_TAC[FUN_EQ_THM];
2716   X_GEN_TAC `p:real^3`;
2717   REWRITE_TAC[INTER;IN_ELIM_THM;wedge;X_IN NOT_IN_EMPTY];
2718   REPEAT WEAK_STRIP_TAC;
2719   SUBGOAL_THEN `j + 1 IN 1..n` ASSUME_TAC;
2720     REPEAT (FIRST_X_ASSUM MP_TAC) THEN REWRITE_TAC[IN_NUMSEG];
2721     BY(ARITH_TAC);
2722   SUBGOAL_THEN `(azim x y z (g (j:num)) < azim x y z p)` ASSUME_TAC;
2723     REWRITE_TAC [arith `a <  b <=> ~(b <= a)`];
2724     WEAK_STRIP_TAC;
2725     (fun gl -> (MP_TAC (SPECL ( envl gl[`x`;`y`;`g j`;`z`;`g j`;`p`;`g (j+1)` ]) AZIM_BASE_SHIFT_LT)) gl);
2726     ASM_SIMP_TAC[AZIM_REFL;arith `j < j+1`];
2727     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
2728   COMMENT "A";
2729   SUBGOAL_THEN `azim x y z p < azim x y z (g (j+1))` ASSUME_TAC;
2730     REWRITE_TAC[arith `a < b <=> ~(b <= a)`];
2731     WEAK_STRIP_TAC;
2732     (fun gl -> (MP_TAC (SPECL ( envl gl[`x`;`y`;`g j`;`z`;`g j`;`p`;`g (j+1)` ]) AZIM_BASE_SHIFT_LT)) gl);
2733     ASM_SIMP_TAC[AZIM_REFL;arith `j < j+1`];
2734     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
2735   COMMENT "B";
2736   SUBGOAL_THEN `k = (n:num) /\ 1 IN 1..n` ASSUME_TAC;
2737     MATCH_MP_TAC (prove (`k IN 1..n /\ ~(k+1 IN 1..n) ==> ((k = n) /\ 1 IN 1..n)`, REWRITE_TAC [ IN_NUMSEG ] THEN ARITH_TAC ));
2738     ASM_SIMP_TAC[];
2739     WEAK_STRIP_TAC;
2740     FIRST_ASSUM (MP_TAC o (SPECL[`k:num`;`k+1`]));
2741     FIRST_X_ASSUM (MP_TAC o (SPECL[`j+1`;`k:num`]));
2742     ASM_SIMP_TAC[arith `k < k+1`];
2743     REPEAT WEAK_STRIP_TAC;
2744     (fun gl -> (MP_TAC (SPECL ( envl gl[`x`;`y`;`g k`;`z`;`g k`;`p`;`g (k+1)`]) AZIM_BASE_SHIFT_LT)) gl);
2745     ASM_SIMP_TAC[AZIM_REFL];
2746     SUBGOAL_THEN `azim x y z (g (j+1)) <= azim x y z (g (k:num))` ASSUME_TAC;
2747       BY(ASM_MESON_TAC[arith `a <= b <=> (a<b \/ a = b)`;arith `j<k ==> (j+1=k)\/ (j+1<k)`]);
2748     REPEAT (FIRST_X_ASSUM MP_TAC);
2749     BY(REAL_ARITH_TAC);
2750   COMMENT "C";
2751   SUBGOAL_THEN `azim x y (g 1) (g n) < azim x y p (g (n:num))` ASSUME_TAC;
2752     MATCH_MP_TAC AZIM_COMP_LT;
2753     BY(ASM_MESON_TAC[]);
2754   SUBGOAL_THEN `1 < n` ASSUME_TAC;
2755     BY(ASM_MESON_TAC[IN_NUMSEG;arith `1 <= j /\ j < k /\ k <= n ==> 1 < n`]);
2756   SUBGOAL_THEN `azim x y z (g n) = azim x y z (g 1) + azim x y (g 1) (g n)` ASSUME_TAC;
2757     MATCH_MP_TAC Fan.sum4_azim_fan;
2758     BY(ASM_MESON_TAC[arith `a<b ==> a <= b`]);
2759   SUBGOAL_THEN `azim x y z p = azim x y z (g 1) + azim x y (g 1) p` ASSUME_TAC;
2760     MATCH_MP_TAC Fan.sum4_azim_fan;
2761     ASM_SIMP_TAC[];
2762     MATCH_MP_TAC (arith `a<b ==> a <= b`);
2763     ASM_CASES_TAC `(1=j)`;
2764       BY(ASM_SIMP_TAC[]);
2765     MATCH_MP_TAC (arith `a < azim x y z (g (j:num)) /\ azim x y z (g j) < c ==> a < c`);
2766     ASM_SIMP_TAC[];
2767     FIRST_X_ASSUM MATCH_MP_TAC;
2768     ASM_SIMP_TAC[];
2769     BY(ASM_MESON_TAC[IN_NUMSEG; arith `1 <= j ==> ((1=j) \/ (1 < j))`]);
2770   FIRST_X_ASSUM MP_TAC;
2771   SUBGOAL_THEN `azim x y z (g n) = azim x y z p + azim x y p (g (n:num))` ASSUME_TAC;
2772     MATCH_MP_TAC Fan.sum4_azim_fan;
2773     ASM_SIMP_TAC[];
2774     MATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`);
2775     CONJ_TAC;
2776       BY(ASM_MESON_TAC[]);
2777     MATCH_MP_TAC (arith `a<b ==> a <= b`);
2778     ASM_CASES_TAC `(j+1=n)`;
2779       BY(ASM_MESON_TAC[]);
2780     MATCH_MP_TAC (arith `a < azim x y z (g (j+1)) /\ azim x y z (g (j+1)) < c ==> a < c`);
2781     ASM_SIMP_TAC[];
2782     BY(ASM_MESON_TAC[IN_NUMSEG; arith `~(j+1=n) /\ ~(j=n) /\ (j<=n) ==> (j+1 < n)`]);
2783   DISCH_TAC;
2784   SUBGOAL_THEN `azim x y (g 1) p < &0` ASSUME_TAC;
2785     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
2786   BY(ASM_MESON_TAC[azim;arith `x < &0 ==> ~(&0 <= x)`])
2787   ]);;
2788   (* }}} *)
2789
2790 let ORDER_AZIM_SUM2Pi = prove_by_refinement(
2791    `!x y z n g.
2792      ~(collinear {x,y,z}) /\
2793     (!i. i IN 1..n ==> ~(collinear {x,y, g i})) /\
2794      (g (n+1) = g 1) /\ (1 < n) /\
2795         (!j k. j IN 1..n /\ k IN 1..n /\ (j < k) ==>
2796           azim x y z (g j) < azim x y z (g k))
2797     ==>
2798      sum (1..n) (\i. azim x y (g i) (g (i+1))) = &2 * pi`,
2799   (* {{{ proof *)
2800   [
2801   REPEAT WEAK_STRIP_TAC;
2802   SUBGOAL_THEN `!i. i IN 1..(n-1) /\ 1 < n ==> (i < i+1 /\ i IN 1..n /\ (i+1) IN 1..n)` MP_TAC;
2803     REWRITE_TAC[IN_NUMSEG];
2804     BY(ARITH_TAC);
2805   REPEAT WEAK_STRIP_TAC;
2806   SUBGOAL_THEN `!i. i IN 1..(n-1) ==> azim x y (g i) (g(i+1)) = azim x y z (g(i+1)) - azim x y z (g i)` ASSUME_TAC;
2807     REPEAT WEAK_STRIP_TAC;
2808     REWRITE_TAC[arith `a = b - c <=> b = c + a`];
2809     MATCH_MP_TAC Fan.sum4_azim_fan;
2810     ASM_SIMP_TAC[];
2811     MATCH_MP_TAC (arith `a < b ==> a <= b`);
2812     BY(ASM_MESON_TAC[arith `i < i+1`]);
2813   SUBGOAL_THEN `sum (1..n) (\i. azim x y (g i) (g (i+1))) = sum (1..(n-1)) (\i. azim x y (g i) (g (i+1))) + sum (n..n) (\i. azim x y (g i) (g (i+1)))` SUBST1_TAC;
2814     BY(ASM_MESON_TAC[arith `1 <= (n-1)+1 /\ ((1<n) ==>(n-1)+1 = n)`;SUM_ADD_SPLIT]);
2815   REWRITE_TAC[SUM_SING_NUMSEG];
2816   SUBGOAL_THEN `sum (1..(n-1)) (\i. azim x y (g i) (g(i+1))) = sum(1..(n-1)) (\i. azim x y z (g (i+1)) - azim x y z (g i))` SUBST1_TAC;
2817     BY(ASM_MESON_TAC[SUM_EQ]);
2818   SIMP_TAC[SUM_DIFFS_ALT];
2819   ASM_SIMP_TAC[arith `1< n ==> 1 <= n-1`;arith `1 < n==> (n-1)+1 = n`];
2820   MATCH_MP_TAC (arith `  a = b + azim x y (g 1) (g n)  /\ c = &2 * pi - azim x y (g 1) (g n) ==> a - b + c = &2 * pi`);
2821   SUBGOAL_THEN `1 IN 1..n /\ n IN 1..n` MP_TAC;
2822     REWRITE_TAC[IN_NUMSEG];
2823     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN ARITH_TAC);
2824   REPEAT WEAK_STRIP_TAC;
2825   SUBCONJ_TAC;
2826     MATCH_MP_TAC Fan.sum4_azim_fan;
2827     BY(ASM_SIMP_TAC[arith `a< b ==> a<=b`]);
2828   DISCH_TAC;
2829   (fun gl -> (REWRITE_TAC[SPECL ( envl gl[`x`;`y`;`g (1)`;`g(n:num)`]) Rogers.AZIM_COMPL_EXT]) gl);
2830   COND_CASES_TAC;
2831     BY(ASM_MESON_TAC[arith `x = y + &0 ==> ~(y<x)`]);
2832   BY(REWRITE_TAC[])
2833   ]);;
2834   (* }}} *)
2835
2836
2837 let AFFINE_VEC0 = prove_by_refinement(
2838   `!(u:real^A) t.  ~(t= &1) ==> vec 0 IN affine hull {u, t % u}`,
2839   (* {{{ proof *)
2840   [
2841   REPEAT WEAK_STRIP_TAC;
2842   REWRITE_TAC[ AFFINE_HULL_2_ALT ; IN_ELIM_THM ];
2843   ASM_CASES_TAC (`(u:real^A) = vec 0`);
2844     ASM_REWRITE_TAC[];
2845     REWRITE_TAC[VECTOR_ADD_RID;VECTOR_SUB_RZERO;VECTOR_ADD_LID;VECTOR_SUB_LZERO];
2846     REWRITE_TAC[VECTOR_MUL_RZERO];
2847     BY(REWRITE_TAC[IN_UNIV]);
2848   REWRITE_TAC[IN_UNIV];
2849   EXISTS_TAC `&1 / (&1 - t)`;
2850   REWRITE_TAC[ VECTOR_ARITH `(u + s % (t % u - (u:real^A))) = (&1 + s * t - s) % u`];
2851   MATCH_MP_TAC (VECTOR_ARITH (`(a:real^A) = b ==> b = a`));
2852   ASM_REWRITE_TAC [ VECTOR_MUL_EQ_0 ];
2853   MATCH_MP_TAC (Calc_derivative.rational_identity `&1 + &1 / (&1 - t) * t - &1 / (&1 - t) = &0`);
2854   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
2855   ]);;
2856   (* }}} *)
2857
2858
2859 let RELATIVE_INTERIOR_AFFINE_FACE = prove_by_refinement(
2860   `!C (p:real^N) f. convex C /\ f face_of C /\ p IN affine hull f /\ (p IN relative_interior C) ==> (f = C) `,
2861   (* {{{ proof *)
2862   [
2863   REPEAT WEAK_STRIP_TAC;
2864   (fun gl -> (ENOUGH_TO_SHOW_TAC ( env gl `~(f INTER relative_interior C = {})`)) gl);
2865     BY(ASM_MESON_TAC[ FACE_OF_DISJOINT_RELATIVE_INTERIOR ]);
2866   REWRITE_TAC[Local_lemmas.EXISTS_IN];
2867   (fun gl -> (EXISTS_TAC ( env gl `p`)) gl);
2868   ASM_REWRITE_TAC[ IN_INTER ];
2869   TYPIFY `f = affine hull f INTER C` (C SUBGOAL_THEN SUBST1_TAC);
2870     BY(ASM_MESON_TAC [ FACE_OF_STILLCONVEX ]);
2871   ASM_REWRITE_TAC[ IN_INTER ];
2872   FIRST_X_ASSUM (MP_TAC);
2873   BY(ASM_MESON_TAC[ RELATIVE_INTERIOR_SUBSET ;SUBSET; IN ])
2874   ]);;
2875   (* }}} *)
2876
2877 let SUBSET_P_HULL = prove(` (S:A -> bool) SUBSET P hull S`,
2878 REWRITE_TAC[HULL_SUBSET]);;
2879
2880
2881 let FCHANGED_AFFINE = prove_by_refinement(
2882   `!p (f:real^3->bool).
2883     polyhedron p /\ bounded p /\ vec 0 IN interior p /\ f facet_of p ==>
2884     (fchanged f INTER affine hull f = relative_interior f)`,
2885   (* {{{ proof *)
2886   [
2887   REPEAT WEAK_STRIP_TAC;
2888   MATCH_MP_TAC SUBSET_ANTISYM;
2889   ROT_TAC;
2890   CONJ_TAC;
2891     REWRITE_TAC[SUBSET_INTER];
2892     CONJ_TAC;
2893       BY(BY(ASM_MESON_TAC[ Polyhedron.RELATIVE_SUBSET_FCHANGE ]));
2894     BY(BY(ASM_MESON_TAC[ Qzksykg.SET_SUBSET_AFFINE_HULL ; RELATIVE_INTERIOR_SUBSET ; SUBSET]));
2895   REWRITE_TAC[ SUBSET ; IN_INTER ; Polyhedron.fchanged ; IN_ELIM_THM ];
2896   (REPEAT WEAK_STRIP_TAC);
2897   (fun gl -> (ASM_CASES_TAC ( env gl`x = v1` )) gl);
2898     BY(ASM_MESON_TAC[]);
2899   TYPIFY `vec 0 IN affine hull f` (C SUBGOAL_THEN ASSUME_TAC);
2900     (fun gl -> (ENOUGH_TO_SHOW_TAC ( env gl `vec 0 IN affine hull {v1, t % v1 } /\ {v1 , t % v1 } SUBSET affine hull f`)) gl);
2901       BY(ASM_MESON_TAC[ SUBSET; IN; Marchal_cells_2_new.AFFINE_SUBSET_KY_LEMMA ; HULL_MONO; HULL_HULL ]);
2902     CONJ_TAC;
2903       MATCH_MP_TAC AFFINE_VEC0;
2904       BY(ASM_MESON_TAC [ VECTOR_MUL_LID ]);
2905     REWRITE_TAC[ SUBSET ];
2906     GEN_TAC;
2907     REWRITE_TAC[Collect_geom.IN_SET2];
2908     REPEAT WEAK_STRIP_TAC THEN ASM_REWRITE_TAC[];
2909       BY(ASM_MESON_TAC [ RELATIVE_INTERIOR_SUBSET; SUBSET_P_HULL ; SUBSET; IN]);
2910     BY(ASM_MESON_TAC[]);
2911   (fun gl -> (SUBGOAL_THEN ( env gl`f = p`) ASSUME_TAC) gl);
2912     MATCH_MP_TAC (INST_TYPE [(`:3`,`:N`)] RELATIVE_INTERIOR_AFFINE_FACE);
2913     EXISTS_TAC `(vec 0):real^3`;
2914     ASM_REWRITE_TAC[];
2915     BY(ASM_MESON_TAC[ POLYHEDRON_IMP_CONVEX ; facet_of; INTERIOR_SUBSET_RELATIVE_INTERIOR ; SUBSET; IN]);
2916   HASH_UNDISCH_TAC 8736;
2917   ASM_REWRITE_TAC[ facet_of ];
2918   BY(MESON_TAC[ ( arith `T ==> ~((x:int) = x - &1)`)])
2919   ]);;
2920   (* }}} *)
2921
2922 let RCONE_PREP = prove_by_refinement(
2923   `!p (v:real^3) u0 b.
2924     &0 < b /\ ~(v = vec 0) /\ (&0 < v dot v)  /\
2925     u0= (b / (v dot v)) % v /\
2926     (&0 < t ) /\ (t < &1) /\
2927     p dot v = b ==>
2928    ( (u0 dot u0 = (b * b) / (v dot v)) /\
2929        (p dot u0 = (b * b )/ (v dot v)) /\
2930      (dist (p,u0) pow 2 = p dot p -  (b * b)/(v dot v)   ))`,
2931   (* {{{ proof *)
2932   [
2933   REPEAT WEAK_STRIP_TAC;
2934   SUBCONJ_TAC;
2935     ASM_REWRITE_TAC[];
2936     REWRITE_TAC[DOT_LMUL];
2937     REWRITE_TAC[DOT_RMUL];
2938     CALC_ID_TAC;
2939     BY((REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
2940   DISCH_TAC;
2941   SUBCONJ_TAC;
2942     ASM_REWRITE_TAC[];
2943     REWRITE_TAC[DOT_RMUL];
2944     ASM_REWRITE_TAC[];
2945     CALC_ID_TAC;
2946     BY((REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
2947   DISCH_TAC;
2948   REWRITE_TAC[ Collect_geom.DIST_POW2_DOT ];
2949   TYPIFY `(p - u0) dot (p - u0) = (p dot p) - (b * b)/(v dot v)` (C SUBGOAL_THEN SUBST1_TAC);
2950   REWRITE_TAC [ VECTOR_ARITH `(p - (u0:real^3)) dot (p - u0) = p dot p - &2 * (p dot u0) + u0 dot u0`];
2951     HASH_KILL_TAC 9721;
2952     ASM_REWRITE_TAC[];
2953     BY(BY(REAL_ARITH_TAC));
2954   BY(REAL_ARITH_TAC)
2955   ]);;
2956   (* }}} *)
2957
2958 let RCONE_DISK = prove_by_refinement(
2959   `!p (v:real^3) u0 b r t.
2960     &0 < b /\ ~(v = vec 0) /\ (&0 < v dot v) /\ dist(p,u0) < r /\
2961     u0= (b / (v dot v)) % v /\
2962     (&0 < t ) /\ (t < &1) /\
2963     p dot v = b /\ (r = b * sqrt(&1 - t pow 2)/(t * norm v)) ==>
2964     (p IN rcone_gt (vec 0) v t)`,
2965   (* {{{ proof *)
2966   [
2967   REPEAT WEAK_STRIP_TAC;
2968   REWRITE_TAC[rcone_gt;rconesgn;IN_ELIM_THM];
2969   REWRITE_TAC[VECTOR_ADD_RID;VECTOR_SUB_RZERO;VECTOR_ADD_LID;VECTOR_SUB_LZERO];
2970   REWRITE_TAC[DIST_0];
2971   GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`p`;`v`;`u0`;`b`]) RCONE_PREP)));
2972   ANTS_TAC;
2973     BY(ASM_MESON_TAC[]);
2974   REPEAT WEAK_STRIP_TAC;
2975   HASH_KILL_TAC 9721;
2976   REWRITE_TAC[arith `a > b <=> b < a`];
2977   MATCH_MP_TAC Tactics_jordan.REAL_POW_2_LT;
2978   REWRITE_TAC[ Trigonometry2.MUL_POW2 ];
2979   REWRITE_TAC[ NORM_POW_2 ];
2980   CONJ_TAC;
2981     REPEAT (MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2) THEN REWRITE_TAC[ NORM_POS_LE ];
2982     REPEAT (MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2) THEN REWRITE_TAC[ NORM_POS_LE ];
2983     BY(BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
2984   CONJ_TAC;
2985     BY(BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
2986   TYPIFY `p dot p < (b * b)/ ((t pow 2) * (v dot v))` (C SUBGOAL_THEN ASSUME_TAC);
2987     FIRST_X_ASSUM (fun t -> MP_TAC (MATCH_MP Tarjjuw.CHANGE_TARJJUW_4 t));
2988     ASM_REWRITE_TAC[];
2989     MATCH_MP_TAC (arith `(c + u = v) ==> (a - c < u ==> a< v)`);
2990     CALC_ID_TAC;
2991     REWRITE_TAC[ NORM_EQ_0 ];
2992     ASM_SIMP_TAC[arith `&0 < k ==> ~(k = &0)`];
2993     REWRITE_TAC[ Trigonometry2.MUL_POW2 ; NORM_POW_2 ];
2994     SUBGOAL_THEN `&0 <= &1 - t pow 2` ASSUME_TAC;
2995       MATCH_MP_TAC Trigonometry2.UNIT_BOUNDED_IN_TOW_FORMS;
2996       BY(BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
2997     ASM_SIMP_TAC [ SQRT_POW_2 ];
2998     BY(BY(REAL_ARITH_TAC));
2999   COMMENT "1";
3000   FIRST_X_ASSUM (fun t -> ASSUME_TAC (MATCH_MP ( REWRITE_RULE[ TAUT `(a /\ b ==> c) <=> (a ==> (b ==> c))`] REAL_LT_RMUL) t));
3001   FIRST_X_ASSUM (C INTRO_TAC [`(v dot v) * t pow 2`]);
3002 (*  TYPIFY `(v dot v) * t pow 2` (C FIRST_X_ASSUM (fun t -> MP_TAC (ISPEC t))); *)
3003   ANTS_TAC;
3004     MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[];
3005     REWRITE_TAC[ GSYM Trigonometry2.NOT_ZERO_EQ_POW2_LT ];
3006     BY(BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
3007   MATCH_MP_TAC (arith `(b = c) ==> (a < b ==> (a < c))`);
3008   ASM_REWRITE_TAC[];
3009   CALC_ID_TAC;
3010   BY(BY(REPEAT CONJ_TAC THEN REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC))
3011  ]);;
3012   (* }}} *)
3013
3014 let RDISK_R = prove_by_refinement(
3015     `! (v:real^3) u0 b  t.
3016     &0 < b /\ ~(v = vec 0) /\ (&0 < v dot v) /\     (&0 < t ) /\ (t < &1) /\
3017     u0= (b / (v dot v)) % v ==>
3018     (?r. (&0 < r) /\ (!p.  dist(p,u0) < r /\  p dot v = b ==>  (p IN rcone_gt (vec 0) v t)) /\
3019        (!w. dist(w,u0) = r /\ w dot v = b ==> cos (arcV(vec 0) u0 w) = t))`,
3020   (* {{{ proof *)
3021   [
3022   REPEAT WEAK_STRIP_TAC;
3023   TYPED_ABBREV_TAC `r = b * sqrt(&1 - t pow 2)/(t * norm v)`;
3024   SUBGOAL_THEN `&0 < &1 - t pow 2` ASSUME_TAC;
3025     REWRITE_TAC[ arith `&0 < &1 - x <=> x < &1` ];
3026     REWRITE_TAC[ ABS_SQUARE_LT_1 ];
3027     BY(BY(BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)));
3028   EXISTS_TAC `r:real`;
3029   SUBCONJ_TAC;
3030     EXPAND_TAC "r";
3031     MATCH_MP_TAC REAL_LT_MUL;
3032     CONJ_TAC THEN ASM_REWRITE_TAC[ Calc_derivative.invert_den_lt ];
3033     MATCH_MP_TAC REAL_LT_MUL;
3034     ASM_SIMP_TAC [ SQRT_POS_LT ];
3035     MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[];
3036     BY(ASM_REWRITE_TAC[ NORM_POS_LT ]);
3037   DISCH_TAC;
3038   CONJ_TAC;
3039     REPEAT WEAK_STRIP_TAC;
3040     BY(ASM_MESON_TAC[ RCONE_DISK]);
3041   REPEAT WEAK_STRIP_TAC;
3042   GOAL_TERM (fun REWRITE_TAC -> (MP_TAC (ISPECL ( envl REWRITE_TAC [`w`;`v`;`u0`;`b`]) RCONE_PREP)));
3043   ANTS_TAC;
3044     BY(BY(ASM_MESON_TAC[]));
3045   REPEAT WEAK_STRIP_TAC;
3046   GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `norm u0 * norm w * cos (arcV (vec 0) u0 w) = norm u0 * norm w * t`)));
3047     REWRITE_TAC[ REAL_EQ_MUL_LCANCEL ; NORM_EQ_0 ];
3048     MATCH_MP_TAC (TAUT `~a /\ ~b ==> (a \/ b \/ c ==> c)`);
3049     CONJ_TAC;
3050       ASM_REWRITE_TAC[];
3051       REWRITE_TAC [ VECTOR_MUL_EQ_0 ];
3052       ASM_REWRITE_TAC[];
3053       REWRITE_TAC [ Calc_derivative.invert_den_eq ];
3054       REWRITE_TAC[ REAL_ENTIRE];
3055       BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
3056     DISCH_TAC;
3057     HASH_UNDISCH_TAC 287;
3058     ASM_REWRITE_TAC[];
3059     REWRITE_TAC[ DOT_LZERO ];
3060     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
3061   REWRITE_TAC[ GSYM Trigonometry1.DOT_COS ];
3062   FIRST_X_ASSUM (MP_TAC);
3063   HASH_KILL_TAC 9721;
3064   ASM_REWRITE_TAC[];
3065   HASH_KILL_TAC 1350;
3066   EXPAND_TAC "r";
3067   REWRITE_TAC[ Trigonometry2.MUL_POW2 ; Trigonometry2.DIV_POW2 ];
3068   REWRITE_TAC[ arith `a = b - c <=> b = a + c`];
3069   ASM_SIMP_TAC [ SQRT_POW_2 ; arith `&0 < u ==> &0 <= u`];
3070   DISCH_TAC;
3071   GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `&0 <= u0 dot w /\ &0 <= norm u0 * norm w * t /\ ((u0 dot w) pow 2 = (norm u0 * norm w * t) pow 2)`)));
3072     BY(ASM_MESON_TAC[ Collect_geom.EQ_POW2_COND ]);
3073   ONCE_REWRITE_TAC[ DOT_SYM ];
3074   ASM_REWRITE_TAC[];
3075   REWRITE_TAC[ Trigonometry2.MUL_POW2 ; Trigonometry2.DIV_POW2 ];
3076   REWRITE_TAC[ NORM_POW_2 ];
3077   ASM_REWRITE_TAC[];
3078   CONJ_TAC;
3079     REWRITE_TAC[ Calc_derivative.invert_den_le ];
3080     BY(MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2 THEN CONJ_TAC THEN TRY (MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2 ) THEN (REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
3081   CONJ_TAC;
3082     REPEAT (MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2 THEN REWRITE_TAC[ NORM_POS_LE ] THEN TRY CONJ_TAC);
3083     BY((REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
3084   CALC_ID_TAC;
3085   ASM_REWRITE_TAC[ DOT_EQ_0 ; NORM_EQ_0 ];
3086   CONJ_TAC;
3087     BY((REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
3088   REWRITE_TAC[ NORM_POW_2 ];
3089   BY(REAL_ARITH_TAC)
3090   ]);;
3091   (* }}} *)
3092
3093 let FCHANGED_MEASURABLE = prove_by_refinement(
3094   `!(p:real^3->bool) f r.
3095     bounded p /\ polyhedron p /\ vec 0 IN interior p /\ f facet_of p ==>
3096     measurable ( fchanged f  INTER normball (vec 0) r)`,
3097   (* {{{ proof *)
3098   [
3099   REPEAT WEAK_STRIP_TAC;
3100   MATCH_MP_TAC Conforming.MEASURABLE_TOPOLOGICAL_COMPONENT_YFAN_INTER_BALL;
3101   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `vertices p`)));
3102   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `edges p`)));
3103   SUBCONJ_TAC;
3104     MATCH_MP_TAC Polyhedron.POLYHEDRON_FAN;
3105     BY(ASM_REWRITE_TAC[]);
3106   DISCH_TAC;
3107   SUBCONJ_TAC;
3108     MATCH_MP_TAC Conforming.PIIJBJK;
3109     ASM_REWRITE_TAC[];
3110     ROT_TAC;
3111     SUBCONJ_TAC;
3112       MATCH_MP_TAC Polyhedron.POLYTOPE_FAN80;
3113       BY(ASM_REWRITE_TAC[]);
3114     DISCH_TAC;
3115     BY(ASM_MESON_TAC [ Polyhedron.CARD_SET_OF_EDGE_INEQ_1_POLYHEDRON ]);
3116   DISCH_TAC;
3117   BY(ASM_MESON_TAC [ Polyhedron.FCHANGED_IN_COMPONENT ])
3118   ]);;
3119   (* }}} *)
3120
3121 let RADIAL_NORMBALL = prove_by_refinement(
3122   `!(p:real^3) r. (radial r p (normball p r))`,
3123   (* {{{ proof *)
3124   [
3125   REPEAT WEAK_STRIP_TAC;
3126   REWRITE_TAC[ Sphere.radial ];
3127   REWRITE_TAC[ NORMBALL_BALL ];
3128   REWRITE_TAC[ IN_BALL ];
3129   CONJ_TAC;
3130     BY(SET_TAC[]);
3131   REWRITE_TAC[ dist ];
3132   REWRITE_TAC[VECTOR_ARITH `(p - (p + u)) = (-- (u:real^3))`];
3133   REWRITE_TAC[ NORM_NEG ];
3134   REWRITE_TAC [ NORM_MUL ];
3135   BY(REAL_ARITH_TAC)
3136   ]);;
3137   (* }}} *)
3138
3139 let FCHANGED_RADIAL = prove_by_refinement(
3140   `!(p:real^3->bool) f r.
3141     bounded p /\ polyhedron p /\ vec 0 IN interior p /\ f facet_of p ==>
3142     radial r (vec 0) ( fchanged f INTER normball (vec 0) r)`,
3143   (* {{{ proof *)
3144   [
3145   REWRITE_TAC[ Sphere.radial ];
3146   REPEAT WEAK_STRIP_TAC;
3147   REWRITE_TAC[ NORMBALL_BALL ];
3148   REWRITE_TAC[VECTOR_ADD_RID;VECTOR_SUB_RZERO;VECTOR_ADD_LID;VECTOR_SUB_LZERO];
3149   CONJ_TAC;
3150     BY(SET_TAC[]);
3151   REPEAT WEAK_STRIP_TAC;
3152   FIRST_X_ASSUM_ST `fchanged` MP_TAC;
3153   REWRITE_TAC[IN_INTER];
3154   REWRITE_TAC[ Polyhedron.fchanged ];
3155   REWRITE_TAC[ IN_ELIM_THM ];
3156   REPEAT WEAK_STRIP_TAC;
3157   CONJ_TAC;
3158     TYPIFY `v1` EXISTS_TAC;
3159     ASM_REWRITE_TAC[];
3160     TYPIFY `t * t'` EXISTS_TAC;
3161     REWRITE_TAC [ VECTOR_MUL_ASSOC ];
3162     REPEAT (FIRST_X_ASSUM_ST `a > b` MP_TAC);
3163     REWRITE_TAC [arith `a > b <=> b < a`];
3164     BY(MESON_TAC[ REAL_LT_MUL ]);
3165   INTRO_TAC RADIAL_NORMBALL [`(vec 0):real^3`;`r`];
3166   REWRITE_TAC[ NORMBALL_BALL ];
3167   REWRITE_TAC[ Sphere.radial ];
3168   REWRITE_TAC[VECTOR_ADD_RID;VECTOR_SUB_RZERO;VECTOR_ADD_LID;VECTOR_SUB_LZERO];
3169   FIRST_X_ASSUM MP_TAC;
3170   REWRITE_TAC[ IN_BALL ];
3171   REWRITE_TAC[ dist ];
3172   REWRITE_TAC[VECTOR_ADD_RID;VECTOR_SUB_RZERO;VECTOR_ADD_LID;VECTOR_SUB_LZERO];
3173   REWRITE_TAC[ NORM_NEG ];
3174   BY(ASM_MESON_TAC[SUBSET])
3175 ]
3176 );;
3177
3178 let WEDGE_SPLIT = prove_by_refinement(
3179   `!u0 u1 u2 u3 w.
3180     ~(collinear {u0,u1,u2}) /\
3181     ~(collinear {u0,u1,u3}) /\
3182     w IN wedge u0 u1 u2 u3 ==>
3183    (     ~(collinear {u0,u1,w}) /\
3184    (wedge u0 u1 u2 w INTER wedge u0 u1 w u3 = {}) /\
3185     wedge u0 u1 u2 w SUBSET wedge u0 u1 u2 u3 /\
3186     wedge u0 u1 w u3 SUBSET wedge u0 u1 u2 u3)`,
3187   (* {{{ proof *)
3188   [
3189   REWRITE_TAC[ wedge ; EMPTY_NOT_EXISTS_IN ];
3190   REWRITE_TAC[ IN_ELIM_THM ; SUBSET ; IN_INTER];
3191   REPEAT WEAK_STRIP_TAC;
3192   ASM_REWRITE_TAC[];
3193   CONJ_TAC;
3194     REPEAT WEAK_STRIP_TAC;
3195     GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`u0`;`u1`;`u2`;`w`;`x`;`w`;`u3`]) AZIM_BASE_SHIFT_LT)));
3196     ASM_REWRITE_TAC[];
3197     REWRITE_TAC[ AZIM_REFL ];
3198     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
3199   CONJ_TAC;
3200     REPEAT WEAK_STRIP_TAC;
3201     ASM_REWRITE_TAC[];
3202     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
3203   REPEAT WEAK_STRIP_TAC;
3204   ASM_REWRITE_TAC[];
3205   GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`u0`;`u1`;`w`;`u2`;`w`;`x`;`u3`]) AZIM_BASE_SHIFT_LT)));
3206   ASM_REWRITE_TAC[ AZIM_REFL ];
3207   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
3208   ]);;
3209   (* }}} *)
3210
3211 let cone0_subset_lune = prove_by_refinement(
3212   `!u0 u1 u2 u3.  cone0 u0 {u1,u2,u3} SUBSET aff_gt { u0 , u1} { u2, u3}`,
3213   (* {{{ proof *)
3214   [
3215   REWRITE_TAC[ Sphere.aff_gt_def ;SUBSET ];
3216   REWRITE_TAC[ Sphere.cone0 ];
3217   REWRITE_TAC[ IN; affsign ];
3218   REPEAT GEN_TAC;
3219   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{u0 } UNION {u1,u2,u3} = {u0,u1,u2,u3}`) SUBST1_TAC));
3220     BY(SET_TAC[]);
3221   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{u0,u1 } UNION {u2,u3} = {u0,u1,u2,u3}`) SUBST1_TAC));
3222     BY(SET_TAC[]);
3223   REWRITE_TAC [ X_IN IN_INSERT ];
3224   BY(MESON_TAC[])
3225   ]);;
3226   (* }}} *)
3227
3228 let COLLINEAR_UNEQUAL = prove_by_refinement(
3229   `!u0 u1 (u2:real^N). ~collinear {u0,u1,u2} ==>
3230     ~(u2 IN {u0,u1}) /\ ~(u1 IN {u0})`,
3231   (* {{{ proof *)
3232   [
3233   REPEAT GEN_TAC;
3234   DISCH_TAC;
3235   REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY ];
3236   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{u0,u1,u2} = {u1,u2,u0}`) ASSUME_TAC));
3237     BY(SET_TAC[]);
3238   BY(ASM_MESON_TAC[ Collect_geom.NOT_COLLINEAR_IMP_2_UNEQUAL ])
3239   ]);;
3240   (* }}} *)
3241
3242 let HAS_SIZE_GE_2 = prove_by_refinement(
3243   `!(s:A->bool). FINITE s /\ CARD s > 1 ==> (!x. x IN s ==> (?y. y IN s /\ ~(y = x)))`,
3244   (* {{{ proof *)
3245   [
3246   REPEAT WEAK_STRIP_TAC;
3247   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(s HAS_SIZE 0) /\ ~(s HAS_SIZE 1)`) MP_TAC));
3248     REWRITE_TAC[HAS_SIZE];
3249     ASM_REWRITE_TAC[];
3250     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN ARITH_TAC);
3251   REWRITE_TAC[ HAS_SIZE_0 ];
3252   REWRITE_TAC[ HAS_SIZE_1_EXISTS ];
3253   FIRST_X_ASSUM MP_TAC;
3254   BY(SET_TAC[])
3255   ]);;
3256   (* }}} *)
3257
3258
3259 let TWO_IMP_HAS_SIZE_GE_2 = prove_by_refinement(
3260   `!(s:A->bool) x y. x IN s /\ y IN s /\ ~(x = y) /\ FINITE s ==> CARD s > 1`,
3261   (* {{{ proof *)
3262   [
3263   REPEAT WEAK_STRIP_TAC;
3264   GOAL_TERM (fun REWRITE_TAC -> (SUBGOAL_THEN ( env REWRITE_TAC `~(s HAS_SIZE 0) /\ ~(s HAS_SIZE 1)`) MP_TAC));
3265     REWRITE_TAC[ HAS_SIZE_0 ];
3266     REWRITE_TAC[ HAS_SIZE_1_EXISTS ];
3267     REPEAT( FIRST_X_ASSUM MP_TAC);
3268     BY(BY(SET_TAC[]));
3269   BY(ASM_MESON_TAC[HAS_SIZE; arith `~(n=0) /\ ~(n=1) ==> (n >1)`])
3270   ]);;
3271   (* }}} *)
3272
3273 let AFF_GT_RELATIVE_INTERIOR = prove_by_refinement(
3274   `!(s:real^N->bool). FINITE s /\ CARD s > 1
3275      ==> aff_gt {} s SUBSET relative_interior (convex hull s)`,
3276   (* {{{ proof *)
3277   [
3278   REPEAT WEAK_STRIP_TAC;
3279   FIRST_ASSUM (fun t -> (MP_TAC (MATCH_MP EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL t)));
3280   DISCH_TAC;
3281   MATCH_MP_TAC SUBSET_TRANS;
3282   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `{y | ?u. (!x. x IN s ==> &0 < u x /\ u x < &1) /\                sum s u = &1 /\               vsum s (\x. u x % x) = y}` )));
3283   ASM_REWRITE_TAC[];
3284   REWRITE_TAC[Sphere.aff_gt_def;AFFSIGN];
3285   REWRITE_TAC[ IN_ELIM_THM; SUBSET ;IN_INSERT ; UNION_EMPTY ];
3286   REWRITE_TAC[ sgn_gt ];
3287   REPEAT WEAK_STRIP_TAC;
3288   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `f`)));
3289   ASM_REWRITE_TAC[];
3290   REPEAT WEAK_STRIP_TAC;
3291   ASM_SIMP_TAC[];
3292   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?y. y IN s /\ ~(y = x')`) MP_TAC));
3293     BY(ASM_MESON_TAC [ HAS_SIZE_GE_2 ]);
3294   REPEAT WEAK_STRIP_TAC;
3295   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(sum {y,x'} f <= sum s f )`) ASSUME_TAC));
3296     MATCH_MP_TAC SUM_SUBSET_SIMPLE;
3297     ASM_REWRITE_TAC[];
3298     CONJ_TAC;
3299       REPEAT (FIRST_X_ASSUM_ST `IN` MP_TAC);
3300 (*       ALL_SEARCH [`IN`];  Feb 3, 2013 *)
3301       BY(SET_TAC[]);
3302     REWRITE_TAC[IN_DIFF];
3303     BY(ASM_MESON_TAC[ arith `&0 < a ==> &0 <= a`]);
3304   FIRST_X_ASSUM MP_TAC;
3305   ASM_REWRITE_TAC[];
3306   ASM_SIMP_TAC[ Upfzbzm_support_lemmas.SUM_SET_OF_2_ELEMENTS ];
3307   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `&0 < f y`) MP_TAC));
3308     BY(ASM_SIMP_TAC[]);
3309   BY(REAL_ARITH_TAC)
3310   ]);;
3311   (* }}} *)
3312
3313 let NOT_COLLINEAR_AFF_DIM_2 = prove_by_refinement(
3314   `!u0 u1 (u2:real^N). ~collinear{u0,u1,u2} ==> aff_dim {u0,u1,u2}= &2`,
3315   (* {{{ proof *)
3316   [
3317   REPEAT WEAK_STRIP_TAC;
3318   ONCE_REWRITE_TAC[ AFF_DIM_INSERT ];
3319   REWRITE_TAC[ AFF_DIM_2 ];
3320   BY(ASM_MESON_TAC[ Collect_geom.IN_AFFINE_HULL_IMP_COLLINEAR ; arith `(&1 + &1 = (&2):int)`; COLLINEAR_UNEQUAL; IN_INSERT])
3321   ]);;
3322   (* }}} *)
3323
3324 let FACET_AFF_DIM_2 = prove_by_refinement(
3325   `!(p:real^3->bool) f .
3326      polyhedron p /\  (vec 0 IN interior p) /\
3327     f facet_of p
3328     ==> aff_dim f = &2 `,
3329   (* {{{ proof *)
3330   [
3331   REPEAT WEAK_STRIP_TAC;
3332   FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP (Polyhedron.AFF_DIM_INTERIOR_EQ_3) t));
3333   BY(BY(ASM_MESON_TAC[ facet_of ; arith `&3 - &1 = (&2):int` ;arith `(x:int <= x)`]))
3334 ]
3335 );;
3336   (* }}} *)
3337
3338 let CONE0_RELATIVE_INTERIOR_FACET = prove_by_refinement(
3339   `!p f (u0:real^3) u1 u2.
3340      polyhedron p /\ bounded p /\ (vec 0 IN interior p) /\
3341     f facet_of p /\ ~(collinear {u0,u1,u2}) /\
3342     {u0,u1,u2} SUBSET f  ==>
3343     aff_gt {}  {u0,u1,u2} SUBSET relative_interior f
3344 `,
3345   (* {{{ proof *)
3346   [
3347   REPEAT WEAK_STRIP_TAC;
3348   MATCH_MP_TAC SUBSET_TRANS;
3349   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `relative_interior (convex hull {u0,u1,u2})`)));
3350   CONJ_TAC;
3351     MATCH_MP_TAC AFF_GT_RELATIVE_INTERIOR;
3352     SUBCONJ_TAC;
3353       BY(REWRITE_TAC[ FINITE_INSERT; FINITE_EMPTY ]);
3354     DISCH_TAC;
3355     MATCH_MP_TAC TWO_IMP_HAS_SIZE_GE_2;
3356     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `u0`)));
3357     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `u1`)));
3358     ASM_REWRITE_TAC[ IN_INSERT ];
3359     BY(BY(ASM_MESON_TAC[ Collect_geom.NOT_COLLINEAR_IMP_2_UNEQUAL ]));
3360   MATCH_MP_TAC SUBSET_RELATIVE_INTERIOR;
3361   CONJ_TAC;
3362     BY(ASM_MESON_TAC[ FACE_OF_IMP_CONVEX; Marchal_cells.CONVEX_HULL_SUBSET; CONVEX_HULL_EQ ; facet_of ]);
3363   MATCH_MP_TAC AFF_DIM_EQ_AFFINE_HULL;
3364   SUBCONJ_TAC;
3365     BY(ASM_MESON_TAC[ FACE_OF_IMP_CONVEX; Marchal_cells.CONVEX_HULL_SUBSET; CONVEX_HULL_EQ ; facet_of ]);
3366   DISCH_TAC;
3367   MATCH_MP_TAC (arith ` (a <= &2 /\ &2 <= c ==> (a:int) <= c)`);
3368   CONJ_TAC;
3369     FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP (Polyhedron.AFF_DIM_INTERIOR_EQ_3) t));
3370     BY(ASM_MESON_TAC[ facet_of ; arith `&3 - &1 = (&2):int` ;arith `(x:int <= x)`]);
3371   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{u0,u1,u2} SUBSET convex hull {u0,u1,u2}`) ASSUME_TAC));
3372     BY(REWRITE_TAC[ Ldurdpn.SUBSET_P_HULL ]);
3373   FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP (AFF_DIM_SUBSET) t));
3374   MATCH_MP_TAC (arith `!b. (a:int) <= b /\ b <= c ==> (a <=c)`);
3375   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `aff_dim {u0,u1,u2}`)));
3376   ASM_REWRITE_TAC[];
3377   BY(ASM_MESON_TAC [ NOT_COLLINEAR_AFF_DIM_2 ; arith `(x:int <= x)`])
3378   ]);;
3379   (* }}} *)
3380
3381
3382 let CONE0_FCHANGED_AFF_GT = prove_by_refinement(
3383   `!(s:real^N->bool). FINITE s /\ CARD s > 1 /\ ~(vec 0 IN s)
3384     ==>
3385    cone0 (vec 0) s SUBSET fchanged (convex hull s)`,
3386   (* {{{ proof *)
3387   [
3388   REPEAT WEAK_STRIP_TAC;
3389   REWRITE_TAC[ Sphere.cone0 ];
3390   REWRITE_TAC[ Polyhedron.fchanged ];
3391   REWRITE_TAC[ SUBSET; IN_ELIM_THM ];
3392   REWRITE_TAC[AFFSIGN];
3393   REWRITE_TAC[ IN_ELIM_THM ; sgn_gt];
3394   REPEAT WEAK_STRIP_TAC;
3395   TYPED_ABBREV_TAC  `(a:real) = f (vec 0)`;
3396   TYPED_ABBREV_TAC `(v1:real^N) = vsum s (\v. (f v / (&1 - a)) % v)`;
3397   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `v1`)));
3398   EXISTS_TAC (`&1 - a`);
3399   SUBGOAL_THEN `&1 - a > &0` ASSUME_TAC;
3400     REWRITE_TAC[ arith `&1 - a > &0 <=> ~(&1 <= a)`];
3401     DISCH_TAC;
3402     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`~(s HAS_SIZE 0)`) MP_TAC));
3403       BY(ASM_MESON_TAC[ HAS_SIZE; arith `x > 1 ==> ~(x = 0)`]);
3404     REWRITE_TAC[ HAS_SIZE_0 ];
3405     REWRITE_TAC[ EMPTY_NOT_EXISTS_IN ];
3406     REPEAT WEAK_STRIP_TAC;
3407     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `sum {x',vec 0} f <= sum ({vec 0 } UNION s) f`) MP_TAC));
3408       MATCH_MP_TAC SUM_SUBSET_SIMPLE;
3409       SUBCONJ_TAC;
3410         BY(ASM_REWRITE_TAC[ FINITE_UNION ;FINITE_INSERT; FINITE_EMPTY]);
3411       DISCH_TAC;
3412       SUBCONJ_TAC;
3413         REPEAT (FIRST_X_ASSUM_ST `IN` MP_TAC);
3414 (*        ALL_SEARCH [`IN`]; Feb 3, 2013 *)
3415         BY(SET_TAC[]);
3416       DISCH_TAC;
3417       REPEAT WEAK_STRIP_TAC;
3418       MATCH_MP_TAC (arith `&0 < x ==> &0 <= x`);
3419       FIRST_X_ASSUM MATCH_MP_TAC;
3420       FIRST_X_ASSUM MP_TAC;
3421       BY(SET_TAC[]);
3422     ASM_REWRITE_TAC[];
3423     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`~(x' = vec 0)`) ASSUME_TAC));
3424       BY(ASM_MESON_TAC[]);
3425     ASM_SIMP_TAC[ Upfzbzm_support_lemmas.SUM_SET_OF_2_ELEMENTS ];
3426     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `&0 < f x'`) MP_TAC));
3427       BY(ASM_MESON_TAC[]);
3428     REPEAT (FIRST_X_ASSUM_ST `<=` MP_TAC);
3429 (*    ALL_SEARCH [`<=`]; Feb 3, 2013 *)
3430     BY(REAL_ARITH_TAC);
3431   ASM_REWRITE_TAC[];
3432   SUBCONJ_TAC;
3433     EXPAND_TAC "v1";
3434     REWRITE_TAC[ GSYM VSUM_LMUL ];
3435     REWRITE_TAC[ VECTOR_MUL_ASSOC ];
3436     SUBGOAL_THEN `!u. (&1 - a) * u/(&1- a) = u` (fun t-> REWRITE_TAC[t]);
3437       GEN_TAC;
3438       CALC_ID_TAC;
3439       FIRST_X_ASSUM MP_TAC;
3440       BY(REAL_ARITH_TAC);
3441     REWRITE_TAC[ Packing3.SING_UNION_EQ_INSERT ];
3442     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `vsum (vec 0 INSERT s) (\v. f v % v) = f (vec 0) % (vec 0) + vsum s (\v. f v % v)`) SUBST1_TAC));
3443       BY(ASM_MESON_TAC[ Marchal_cells_2_new.VSUM_CLAUSES_alt ]);
3444     REWRITE_TAC[ VECTOR_MUL_RZERO ];
3445     BY(REWRITE_TAC[VECTOR_ADD_RID;VECTOR_SUB_RZERO;VECTOR_ADD_LID;VECTOR_SUB_LZERO]);
3446   DISCH_TAC;
3447   GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `v1 IN aff_gt {} s`)));
3448     GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `aff_gt {} s SUBSET relative_interior (convex hull s)`)));
3449       BY(SET_TAC[]);
3450     MATCH_MP_TAC AFF_GT_RELATIVE_INTERIOR;
3451     BY(ASM_REWRITE_TAC[]);
3452   REWRITE_TAC[ aff_gt_def ; AFFSIGN ];
3453   REWRITE_TAC[ UNION_EMPTY ; sgn_gt ];
3454   REWRITE_TAC[ IN_ELIM_THM ];
3455   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `\v. f v / (&1 - a)`)));
3456   BETA_TAC;
3457   ASM_REWRITE_TAC[];
3458   SUBCONJ_TAC;
3459     REPEAT WEAK_STRIP_TAC;
3460     REWRITE_TAC[ Calc_derivative.invert_den_lt ];
3461     MATCH_MP_TAC REAL_LT_MUL;
3462     CONJ_TAC;
3463       BY(ASM_MESON_TAC[]);
3464     REPEAT (FIRST_X_ASSUM_ST `>` MP_TAC);
3465 (*    ALL_SEARCH [`>`]; *)
3466     BY(REAL_ARITH_TAC);
3467   DISCH_TAC;
3468   REPEAT (FIRST_X_ASSUM_ST `sum` MP_TAC);
3469 (*  ALL_SEARCH [`sum`]; *)
3470   REWRITE_TAC[ Packing3.SING_UNION_EQ_INSERT ];
3471   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `sum (vec 0 INSERT s) f = f (vec 0) + sum s f`) SUBST1_TAC));
3472     BY(ASM_MESON_TAC[ SUM_CLAUSES ]);
3473   REWRITE_TAC[ real_div ];
3474   REWRITE_TAC[ SUM_RMUL ];
3475   ASM_REWRITE_TAC[];
3476   REWRITE_TAC [arith `a + b = c <=> b = c - a`];
3477   DISCH_THEN SUBST1_TAC;
3478   CALC_ID_TAC;
3479   REPEAT (FIRST_X_ASSUM_ST `>` MP_TAC);
3480 (*  ALL_SEARCH [`>`]; *)
3481   BY(REAL_ARITH_TAC)
3482   ]);;
3483   (* }}} *)
3484
3485 let CONE0_FCHANGED = prove_by_refinement(
3486   `!p f (u0:real^3) u1 u2.
3487     polyhedron p /\ bounded p /\ (vec 0 IN interior p) /\
3488     f facet_of p /\ ~(collinear {u0,u1,u2}) /\
3489     {u0,u1,u2} SUBSET f  ==>
3490     cone0 (vec 0) {u0,u1,u2} SUBSET fchanged f`,
3491   (* {{{ proof *)
3492   [
3493   REPEAT WEAK_STRIP_TAC;
3494   MATCH_MP_TAC SUBSET_TRANS;
3495   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `fchanged (convex hull {u0,u1,u2})`)));
3496   SUBCONJ_TAC;
3497     MATCH_MP_TAC CONE0_FCHANGED_AFF_GT;
3498     SUBCONJ_TAC;
3499       BY(REWRITE_TAC[ FINITE_INSERT; FINITE_EMPTY ]);
3500     DISCH_TAC;
3501     SUBCONJ_TAC;
3502       BY(ASM_MESON_TAC[ COLLINEAR_UNEQUAL; TWO_IMP_HAS_SIZE_GE_2; IN_INSERT ]);
3503     DISCH_TAC;
3504     GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `~(vec 0 IN f)`)));
3505       REPEAT (FIRST_X_ASSUM_ST `SUBSET` MP_TAC);
3506 (*      ALL_SEARCH [`SUBSET`]; *)
3507       BY(SET_TAC[]);
3508     BY(ASM_MESON_TAC [ FACE_OF_DISJOINT_INTERIOR ; Hypermap.lemma_in_disjoint ; facet_of ; arith `~(x = x - (&1):int)`]);
3509   DISCH_TAC;
3510   REWRITE_TAC[ Polyhedron.fchanged ];
3511   REWRITE_TAC[ SUBSET ; IN_ELIM_THM ];
3512   REPEAT WEAK_STRIP_TAC;
3513   GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w`relative_interior (convex hull {u0,u1,u2}) SUBSET relative_interior f`)));
3514     REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC);
3515     BY(SET_TAC[]);
3516   MATCH_MP_TAC SUBSET_RELATIVE_INTERIOR;
3517   SUBCONJ_TAC;
3518     BY(BY(ASM_MESON_TAC[ FACE_OF_IMP_CONVEX; Marchal_cells.CONVEX_HULL_SUBSET; CONVEX_HULL_EQ ; facet_of ]));
3519   DISCH_TAC;
3520   MATCH_MP_TAC AFF_DIM_EQ_AFFINE_HULL;
3521   ASM_REWRITE_TAC[];
3522   MATCH_MP_TAC (arith `a = &2 /\ b = &2 ==> (a:int) <= b`);
3523   CONJ_TAC;
3524     BY(ASM_MESON_TAC[ FACET_AFF_DIM_2]);
3525   BY(ASM_MESON_TAC[ AFF_DIM_CONVEX_HULL; NOT_COLLINEAR_AFF_DIM_2 ])
3526   ]);;
3527   (* }}} *)
3528
3529 let COLLINEAR_ORTHO_PLANE = prove_by_refinement(
3530   `!p v u0 b (u1:real^N).
3531     ~(v = vec 0) /\
3532     ~(u0 = u1) /\
3533     u0 dot v = b /\
3534     p dot v = b /\
3535     (u1 = u0 + v) /\
3536     collinear {u0,u1,p } ==>
3537     (p = u0)`,
3538   (* {{{ proof *)
3539   [
3540   REPEAT WEAK_STRIP_TAC;
3541   REPEAT (FIRST_X_ASSUM_ST `collinear` MP_TAC);
3542 (*  ALL_SEARCH [`collinear`]; *)
3543   ASM_SIMP_TAC [ COLLINEAR_3_AFFINE_HULL ];
3544   REWRITE_TAC [ AFFINE_HULL_2_ALT ];
3545   REWRITE_TAC[ IN_ELIM_THM ; IN_UNIV];
3546   SUBST1_TAC ( VECTOR_ARITH ( `(u0 + (v:real^N) ) - u0 = v`));
3547   REPEAT WEAK_STRIP_TAC;
3548   REPEAT (FIRST_X_ASSUM_ST `dot` MP_TAC);
3549 (*  ALL_SEARCH [`dot`]; *)
3550   ASM_REWRITE_TAC[];
3551   GOAL_TERM (fun t -> (REWRITE_TAC[ VECTOR_ARITH ( env t`(u0 + u % (v)) dot v = u0 dot v + u * (v dot v)`)]));
3552   DISCH_THEN SUBST1_TAC;
3553   GOAL_TERM (fun t -> (REWRITE_TAC[ VECTOR_ARITH ( env t` (u0 + u % v = u0) <=> u % v = vec 0`); arith `b + c = b <=> c = &0`;REAL_ENTIRE; VECTOR_MUL_EQ_0 ]));
3554   BY(REWRITE_TAC[ DOT_EQ_0 ])
3555   ]);;
3556   (* }}} *)
3557
3558 let collinear_translate_axis = prove_by_refinement(
3559   `!t u1 u2. collinear {t % u1,u1,u2} <=> collinear {vec 0 ,u1- t % u1, (u2:real^3)}`,
3560   (* {{{ proof *)
3561   [
3562   REPEAT WEAK_STRIP_TAC;
3563   ONCE_REWRITE_TAC[Trigonometry2.COLLINEAR_TRANSABLE];
3564   REWRITE_TAC[arith `(v:real^3) - vec 0 = v`;arith `(u1:real^3) - t % u1 = (&1- t) % u1`];
3565   ONCE_REWRITE_TAC[Local_lemmas.COLL_IFF_COLL_CROSS];
3566   SUBGOAL_THEN `(&1 - t) % u1 cross (u2 - t % u1) = (&1 - t) % u1 cross u2` SUBST1_TAC;
3567     REWRITE_TAC[arith `x - (y:real^3) = x + (-- &1) % y`;CROSS_RADD;CROSS_LMUL;CROSS_RMUL;CROSS_REFL;VECTOR_MUL_RZERO];
3568     BY(VECTOR_ARITH_TAC);
3569   BY(REWRITE_TAC[])
3570   ]);;
3571   (* }}} *)
3572
3573 let azim_axis = prove_by_refinement(
3574   `!t u1 u w.
3575     ~(collinear {t % u1,u1,u}) /\
3576     ~(collinear {t % u1,u1,w}) ==>
3577     azim (t % u1) u1 u w = azim (vec 0) (u1-t % u1) u w`,
3578   (* {{{ proof *)
3579   [
3580   REPEAT WEAK_STRIP_TAC;
3581   MP_TAC (arith `(t % u1) = (t % u1) + vec 0 /\ (u1 =   (t % u1)+ (u1- t % u1)) /\ (u:real^3) =   (t % u1) + (u - t % u1)/\ w =   (t % u1) + (w - t % u1)`);
3582   DISCH_THEN (fun t -> ONCE_REWRITE_TAC[t]);
3583   REWRITE_TAC[AZIM_TRANSLATION];
3584   ONCE_REWRITE_TAC[arith ` ((t % u1 + u1 - t % u1) - (t % (u1:real^3) + vec 0)) = (u1 - t % u1)`];
3585   SUBGOAL_THEN `~(t = &1)` ASSUME_TAC;
3586     DISCH_TAC;
3587     FIRST_X_ASSUM_ST `collinear` MP_TAC;
3588     ASM_REWRITE_TAC[];
3589     ONCE_REWRITE_TAC[arith `&1 % (v:real^3) = v`];
3590     SUBGOAL_THEN `{u1,u1,w} = {u1,(w:real^3)}` SUBST1_TAC;
3591       BY(SET_TAC[]);
3592     BY(REWRITE_TAC[COLLINEAR_2]);
3593   SUBGOAL_THEN `!y. y - t % (u1:real^3) = (t/(&1 - t)) % (vec 0) + (t/ (t - &1)) % (u1 - t % u1) + (&1 % y)` ASSUME_TAC;
3594     GEN_TAC;
3595     ONCE_REWRITE_TAC[arith ` ((u:real^3) = v) <=> (u - v = vec 0)`];
3596     REWRITE_TAC [arith `t % vec 0 = (vec 0):real^3`];
3597     REWRITE_TAC [arith `y - t % u1 - (vec 0 + t / (t - &1) % (u1 - t % u1) + &1 % y) = (-- t - (t/(t- &1) * (&1-t))) % (u1:real^3)`];
3598     REWRITE_TAC[VECTOR_MUL_EQ_0];
3599     DISJ1_TAC;
3600     Calc_derivative.CALC_ID_TAC;
3601     BY(FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC);
3602   REWRITE_TAC[arith `x + y - x = (y:real^3)`];
3603   SUBGOAL_THEN `t/ (&1 - t) + t/(t - &1) + &1 = &1` ASSUME_TAC;
3604     Calc_derivative.CALC_ID_TAC;
3605     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
3606   SUBGOAL_THEN `azim (vec 0) (u1 - t % u1) (u - t % u1) (w - t % u1) = azim (vec 0) (u1 - t % u1) (u - t % u1) w` SUBST1_TAC;
3607     FIRST_X_ASSUM (fun t -> ASSUME_TAC(ISPEC `w:real^3` t));
3608     FIRST_X_ASSUM (SUBST1_TAC);
3609     MATCH_MP_TAC (GSYM Topology.th1);
3610     ASM_REWRITE_TAC[];
3611     CONJ_TAC;
3612       BY(REAL_ARITH_TAC);
3613     SUBGOAL_THEN `~collinear {vec 0, u1 - t % (u1:real^3), w}` ASSUME_TAC;
3614       BY(ASM_MESON_TAC[collinear_translate_axis]);
3615     CONJ_TAC;
3616       MATCH_MP_TAC Fan.th3a;
3617       BY(ASM_REWRITE_TAC[]);
3618     CONJ_TAC;
3619       BY(ASM_MESON_TAC[Trigonometry2.COLLINEAR_TRANSABLE]);
3620     BY(ASM_REWRITE_TAC[]);
3621   ONCE_REWRITE_TAC[Rogers.AZIM_EQ_SYM];
3622   FIRST_X_ASSUM (fun t -> ASSUME_TAC(ISPEC `u:real^3` t));
3623   FIRST_X_ASSUM (SUBST1_TAC);
3624   MATCH_MP_TAC (GSYM Topology.th1);
3625   ASM_REWRITE_TAC[];
3626   CONJ_TAC;
3627     BY(REAL_ARITH_TAC);
3628   SUBGOAL_THEN `~collinear {vec 0, u1 - t % (u1:real^3), u}` ASSUME_TAC;
3629     BY(ASM_MESON_TAC[collinear_translate_axis]);
3630   CONJ_TAC;
3631     MATCH_MP_TAC Fan.th3a;
3632     BY(ASM_REWRITE_TAC[]);
3633   BY(ASM_MESON_TAC[collinear_translate_axis])
3634   ]);;
3635   (* }}} *)
3636
3637 let EUSOTYP2_general = prove_by_refinement(
3638   `!P c3 A n s t u v b.
3639     polyhedron P /\ bounded P /\ (vec 0) IN interior P /\
3640     c3 facet_of P /\
3641     c3 SUBSET A /\
3642     ( P INTER A = c3 ) /\
3643     A = {p | p dot v = b} /\
3644     s = { c | c facet_of c3 } /\
3645     s HAS_SIZE n /\
3646     &0 < b /\
3647     (&0 < t ) /\ (t < &1) /\
3648     ~(collinear {vec 0,v,u}) /\
3649     (rcone_gt (vec 0) v t SUBSET fchanged c3) /\
3650    (rcone_gt (vec 0) v t INTER A SUBSET c3) ==>
3651     (?g h.
3652        (!i. i IN 1..n ==> ((g i ) IN c3) /\ cos (arcV (vec 0) v (g i)) = t) /\
3653        (g (n+1) = g 1) /\
3654        (!i. i IN 1..n ==> ((h i) IN c3)) /\
3655        (!j k. j IN 1..n /\ k IN 1..n /\ (j < k) ==>
3656           azim (vec 0) v u (g j) < azim (vec 0) v u (g k)) /\
3657        (!i. i IN 1..n  ==>
3658            azim (vec 0) v (g i) (h i) = (azim (vec 0) v (g i) (g (i+1)))/ &2  /\
3659             azim (vec 0) v (h i) (g (i+1)) = (azim (vec 0) v (g i) (g (i+1)))/ &2) /\
3660       (!i. i IN 1..n ==>
3661          ((h i - g i) dot v = &0 /\ (h i - g (i+1)) dot v = &0 /\ (h i - g i) dot g i = &0 /\
3662         (h i - g (i+1)) dot g (i+1) = &0)) /\
3663       (1 < n) /\
3664      (!i. i IN 1..n ==> ~(collinear{vec 0, v, g i}))  /\
3665      (!i. i IN 1..n ==> ~(collinear{vec 0,v, h i})) /\
3666       (!i. (i IN 1..n ==> azim (vec 0) v (g i) (g (i+1)) < pi))
3667       )`,
3668   (* {{{ proof *)
3669   [
3670   REPEAT WEAK_STRIP_TAC;
3671   TYPED_ABBREV_TAC `u0 = (b / (v dot v)) % (v:real^3)`;
3672   TYPED_ABBREV_TAC `u1 = u0 + (v:real^3)`;
3673   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(v = vec 0)`) ASSUME_TAC));
3674     DISCH_TAC;
3675     FIRST_X_ASSUM_ST `collinear` MP_TAC;
3676     ASM_REWRITE_TAC[];
3677     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`{vec 0 ,vec 0 ,u} = {vec 0,u}`) SUBST1_TAC));
3678       BY(SET_TAC[]);
3679     BY(REWRITE_TAC[COLLINEAR_2]);
3680   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `&0 < v dot v`) ASSUME_TAC));
3681     BY(ASM_REWRITE_TAC[DOT_POS_LT]);
3682   GOAL_TERM (fun w -> (MP_TAC (ISPECL (  envl w[`v`;`u0`;`b`;`t`]) RDISK_R)));
3683   ANTS_TAC;
3684     BY(ASM_MESON_TAC[]);
3685   REPEAT WEAK_STRIP_TAC;
3686   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?a. u + a % v IN A`) MP_TAC));
3687     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `(b - u dot v)/(v dot v)`)));
3688     ASM_REWRITE_TAC[IN_ELIM_THM];
3689     REWRITE_TAC[DOT_LADD;DOT_LMUL];
3690     Calc_derivative.CALC_ID_TAC;
3691     BY(FIRST_X_ASSUM_ST `&0 < v dot (v:real^3)` MP_TAC THEN REAL_ARITH_TAC);
3692   REPEAT WEAK_STRIP_TAC;
3693   TYPED_ABBREV_TAC ( `u2 = (u:real^3) + a % v`);
3694   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(u0 = u2)`) ASSUME_TAC));
3695     EXPAND_TAC "u2";
3696     DISCH_TAC;
3697     FIRST_X_ASSUM_ST `collinear` MP_TAC;
3698     REWRITE_TAC[];
3699     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`?b'. u = b' % v`) MP_TAC));
3700       GOAL_TERM (fun w -> (EXISTS_TAC ( env w`(b / (v dot v) - a)`)));
3701       FIRST_X_ASSUM MP_TAC;
3702       EXPAND_TAC "u0";
3703       BY(VECTOR_ARITH_TAC);
3704     REPEAT WEAK_STRIP_TAC;
3705     ASM_REWRITE_TAC[];
3706     REWRITE_TAC[ (COLLINEAR_LEMMA_ALT) ];
3707     BY(MESON_TAC[]);
3708   GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w[`c3`;`A`;`n`;`{c | c facet_of c3}`;`r`;`u0`;`u1`;`u2`]) EUSOTYP_general)));
3709   ASM_REWRITE_TAC[];
3710   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `polyhedron c3`) ASSUME_TAC));
3711     BY(ASM_MESON_TAC[ FACET_OF_IMP_FACE_OF ; FACE_OF_POLYHEDRON_POLYHEDRON ]);
3712   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `bounded c3`) ASSUME_TAC));
3713     BY(ASM_MESON_TAC[ FACE_OF_IMP_SUBSET ; BOUNDED_SUBSET ; FACET_OF_IMP_FACE_OF ]);
3714   ASM_REWRITE_TAC[];
3715   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(u1 = u0)`) ASSUME_TAC));
3716     EXPAND_TAC "u1";
3717     FIRST_X_ASSUM_ST `(v = vec 0)` MP_TAC;
3718     GOAL_TERM (fun w -> (ONCE_REWRITE_TAC [varith ( env w `u0 + v = u0 <=> v = vec 0`)]));
3719     BY(REWRITE_TAC[]);
3720   ASM_REWRITE_TAC[];
3721   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{c | c facet_of c3} HAS_SIZE n`) (fun t -> REWRITE_TAC[t])));
3722     BY(ASM_MESON_TAC[]);
3723   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w ` (!p. dist (p,u0) < r /\ p IN {p | p dot v = b} ==> p IN c3)`) (fun t-> REWRITE_TAC[t])));
3724     GEN_TAC;
3725     REWRITE_TAC[IN_ELIM_THM];
3726     REPEAT WEAK_STRIP_TAC;
3727     GOAL_TERM (fun w -> (FIRST_X_ASSUM_ST `rcone_gt` (MP_TAC o (ISPEC ( env w`p`)))));
3728     ASM_REWRITE_TAC[];
3729     FIRST_X_ASSUM_ST `rcone_gt` (MP_TAC);
3730     ASM_REWRITE_TAC[INTER;SUBSET;IN_ELIM_THM];
3731     BY(ASM_MESON_TAC[]);
3732   SUBGOAL_THEN `(u0:real^3) IN rcone_gt (vec 0) v t` ASSUME_TAC;
3733     REWRITE_TAC[rcone_gt ; rconesgn ; IN_ELIM_THM ; VECTOR_SUB_RZERO ; DIST_0 ];
3734     EXPAND_TAC "u0";
3735     REWRITE_TAC[ DOT_LMUL ];
3736     REWRITE_TAC[ NORM_MUL ];
3737     REWRITE_TAC[ GSYM NORM_POW_2 ];
3738     REWRITE_TAC[ arith `x pow 2 = x * x`];
3739     REWRITE_TAC[ arith `x > y <=> y < x`];
3740     (fun gl -> (SUBGOAL_THEN ( env gl`abs (b / (norm v * norm v)) = b / (norm v * norm v)`) SUBST1_TAC) gl);
3741       MATCH_MP_TAC Trigonometry2.LT_IMP_ABS_REFL;
3742       MATCH_MP_TAC REAL_LT_DIV;
3743       BY((ASM_MESON_TAC [ NORM_POW_2 ; arith `x pow 2 = x * x` ]));
3744     REWRITE_TAC[ arith `(a * b) * c = a * (b * c)`];
3745     REWRITE_TAC[ arith `x * x = x pow 2`; NORM_POW_2 ; arith `a * b * c * d = a * (b * c) * d`];
3746     MATCH_MP_TAC REAL_LT_LMUL;
3747     CONJ_TAC;
3748       BY((ASM_MESON_TAC [ REAL_LT_DIV ]));
3749     REWRITE_TAC[ arith `a * t < a <=> &0 < a * (&1 - t)`];
3750     BY((ASM_MESON_TAC [ REAL_LT_MUL ; arith `t < &1 <=> &0 < &1 - t`]));
3751   COMMENT "u0";
3752   SUBGOAL_THEN `(u0:real^3) IN c3` ASSUME_TAC;
3753     ENOUGH_TO_SHOW_TAC `(u0:real^3) IN fchanged c3 /\ (u0 IN affine hull c3)`;
3754       REWRITE_TAC[ GSYM IN_INTER];
3755       BY((ASM_MESON_TAC[FCHANGED_AFFINE; SUBSET; IN; RELATIVE_INTERIOR_SUBSET ]));
3756     CONJ_TAC;
3757       BY((ASM_MESON_TAC[SUBSET; IN]));
3758     GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w[`P`;`c3`;`v`;`b`]) affine_facet_hyper )));
3759     ANTS_TAC;
3760       ASM_REWRITE_TAC[];
3761       CONJ_TAC;
3762         MATCH_MP_TAC Polyhedron.INTERIOR_AFFINIE_HUL_EQ_UNIV;
3763         BY((ASM_MESON_TAC[]));
3764       EXPAND_TAC "c3";
3765       AP_TERM_TAC;
3766       ASM_REWRITE_TAC[];
3767       MATCH_MP_TAC EQ_EXT;
3768       REWRITE_TAC[ IN_ELIM_THM ];
3769       BY((MESON_TAC[ DOT_SYM ]));
3770     DISCH_THEN SUBST1_TAC;
3771     REWRITE_TAC[ IN_ELIM_THM ];
3772     EXPAND_TAC "u0";
3773     REWRITE_TAC [ DOT_RMUL ];
3774     CALC_ID_TAC;
3775     BY((REPEAT (FIRST_X_ASSUM MP_TAC ) THEN REAL_ARITH_TAC));
3776   ASM_REWRITE_TAC[];
3777   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!v'. v' IN A <=> (v' - u0) dot v = &0`) ASSUME_TAC));
3778     ASM_REWRITE_TAC[IN;IN_ELIM_THM];
3779     EXPAND_TAC "u0";
3780     REWRITE_TAC[varith `v' - c % (v:real^3) = v' + (-- c) % v`;DOT_LMUL; DOT_LADD ];
3781     GEN_TAC;
3782     SUBGOAL_THEN ` -- (b / (v dot (v:real^3))) * (v dot v) = -- b` SUBST1_TAC;
3783       Calc_derivative.CALC_ID_TAC;
3784       BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
3785     BY(REAL_ARITH_TAC);
3786   ANTS_TAC;
3787     EXPAND_TAC "u1";
3788     GEN_TAC;
3789     REWRITE_TAC[ varith ( `(u0 + (v:real^3)) - u0 = v`)];
3790     BY(ASM_MESON_TAC[]);
3791   COMMENT "all anticedents established, ready to choose g, h";
3792   REPEAT WEAK_STRIP_TAC;
3793   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `g`)));
3794   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `h`)));
3795   ASM_REWRITE_TAC[];
3796   SUBGOAL_THEN `!(w:real^3). w IN A ==> (w dot v = b)` ASSUME_TAC;
3797     GEN_TAC;
3798     FIRST_X_ASSUM_ST `A = {p | p dot v = b}` SUBST1_TAC;
3799     BY(REWRITE_TAC[IN;IN_ELIM_THM]);
3800   SUBGOAL_THEN `!(w:real^3). w IN c3 ==> w IN A` ASSUME_TAC;
3801     EXPAND_TAC "c3";
3802     REWRITE_TAC[IN;INTER;IN_ELIM_THM];
3803     BY(MESON_TAC[]);
3804   SUBCONJ_TAC;
3805     GEN_TAC;
3806     DISCH_TAC;
3807     SUBCONJ_TAC;
3808       BY(ASM_MESON_TAC[]);
3809     DISCH_TAC;
3810     FIRST_X_ASSUM_ST `arcV` MP_TAC;
3811     ONCE_REWRITE_TAC[ Trigonometry2.ARC_SYM ];
3812     GOAL_TERM (fun w -> (DISCH_THEN (MP_TAC o (ISPEC ( env w `g i`)))));
3813     ANTS_TAC;
3814       BY(ASM_MESON_TAC[]);
3815     EXPAND_TAC "u0";
3816     GMATCH_SIMP_TAC Trigonometry2.WHEN_K_POS_ARCV_STABLE;
3817     EXISTS_TAC ( `(v dot (v:real^3)) / (b:real)`);
3818     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `&0 < (v dot v) /(b:real)`) (fun t -> REWRITE_TAC [ t ])));
3819       REWRITE_TAC[ Calc_derivative.invert_den_lt ];
3820       MATCH_MP_TAC Real_ext.REAL_PROP_POS_MUL2;
3821       BY(ASM_REWRITE_TAC[]);
3822     MATCH_MP_TAC (TAUT `(a = b) ==> (a ==> b)`);
3823     REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
3824     REWRITE_TAC[ VECTOR_MUL_ASSOC ];
3825     SUBGOAL_THEN `(v dot v) / b *  (b:real) / ((v:real^3) dot v) = &1` SUBST1_TAC;
3826       Calc_derivative.CALC_ID_TAC;
3827       BY(ASM_SIMP_TAC[arith `&0 < x ==> ~(x = &0)`]);
3828     BY(VECTOR_ARITH_TAC);
3829   DISCH_TAC;
3830   SUBCONJ_TAC;
3831     BY(ASM_MESON_TAC[]);
3832   DISCH_TAC;
3833   SUBGOAL_THEN `!w. w IN A /\ ~(w = u0) ==> ~collinear {u0,(u1:real^3),w}` ASSUME_TAC;
3834     GEN_TAC;
3835     DISCH_TAC;
3836     ONCE_REWRITE_TAC[ Trigonometry2.COLLINEAR_TRANSABLE ];
3837     EXPAND_TAC "u1";
3838     SUBST1_TAC ( varith ( `(u0 + v) - (u0:real^3) = v`));
3839     REWRITE_TAC[ COLLINEAR_LEMMA_ALT ];
3840     REWRITE_TAC[ DE_MORGAN_THM ; NOT_EXISTS_THM ];
3841     ASM_REWRITE_TAC[];
3842     REPEAT WEAK_STRIP_TAC;
3843     SUBGOAL_THEN `(w - u0) dot v = c * ((v:real^3) dot v)` MP_TAC;
3844       ASM_REWRITE_TAC[];
3845       BY(REWRITE_TAC[ DOT_LMUL ]);
3846     SUBGOAL_THEN `(w - u0) dot (v:real^3) = &0` SUBST1_TAC;
3847       BY(ASM_MESON_TAC[]);
3848     MATCH_MP_TAC (arith `~(c = &0) /\ (&0 < x) ==> (&0 = c * x ==> F)` );
3849     ASM_REWRITE_TAC[];
3850     DISCH_TAC;
3851     FIRST_X_ASSUM_ST `(%)` MP_TAC;
3852     ASM_REWRITE_TAC[ VECTOR_MUL_LZERO ];
3853     BY(ASM_REWRITE_TAC[ varith `(w - u0 = vec 0) <=> (w = (u0:real^3))`]);
3854   SUBGOAL_THEN `!(w:real^3). (w IN A) /\ ~(w = u0) ==> ~collinear {(vec 0),v,w}` ASSUME_TAC;
3855     REPEAT WEAK_STRIP_TAC;
3856     FIRST_X_ASSUM MP_TAC;
3857     REWRITE_TAC[ COLLINEAR_LEMMA_ALT ];
3858     ASM_REWRITE_TAC[ DE_MORGAN_THM ; NOT_EXISTS_THM ];
3859     REPEAT WEAK_STRIP_TAC;
3860     SUBGOAL_THEN `(w - u0) dot v = (c - b/ (v dot v)) * ((v:real^3) dot v)` MP_TAC;
3861       ASM_REWRITE_TAC[];
3862       EXPAND_TAC "u0";
3863       BY(REWRITE_TAC[ varith `c % (v:real^3) - x % v = (c - x) % v`; DOT_LMUL ]);
3864     SUBGOAL_THEN `(w - u0) dot (v:real^3) = &0` SUBST1_TAC;
3865       BY(ASM_MESON_TAC[]);
3866     MATCH_MP_TAC (arith `~(c = &0) /\ (&0 < x) ==> (&0 = c * x ==> F)` );
3867     ASM_REWRITE_TAC[];
3868     ONCE_REWRITE_TAC[arith `~(x -y = &0) <=> ~(x = y)`];
3869     DISCH_TAC;
3870     FIRST_X_ASSUM_ST `(%)` MP_TAC;
3871     BY(ASM_REWRITE_TAC[ ]);
3872   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(!i. i IN 1..n ==> ~collinear {vec 0, v, g i})`) ASSUME_TAC));
3873     BY(ASM_MESON_TAC[]);
3874   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w` (!i. i IN 1..n ==> ~collinear {vec 0, v, h i})`) ASSUME_TAC));
3875     BY(ASM_MESON_TAC[]);
3876   ASM_REWRITE_TAC[];
3877   SUBGOAL_THEN (`!w w'. w IN A /\ w' IN A ==> (w - w') dot (v:real^3) = &0`) ASSUME_TAC;
3878     ASM_REWRITE_TAC[];
3879     REPEAT WEAK_STRIP_TAC;
3880     ONCE_REWRITE_TAC [varith `(w - w') = (w - u0) + (-- &1) % (w' - (u0:real^3))`];
3881     REWRITE_TAC[ DOT_LADD ; DOT_LMUL ];
3882     BY(FIRST_X_ASSUM MP_TAC THEN FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC);
3883   SUBGOAL_THEN `!w (w':real^3).  w IN A /\ w' IN A /\ (w - u0) dot (w' - w) = &0 ==> (w' - w) dot w = &0` ASSUME_TAC;
3884     REPEAT WEAK_STRIP_TAC;
3885     ONCE_REWRITE_TAC[ DOT_SYM ];
3886     FIRST_X_ASSUM MP_TAC;
3887     MATCH_MP_TAC (arith `(-- &1) * x +  y = &0 ==> (x = &0 ==> y = &0)`);
3888     REWRITE_TAC[ GSYM DOT_LADD ; GSYM DOT_LMUL ];
3889     REWRITE_TAC[varith `( -- &1 % ((w:real^3) - u0) + w) = u0 `];
3890     EXPAND_TAC "u0";
3891     REWRITE_TAC[ DOT_LMUL ;REAL_ENTIRE];
3892     BY(ASM_MESON_TAC[ DOT_SYM ]);
3893   SUBGOAL_THEN `1 IN 1..n` ASSUME_TAC;
3894     BY(ASM_SIMP_TAC[ IN_NUMSEG ; arith `1 <= 1 /\ (1 < n ==> 1 <= n)` ]);
3895   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!i. i IN 1..n ==> g (i + 1) IN c3`) ASSUME_TAC));
3896     GEN_TAC;
3897     SUBGOAL_THEN `i IN 1..n ==> (i+1) IN 1..n \/ (i=n)` ASSUME_TAC;
3898       REWRITE_TAC[ IN_NUMSEG ];
3899       BY(ARITH_TAC);
3900     BY(ASM_MESON_TAC[]);
3901   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(!i. i IN 1..n       ==> (h i - g i) dot v = &0 /\          (h i - g (i + 1)) dot v = &0 /\          (h i - g i) dot g i = &0 /\          (h i - g (i + 1)) dot g (i + 1) = &0)`) (fun t -> REWRITE_TAC [t])));
3902     BY(ASM_MESON_TAC[]);
3903   SUBGOAL_THEN `!w w'. (w IN A) /\ (w' IN A) /\ ~(w = u0) /\ ~(w' = u0) ==> (azim u0 u1 w w' = azim (vec 0) v w w')` ASSUME_TAC;
3904     REPEAT WEAK_STRIP_TAC;
3905     SUBGOAL_THEN `~collinear {u0, u1,w} /\ ~collinear {u0,u1,(w':real^3)}` MP_TAC;
3906       BY(ASM_MESON_TAC[]);
3907     SUBGOAL_THEN `?t. (u0:real^3) = t % u1 /\ v = u1 - t % u1` MP_TAC;
3908       EXISTS_TAC `(b:real)/ (v dot v) / (&1 + b / (v dot (v:real^3)))`;
3909       MATCH_MP_TAC (varith ` (a = b) /\ ( c = (d:real^3) - a) ==> (a = b /\ c = d - b)`);
3910       EXPAND_TAC "u1";
3911       REWRITE_TAC[varith ` (u0 + v) - u0 = (v:real^3) `];
3912       EXPAND_TAC "u0";
3913       TYPED_ABBREV_TAC `b' = b / (v dot (v:real^3))`;
3914       ONCE_REWRITE_TAC[VECTOR_ARITH `b' % (v:real^3) + v = (b' + &1) % v`];
3915       REWRITE_TAC[ VECTOR_MUL_ASSOC ];
3916       REWRITE_TAC[ VECTOR_MUL_RCANCEL ];
3917       DISJ1_TAC;
3918       Calc_derivative.CALC_ID_TAC;
3919       EXPAND_TAC "b'";
3920       MATCH_MP_TAC (arith `&0 < x ==> ~(&1 + x = &0)`);
3921       REWRITE_TAC[ Calc_derivative.invert_den_lt ; Real_ext.REAL_PROP_POS_MUL2 ];
3922       MATCH_MP_TAC Real_ext.REAL_PROP_POS_MUL2;
3923       BY(ASM_REWRITE_TAC[]);
3924     WEAK_STRIP_TAC;
3925     ASM_REWRITE_TAC[];
3926     BY(ASM_MESON_TAC[azim_axis]);
3927   CONJ_TAC;
3928     REPEAT WEAK_STRIP_TAC;
3929     SUBGOAL_THEN `(!l. l IN 1..n ==> azim u0 u1 u2 (g l) = azim (vec 0) v u (g l))` ASSUME_TAC;
3930       REPEAT WEAK_STRIP_TAC;
3931       SUBGOAL_THEN `azim (vec 0) v u (g l) = azim (vec 0) v u2 (g (l:num))` SUBST1_TAC;
3932         EXPAND_TAC "u2";
3933         MATCH_MP_TAC EQ_SYM;
3934         ONCE_REWRITE_TAC [ Rogers.AZIM_EQ_SYM ];
3935         SUBGOAL_THEN `(u:real^3) + a % v = (-- a) % (vec 0) + a % v + (&1) % u` SUBST1_TAC;
3936           BY(VECTOR_ARITH_TAC);
3937         MATCH_MP_TAC (GSYM Topology.th1);
3938         CONJ_TAC;
3939           BY(REAL_ARITH_TAC);
3940         CONJ_TAC;
3941           BY(REAL_ARITH_TAC);
3942         BY(ASM_MESON_TAC[ Fan.th3a ]);
3943       FIRST_X_ASSUM MATCH_MP_TAC;
3944       BY(ASM_MESON_TAC[]);
3945     BY(ASM_MESON_TAC[]);
3946   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!i. i IN 1..n ==> ~(g (i+1) = u0)`) ASSUME_TAC));
3947     REPEAT WEAK_STRIP_TAC;
3948     SUBGOAL_THEN `i IN 1..n ==> (i + 1 IN 1..n) \/ (i = n)` ASSUME_TAC;
3949       REWRITE_TAC[ IN_NUMSEG ];
3950       BY(ARITH_TAC);
3951     BY(ASM_MESON_TAC[]);
3952   REPEAT (FIRST_X_ASSUM_ST `dot` (fun t -> ALL_TAC));
3953   REPEAT (FIRST_X_ASSUM_ST `collinear` (fun t -> ALL_TAC));
3954   REPEAT (FIRST_X_ASSUM_ST `rcone_gt` (fun t -> ALL_TAC));
3955   SUBGOAL_THEN `!i. i IN 1..n ==> (g i) IN A /\ (g (i+1) IN A) /\ (h i IN (A:real^3->bool))` ASSUME_TAC;
3956     BY(ASM_MESON_TAC[]);
3957   SUBGOAL_THEN `!i. i IN 1..n ==> ~(g i = u0) /\ ~(g (i+1) = u0) /\ ~( h i = (u0:real^3))` ASSUME_TAC;
3958     BY(ASM_MESON_TAC[]);
3959   REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC);
3960   FIRST_X_ASSUM_ST `azim` MP_TAC;
3961   FIRST_X_ASSUM_ST `pi` MP_TAC;
3962   FIRST_X_ASSUM_ST `&2` MP_TAC;
3963   REPEAT (FIRST_X_ASSUM (fun t -> ALL_TAC));
3964   REPEAT WEAK_STRIP_TAC;
3965   CONJ_TAC;
3966     REPEAT WEAK_STRIP_TAC;
3967     SUBGOAL_THEN (`azim (vec 0) v (g (i:num)) (h i) = azim u0 u1 (g i) (h i)`) SUBST1_TAC;
3968       BY(ASM_MESON_TAC[]);
3969     SUBGOAL_THEN (`azim (vec 0) v (g (i:num)) (g (i+1)) = azim u0 u1 (g i) (g (i+1))`) SUBST1_TAC;
3970       BY(ASM_MESON_TAC[]);
3971     SUBGOAL_THEN (`azim (vec 0) v (h (i:num)) (g (i+1)) = azim u0 u1 (h i) (g (i+1))`) SUBST1_TAC;
3972       BY(ASM_MESON_TAC[]);
3973     BY(ASM_SIMP_TAC[]);
3974   BY(ASM_MESON_TAC[])
3975   ]);;
3976   (* }}} *)
3977
3978 let CONE0_SUBSET_WEDGE = prove_by_refinement(
3979   `!v u w.
3980     ~collinear { vec 0, v, u} /\
3981     ~collinear { vec 0, v, w} /\
3982     &0 < azim (vec 0) v u w /\
3983     azim (vec 0) v u w < pi
3984     ==>
3985     cone0 (vec 0) {v,u,w} SUBSET wedge (vec 0) v u w`,
3986   (* {{{ proof *)
3987   [
3988   REPEAT WEAK_STRIP_TAC;
3989   ENOUGH_TO_SHOW_TAC `wedge (vec 0) v u w = aff_gt {(vec 0),v} {u,w}`;
3990     BY((MESON_TAC[cone0_subset_lune]));
3991   MATCH_MP_TAC WEDGE_LUNE_GT;
3992   BY((ASM_REWRITE_TAC[]))
3993   ]);;
3994   (* }}} *)
3995
3996 let FACET_INTER_DISJOINT = prove_by_refinement(
3997   `!(p:real^A->bool) f.
3998     polyhedron p /\
3999     vec 0 IN interior p /\
4000     f facet_of p ==> ~((vec 0) IN f)`,
4001   (* {{{ proof *)
4002   [
4003   REPEAT GEN_TAC;
4004   REWRITE_TAC[ facet_of ];
4005   GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w[`f`;`p`]) FACE_OF_DISJOINT_INTERIOR)));
4006   REWRITE_TAC[ Local_lemmas.EMPTY_NOT_EXISTS_IN ];
4007   REWRITE_TAC[ INTER; IN;];
4008   REWRITE_TAC[ INTER; IN; IN_ELIM_THM];
4009   BY(ASM_MESON_TAC[ arith `~(x = (x:int) - &1)`])
4010   ]);;
4011   (* }}} *)
4012
4013 let CONE0_AFF_GT = prove_by_refinement(
4014   `!x U. cone0 (x:real^A) U = aff_gt {x } U`,
4015   (* {{{ proof *)
4016   [
4017   BY(REWRITE_TAC[cone0;Sphere.aff_gt_def])
4018   ]);;
4019   (* }}} *)
4020
4021 let DISJOINT0_SCALE = prove_by_refinement(
4022   `!t (u0:real^A) u1 u2.
4023     DISJOINT { (vec 0) } { u0,u1,u2 } /\
4024     ~(t = &0)  ==>
4025         DISJOINT { (vec 0) } { t % u0,u1,u2 }
4026     `,
4027   (* {{{ proof *)
4028   [
4029   REWRITE_TAC[DISJOINT; Collect_geom2.INTER_DISJONT_EX ];
4030   REWRITE_TAC[ IN_SING; IN_INSERT];
4031   BY(MESON_TAC[ VECTOR_MUL_EQ_0 ; ])
4032   ]);;
4033   (* }}} *)
4034
4035 let CONE0_SCALE = prove_by_refinement(
4036   `!t (u0:real^A) u1 u2.
4037     DISJOINT { (vec 0) } { u0,u1,u2 } /\
4038     &0 < t ==>
4039    cone0 (vec 0) {u0, u1,u2 } = cone0 (vec 0) {t % u0,u1,u2 }`,
4040   (* {{{ proof *)
4041   [
4042   REPEAT WEAK_STRIP_TAC;
4043   REWRITE_TAC[ CONE0_AFF_GT];
4044   ASM_SIMP_TAC [ Vol1.AFF_GT_1_3 ;DISJOINT0_SCALE; arith `&0 < t ==> ~(t = &0)`];
4045   ONCE_REWRITE_TAC[FUN_EQ_THM];
4046   REWRITE_TAC[IN_ELIM_THM];
4047   REWRITE_TAC[arith `t % (vec 0) = vec 0 /\ (vec 0) + u = u`];
4048   GEN_TAC;
4049   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e <=> d /\ (a /\ b /\ c /\ e)`];
4050   REWRITE_TAC[MESON[] `!a b. ((?t1 t2 t3 t4. (a t1 t2 t3 t4 /\ b t2 t3 t4 )) <=> (?t2 t3 t4. ((?t1. a t1 t2 t3 t4) /\ b t2 t3 t4)))`];
4051   SUBGOAL_THEN `!t2 t3 t4. ?t1. t1 + t2 + t3 + t4 = &1` (fun t -> REWRITE_TAC [ t]);
4052     REPEAT WEAK_STRIP_TAC;
4053     EXISTS_TAC `&1 - t2 - t3 - t4`;
4054     BY(REAL_ARITH_TAC);
4055   ONCE_REWRITE_TAC[ Geomdetail.EQ_EXPAND ];
4056   REPEAT WEAK_STRIP_TAC;
4057   CONJ_TAC;
4058     REPEAT WEAK_STRIP_TAC;
4059     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `t2 / t`)));
4060     EXISTS_TAC `t3:real`;
4061     EXISTS_TAC `t4:real`;
4062     REWRITE_TAC[ VECTOR_MUL_ASSOC ];
4063     SUBGOAL_THEN `t2 / t * t = t2` SUBST1_TAC;
4064       Calc_derivative.CALC_ID_TAC;
4065       BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
4066     ASM_REWRITE_TAC[];
4067     MATCH_MP_TAC REAL_LT_DIV;
4068     BY(ASM_REWRITE_TAC[]);
4069   REWRITE_TAC[ VECTOR_MUL_ASSOC ];
4070   REPEAT WEAK_STRIP_TAC;
4071   EXISTS_TAC (`t2 * t`);
4072   EXISTS_TAC `t3:real`;
4073   EXISTS_TAC `t4:real`;
4074   ASM_REWRITE_TAC[];
4075   MATCH_MP_TAC REAL_LT_MUL;
4076   BY(ASM_REWRITE_TAC[])
4077   ]);;
4078   (* }}} *)
4079
4080 let CONE0_FCHANGED_SCALE = prove_by_refinement(
4081   ` !p f (u0:real^3) u1 u2 t.
4082          polyhedron p /\
4083          bounded p /\
4084          vec 0 IN interior p /\
4085          f facet_of p /\
4086          ~coplanar { (vec 0), u0,u1, u2 } /\
4087          {t % u0,  u1,  u2} SUBSET f /\
4088       &0 < t
4089          ==> cone0 (vec 0) {u0, u1, u2} SUBSET fchanged f`,
4090   (* {{{ proof *)
4091   [
4092   REPEAT WEAK_STRIP_TAC;
4093   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(u1 = vec 0) /\ ~(u2 = vec 0) /\ ~collinear {u0,u1,u2}`) MP_TAC));
4094     CONJ_TAC;
4095       BY(ASM_MESON_TAC[ Planarity.notcoplanar_disjoint ]);
4096     CONJ_TAC;
4097       BY(ASM_MESON_TAC[ Planarity.notcoplanar_disjoint ]);
4098     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`{ vec 0 , u0 , u1, u2} = {u0,u1 , u2, vec 0}`) ASSUME_TAC));
4099       BY(SET_TAC[]);
4100     BY(ASM_MESON_TAC[ NOT_COPLANAR_NOT_COLLINEAR ]);
4101   REPEAT WEAK_STRIP_TAC;
4102   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `cone0 (vec 0) {u0,u1,u2} = cone0 (vec 0) {t % u0,u1,u2}`) SUBST1_TAC));
4103     GOAL_TERM (fun w -> (ASM_CASES_TAC ( env w `u0 = vec 0`)));
4104       BY(ASM_REWRITE_TAC[ VECTOR_MUL_RZERO ]);
4105     MATCH_MP_TAC CONE0_SCALE;
4106     ASM_REWRITE_TAC[];
4107     REWRITE_TAC[ DISJOINT ];
4108     REWRITE_TAC[ Local_lemmas.EMPTY_NOT_EXISTS_IN ];
4109     REWRITE_TAC[ IN_SING ; IN_INTER ; IN_INSERT ];
4110     BY(ASM_MESON_TAC[]);
4111   MATCH_MP_TAC CONE0_FCHANGED;
4112   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `p`)));
4113   ASM_REWRITE_TAC[];
4114   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~coplanar { vec 0, t % u0, u1, u2}`) ASSUME_TAC));
4115     BY(ASM_MESON_TAC[ COPLANAR_SPECIAL_SCALE ; arith `&0 < t ==> ~(t = &0)`]);
4116   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`{ vec 0 , t % u0 , u1, u2} = {t % u0,u1 , u2, vec 0}`) ASSUME_TAC));
4117     BY(SET_TAC[]);
4118   BY(ASM_MESON_TAC[ NOT_COPLANAR_NOT_COLLINEAR ])
4119   ]);;
4120   (* }}} *)
4121
4122 let gotcjah_sol_half = prove_by_refinement(
4123   `!c3 v b P W t rho bet (w0:real^3) w1 s.
4124     polyhedron P /\ bounded P /\ (&0 < b) /\
4125     (vec 0 IN interior P) /\
4126     (c3 facet_of P) /\
4127     (fchanged c3 = W) /\
4128     (&0 < t /\ t < &1 ) /\
4129     (&0 < rho) /\
4130     (&0 < s) /\
4131     (P INTER { p | p dot v = b } = c3) /\
4132     rcone_gt (vec 0) v t SUBSET W /\
4133     ~(v = vec 0) /\
4134     &0 < v dot v /\
4135     cos (arcV(vec 0) v w0) = t /\
4136     s % v IN c3 /\
4137     w0 IN c3 /\
4138     w1 IN c3 /\
4139     ~coplanar {(vec 0), v, w0, w1 } /\
4140     // ~collinear {(vec 0), v, w0} /\
4141     // ~collinear {(vec 0), v, w1} /\
4142     // &0 < dihV (vec 0) v w0 w1 /\
4143     // dihV (vec 0) v w0 w1  < pi /\
4144     dihV (vec 0) v w0 w1 = bet /\
4145     (w1 - w0) dot v = &0 /\
4146     (w1 - w0) dot w0 = &0
4147   ==>
4148     (?X.
4149        X = cone0 (vec 0) {v,w0,w1} /\
4150       X SUBSET (aff_gt { (vec 0), v } { w0, w1} INTER W) /\
4151        measurable (X INTER normball (vec 0) rho) /\
4152        radial_norm rho (vec 0) (X INTER normball (vec 0) rho) /\
4153         (bet - asn (sin bet * t)) = sol (vec 0) X)
4154 `,
4155   (* {{{ proof *)
4156   [
4157   REPEAT WEAK_STRIP_TAC;
4158   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~collinear {(vec 0),v,w0} /\ ~collinear {(vec 0),v,w1} /\ &0 < dihV (vec 0) v w0 w1 /\ dihV (vec 0) v w0 w1 < pi`) MP_TAC));
4159     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{(vec 0), v,w0,w1} = {(vec 0),v,w1,w0}`) ASSUME_TAC));
4160       BY(SET_TAC []);
4161     BY(ASM_MESON_TAC[ NOT_COPLANAR_NOT_COLLINEAR ; DIHV_EQ_0_PI_EQ_COPLANAR ; DIHV_RANGE ; arith `&0<=x /\ x <= pi /\ ~(x = &0) /\ ~(x = pi) ==> (&0 < x /\ x < pi)`]);
4162   REPEAT WEAK_STRIP_TAC;
4163   EXISTS_TAC `cone0 (vec 0) {v,w0,(w1:real^3)}`;
4164   REWRITE_TAC[ ];
4165   CONJ_TAC;
4166     REWRITE_TAC[ Misc_defs_and_lemmas.SUBSET_INTER ];
4167     CONJ_TAC;
4168       BY(REWRITE_TAC[ cone0_subset_lune ]);
4169     EXPAND_TAC "W";
4170     MATCH_MP_TAC CONE0_FCHANGED_SCALE;
4171     GOAL_TERM (fun w -> (EXISTS_TAC ( env w`P`)));
4172     GOAL_TERM (fun w -> (EXISTS_TAC ( env w`s`)));
4173     ASM_REWRITE_TAC[];
4174     REWRITE_TAC[SUBSET;IN_INSERT];
4175     BY(ASM_MESON_TAC[ NOT_IN_EMPTY ]);
4176   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`!r. &0 < r ==> measurable (cone0 (vec 0) {v, w0, w1} INTER normball (vec 0) r)`) ASSUME_TAC));
4177     REPEAT WEAK_STRIP_TAC;
4178     ONCE_REWRITE_TAC[ INTER_COMM ];
4179     ONCE_REWRITE_TAC[ NORMBALL_BALL ];
4180     ONCE_REWRITE_TAC[ CONE0_AFF_GT ];
4181     BY(REWRITE_TAC[ MEASURABLE_BALL_AFF_GT ]);
4182   ASM_SIMP_TAC[];
4183   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`!r. &0 < r ==> radial_norm r (vec 0)  (cone0 (vec 0) {v, w0, w1} INTER normball (vec 0) r) `) ASSUME_TAC));
4184     REPEAT WEAK_STRIP_TAC;
4185     REWRITE_TAC[ CONE0_AFF_GT ];
4186     MATCH_MP_TAC Vol1.aff_gt_radial;
4187     CONJ_TAC;
4188       REWRITE_TAC[ DISJOINT ; Local_lemmas.EMPTY_NOT_EXISTS_IN ];
4189       REWRITE_TAC[ IN_SING; IN_INTER; IN_INSERT ];
4190       BY(ASM_MESON_TAC [ Planarity.notcoplanar_disjoint ]);
4191     BY(FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC);
4192   ASM_SIMP_TAC[];
4193   GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`w0`;`v`;`w1`]) vol_solid_triangle_ortho)));
4194   ASM_REWRITE_TAC[];
4195   ANTS_TAC;
4196     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`{vec 0 ,w0, v, w1} = {vec 0 ,v,w0,w1}`) SUBST1_TAC));
4197       BY(SET_TAC []);
4198     BY(ASM_REWRITE_TAC[]);
4199   LET_TAC;
4200   LET_TAC;
4201   DISCH_THEN (fun t -> REWRITE_TAC [ GSYM t ]);
4202   GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`(vec 0):real^3`;`cone0 (vec 0) {v,w0,w1}`;`rho'`]) Pack_defs.sol)));
4203   GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`(vec 0):real^3`;`cone0 (vec 0) {v,w0,w1}`;`&1`]) Pack_defs.sol)));
4204   ASM_SIMP_TAC[arith `&0 < &1`;arith `x < y ==> y > x`];
4205   DISCH_THEN (fun t -> ALL_TAC);
4206   DISCH_THEN (fun t -> REWRITE_TAC[ GSYM t]);
4207   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`{(vec 0),w0,v,w1}= {vec 0, v,w0,w1}`) ASSUME_TAC));
4208     BY(SET_TAC []);
4209   ASM_SIMP_TAC[arith `&1 > &0`;GSYM volume_props];
4210   REWRITE_TAC[solid_triangle];
4211   REWRITE_TAC[arith `x / &1 pow 3 = x`];
4212   REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
4213   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`{w0,v,w1} = {v,w0,w1}`) MP_TAC));
4214     BY(SET_TAC[]);
4215   BY(MESON_TAC[INTER_COMM])
4216   ]);;
4217
4218 let  AZIM_LE_PI_EQ_DIHV_ALT = prove_by_refinement(
4219   `!a b x y. ~collinear {a, b, x} /\ ~collinear {a, b, y} /\
4220       azim a b x y <= pi
4221       ==> dihV a b x y = azim a b x y`,
4222   (* {{{ proof *)
4223   [
4224     MESON_TAC[Local_lemmas.AZIM_LE_PI_EQ_DIHV];
4225   ]);;
4226   (* }}} *)
4227
4228 let gotcjah_sol_lemma = prove_by_refinement(
4229   `!c3 v b P W t rho bet (w0:real^3) w1 w2 s.
4230     polyhedron P /\ bounded P /\ (&0 < b) /\
4231     (vec 0 IN interior P) /\
4232     (c3 facet_of P) /\
4233     (fchanged c3 = W) /\
4234     (&0 < t /\ t < &1 ) /\
4235     (&0 < rho) /\
4236     (&0 < s) /\
4237     (P INTER { p | p dot v = b } = c3) /\
4238     rcone_gt (vec 0) v t SUBSET W /\
4239     ~(v = vec 0) /\
4240     &0 < v dot v /\
4241     cos (arcV(vec 0) v w0) = t /\
4242     cos (arcV(vec 0) v w2) = t /\
4243     s % v IN c3 /\
4244     w0 IN c3 /\
4245     w1 IN c3 /\
4246     w2 IN c3 /\
4247     ~collinear {(vec 0), v, w0} /\
4248     ~collinear {(vec 0), v, w1} /\
4249     ~collinear {(vec 0), v, w2} /\
4250     s % v IN c3 /\
4251     w0 IN c3 /\
4252     w1 IN c3 /\
4253     w2 IN c3 /\
4254     azim (vec 0) v w0 w2 / &2 = bet /\
4255     // &0 < azim (vec 0) v w0 w2 /\
4256     azim (vec 0) v w0 w2 < pi /\
4257     azim (vec 0) v w0 w1 = bet /\
4258     azim (vec 0) v w1 w2 = bet /\
4259     (w1 - w0) dot v = &0 /\
4260     (w1 - w0) dot w0 = &0 /\
4261     (w1 - w2) dot v = &0 /\
4262     (w1 - w2) dot w2 = &0
4263   ==>
4264     (?X.  X SUBSET (wedge (vec 0) v w0 w2 INTER W) /\
4265        measurable (X INTER normball (vec 0) rho) /\
4266        radial_norm rho (vec 0) (X INTER normball (vec 0) rho) /\
4267        &2 * (bet - asn (sin bet * t)) = sol (vec 0) X)
4268 `,
4269   (* {{{ proof *)
4270   [
4271   REPEAT WEAK_STRIP_TAC;
4272   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `dihV (vec 0) v w0 w1 = bet /\ dihV (vec 0) v w1 w2 = bet`) MP_TAC));
4273     GMATCH_SIMP_TAC AZIM_LE_PI_EQ_DIHV_ALT;
4274     GMATCH_SIMP_TAC AZIM_LE_PI_EQ_DIHV_ALT;
4275     ASM_REWRITE_TAC[];
4276     REPEAT (FIRST_X_ASSUM_ST `azim` MP_TAC);
4277     MP_TAC PI_POS;
4278     BY(REAL_ARITH_TAC);
4279   REPEAT WEAK_STRIP_TAC;
4280   COMMENT "CHANGE STARTS HERE";
4281   SUBGOAL_THEN `azim (vec 0) v w0 w2 = &0 \/ &0 < azim (vec 0) v w0 w2` MP_TAC;
4282     BY(MESON_TAC[AZIM_NN; arith `&0 <= x ==> (x = &0) \/ &0 < x`]);
4283   DISCH_THEN DISJ_CASES_TAC;
4284     EXISTS_TAC (`{}:real^3->bool`);
4285     REWRITE_TAC[INTER_EMPTY ; MEASURABLE_EMPTY; Conforming.RADIAL_EMPTY ];
4286     REWRITE_TAC[ EMPTY_SUBSET ];
4287     REWRITE_TAC[ Conforming.SOL_EMPTY ];
4288     FIRST_X_ASSUM_ST `&2` MP_TAC;
4289     ASM_REWRITE_TAC[];
4290     REWRITE_TAC[arith `&0/ &2 = bet <=> bet = &0`];
4291     DISCH_THEN SUBST1_TAC;
4292     REWRITE_TAC[ SIN_0 ; ASN_0; arith `&0 * t = &0`];
4293     BY(REAL_ARITH_TAC);
4294     (COMMENT "CHANGE ENDS HERE");
4295   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`~coplanar {(vec 0),v,w0,w1} /\ ~coplanar {(vec 0),v,w1,w2}`) MP_TAC));
4296     ASSUME_TAC DIHV_EQ_0_PI_EQ_COPLANAR;
4297     GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w`~(dihV (vec 0) v w0 w1 = &0) /\ ~(dihV (vec 0) v w0 w1 = pi) /\ ~(dihV (vec 0) v w1 w2 = &0) /\ ~(dihV( vec 0) v w1 w2 = pi)`)));
4298       BY(ASM_MESON_TAC[]);
4299     REPEAT (FIRST_X_ASSUM_ST `azim` MP_TAC);
4300     MP_TAC PI_POS;
4301     REPEAT (FIRST_X_ASSUM_ST `dihV` MP_TAC);
4302     BY(REAL_ARITH_TAC);
4303   REPEAT WEAK_STRIP_TAC;
4304   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `cone0 (vec 0) {v,w0,w1}  UNION cone0 (vec 0) {v,w2,w1}`)));
4305   REWRITE_TAC[ UNION_SUBSET ];
4306   ONCE_REWRITE_TAC[INTER_COMM];
4307   REWRITE_TAC[UNION_OVER_INTER];
4308   GMATCH_SIMP_TAC MEASURABLE_UNION;
4309   GMATCH_SIMP_TAC Conforming.RADIAL_UNION;
4310   GMATCH_SIMP_TAC Conforming.SOL_DISJOINT_UNION;
4311   ONCE_REWRITE_TAC[arith `u2 = x + y <=> u2 - (x + y) = &0`];
4312   GMATCH_SIMP_TAC (arith `u = x /\ u = y ==> &2 * u - ( x + y) = &0`);
4313   GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`c3`;`v`;`b`;`P`;`W`;`t`;`rho'`;`bet`;`w0`;`w1`;`s`]) gotcjah_sol_half)));
4314   ASM_REWRITE_TAC[];
4315   WEAK_STRIP_TAC;
4316   FIRST_X_ASSUM_ST `cone0` (ASSUME_TAC o SYM);
4317   ASM_REWRITE_TAC[];
4318   GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`c3`;`v`;`b`;`P`;`W`;`t`;`rho'`;`bet`;`w2`;`w1`;`s`]) gotcjah_sol_half)));
4319   ASM_REWRITE_TAC[];
4320   ANTS_TAC;
4321     CONJ_TAC;
4322       FIRST_X_ASSUM_ST `coplanar` MP_TAC;
4323       GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w`{vec 0 , v,w1,w2} = {vec 0, v, w2,w1}`)));
4324         BY(MESON_TAC[]);
4325       BY(SET_TAC[]);
4326     ONCE_REWRITE_TAC[ DIHV_SYM ];
4327     BY(ASM_REWRITE_TAC[]);
4328   WEAK_STRIP_TAC;
4329   FIRST_X_ASSUM_ST `cone0` (ASSUME_TAC o SYM);
4330   ASM_REWRITE_TAC[];
4331   ONCE_REWRITE_TAC[INTER_COMM];
4332   ASM_REWRITE_TAC[];
4333   MATCH_MP_TAC (TAUT `b /\ c /\ a ==> a /\ b /\ c`);
4334   GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`(vec 0):real^3`;`v`;`w0`;`w2`;`w1`]) WEDGE_SPLIT)));
4335   ASM_REWRITE_TAC[];
4336   ANTS_TAC;
4337     REWRITE_TAC[wedge; IN;IN_ELIM_THM];
4338     ASM_REWRITE_TAC[];
4339     MP_TAC PI_POS;
4340     REPEAT (FIRST_X_ASSUM_ST `azim` MP_TAC);
4341     BY(REAL_ARITH_TAC);
4342   REPEAT WEAK_STRIP_TAC;
4343   SUBGOAL_THEN `wedge (vec 0) v w0 w1  = aff_gt {vec 0, v} {w0,w1} /\ wedge (vec 0) v w1 w2  = aff_gt {vec 0, v} {w2,w1}` MP_TAC;
4344     GMATCH_SIMP_TAC WEDGE_LUNE_GT;
4345     GMATCH_SIMP_TAC WEDGE_LUNE_GT;
4346     ASM_REWRITE_TAC[];
4347     ASSUME_TAC PI_POS;
4348     CONJ_TAC;
4349       BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
4350     CONJ_TAC;
4351       BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
4352     REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
4353     BY(SET_TAC[]);
4354   REPEAT WEAK_STRIP_TAC;
4355   MATCH_MP_TAC (TAUT `c /\ a /\ b ==> a /\ b /\ c`);
4356   CONJ_TAC;
4357     EXISTS_TAC `rho':real`;
4358     ONCE_REWRITE_TAC[INTER_COMM];
4359     ASM_REWRITE_TAC[];
4360     ASM_SIMP_TAC[arith `&0 < x ==> x > &0`;DISJOINT];
4361     ENOUGH_TO_SHOW_TAC `?Y Y'. X SUBSET Y /\ X' SUBSET Y' /\ Y INTER (Y':real^3->bool) = {}`;
4362       BY(SET_TAC[]);
4363     REPEAT (FIRST_X_ASSUM_ST `wedge` MP_TAC);
4364     REPEAT (FIRST_X_ASSUM_ST `aff_gt` MP_TAC);
4365     BY(MESON_TAC[ SUBSET_INTER]);
4366   REPEAT (FIRST_X_ASSUM_ST `wedge` MP_TAC);
4367   REPEAT (FIRST_X_ASSUM_ST `aff_gt` MP_TAC);
4368   BY(SET_TAC[])
4369   ]);;
4370
4371 let c3_lemma = prove_by_refinement(
4372   `!c3 (v:real^3) b.
4373     c3 SUBSET { p | p dot v = b } /\
4374     &0 < b ==>
4375     ({p | p dot v = b} INTER fchanged c3 SUBSET c3)`,
4376   (* {{{ proof *)
4377   [
4378   ONCE_REWRITE_TAC[INTER;SUBSET];
4379   REWRITE_TAC[IN;INTER;IN_ELIM_THM];
4380   REWRITE_TAC[ Polyhedron.fchanged ;IN_ELIM_THM];
4381   REPEAT WEAK_STRIP_TAC;
4382   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`c3 v1`) ASSUME_TAC));
4383     BY(ASM_MESON_TAC[ SUBSET;IN;IN_ELIM_THM;RELATIVE_INTERIOR_SUBSET ]);
4384   SUBGOAL_THEN`t * b = b` ASSUME_TAC;
4385     BY(ASM_MESON_TAC[ DOT_LMUL ]);
4386   SUBGOAL_THEN `t = &1` ASSUME_TAC;
4387     MATCH_MP_TAC (REAL_RING `~(b = &0) /\ (t * b= b) ==> (t = &1)`);
4388     BY(ASM_SIMP_TAC [arith `&0 < b==> ~(b = &0)`]);
4389   BY(ASM_MESON_TAC[arith `&1 % (v1:real^3) = v1`])
4390   ]);;
4391   (* }}} *)
4392
4393 let NOT_COLLINEAR = prove_by_refinement(
4394   `!(v:real^3). ~(v = vec 0)==> (?u. ~collinear {(vec 0),v,u})`,
4395   (* {{{ proof *)
4396   [
4397   REPEAT WEAK_STRIP_TAC;
4398   ASM_SIMP_TAC [ Local_lemmas.COLLINEAR_ONCE_VEC_0 ];
4399   SUBGOAL_THEN `&0 < (v:real^3) dot v` ASSUME_TAC;
4400     BY(ASM_REWRITE_TAC[DOT_POS_LT]);
4401   GOAL_TERM (fun w -> (MP_TAC (ISPEC ( env w `v`) Trigonometry2.EXISTS_OTHOR_VECTOR_DIFFF_VEC0)));
4402   REPEAT WEAK_STRIP_TAC;
4403   EXISTS_TAC `v':real^3`;
4404   REWRITE_TAC[ NOT_EXISTS_THM ];
4405   GEN_TAC;
4406   ONCE_REWRITE_TAC[MESON[] `a = b <=> (b = a)`];
4407   DISCH_TAC;
4408   REPEAT (FIRST_X_ASSUM_ST `0` MP_TAC);
4409   EXPAND_TAC "v'";
4410   REWRITE_TAC[DOT_RMUL];
4411   REWRITE_TAC[REAL_ENTIRE];
4412   REWRITE_TAC[ VECTOR_MUL_EQ_0 ];
4413   BY(REAL_ARITH_TAC)
4414   ]);;
4415   (* }}} *)
4416
4417 let gotcjah_prep = prove_by_refinement(
4418   `!c v b P  WF t n u0 A.
4419     polyhedron P /\ bounded P /\  (&0 < b) /\
4420     (vec 0 IN interior P) /\
4421     c facet_of P /\
4422     ( { (p:real^3) | p dot v = b} = A) /\
4423     ( (b / (v dot v)) % (v:real^3) = u0 ) /\
4424     fchanged c = WF /\
4425     (&0 < t /\ t < &1) /\
4426     (P INTER { p | p dot v = b } = c) /\
4427     rcone_gt (vec 0) v t SUBSET WF /\
4428     ( {f | f facet_of c } HAS_SIZE n) ==>
4429     (c SUBSET A) /\
4430     ( ~((v:real^3) = vec 0)   )  /\
4431     ( &0 < (v:real^3) dot v ) /\
4432     ( (u0:real^3) IN rcone_gt (vec 0) v t ) /\
4433     ( (u0:real^3) IN c ) /\
4434     ( rcone_gt (vec 0) v t INTER A SUBSET c ) /\
4435     ( ?u. ~(collinear {(vec 0), v, u }))`,
4436   (* {{{ proof *)
4437   [
4438   X_GENv_TAC "c3";
4439   REPEAT WEAK_STRIP_TAC;
4440   SUBCONJ_TAC;
4441     FIRST_X_ASSUM_ST `INTER` MP_TAC;
4442     ASM_REWRITE_TAC[];
4443     BY(SET_TAC[]);
4444   DISCH_TAC;
4445   SUBGOAL_THEN `~((v:real^3) = vec 0)` ASSUME_TAC;
4446     DISCH_TAC;
4447     HASH_UNDISCH_TAC 2896;
4448     ASM_REWRITE_TAC[DOT_RZERO];
4449     REWRITE_TAC[ FUN_EQ_THM ;IN_ELIM_THM];
4450     DISCH_TAC;
4451     (fun gl -> (SUBGOAL_THEN ( env gl`A = {}`) ASSUME_TAC) gl);
4452       BY((REPEAT (FIRST_X_ASSUM MP_TAC) THEN SET_TAC[arith `&0 < b ==> ~(&0 = b)`]));
4453     (fun gl -> (SUBGOAL_THEN ( env gl`c3 = {}`) ASSUME_TAC) gl);
4454       FIRST_X_ASSUM_ST `SUBSET` MP_TAC;
4455       FIRST_X_ASSUM MP_TAC;
4456       BY(SET_TAC[]);
4457     BY((ASM_MESON_TAC[ facet_of ]));
4458   COMMENT "1";
4459   COMMENT "v dot v";
4460   SUBGOAL_THEN `&0 < (v:real^3) dot v` ASSUME_TAC;
4461     BY((ASM_REWRITE_TAC[DOT_POS_LT]));
4462   COMMENT "subgoal";
4463   ASM_SIMP_TAC[ NOT_COLLINEAR ];
4464   SUBCONJ_TAC;
4465     REWRITE_TAC[rcone_gt ; rconesgn ; IN_ELIM_THM ; VECTOR_SUB_RZERO ; DIST_0 ];
4466     EXPAND_TAC "u0";
4467     REWRITE_TAC[ DOT_LMUL ];
4468     REWRITE_TAC[ NORM_MUL ];
4469     REWRITE_TAC[ GSYM NORM_POW_2 ];
4470     REWRITE_TAC[ arith `x pow 2 = x * x`];
4471     REWRITE_TAC[ arith `x > y <=> y < x`];
4472     (fun gl -> (SUBGOAL_THEN ( env gl`abs (b / (norm v * norm v)) = b / (norm v * norm v)`) SUBST1_TAC) gl);
4473       MATCH_MP_TAC Trigonometry2.LT_IMP_ABS_REFL;
4474       MATCH_MP_TAC REAL_LT_DIV;
4475       BY((ASM_MESON_TAC [ NORM_POW_2 ; arith `x pow 2 = x * x` ]));
4476     REWRITE_TAC[ arith `(a * b) * c = a * (b * c)`];
4477     REWRITE_TAC[ arith `x * x = x pow 2`; NORM_POW_2 ; arith `a * b * c * d = a * (b * c) * d`];
4478     MATCH_MP_TAC REAL_LT_LMUL;
4479     CONJ_TAC;
4480       BY((ASM_MESON_TAC [ REAL_LT_DIV ]));
4481     REWRITE_TAC[ arith `a * t < a <=> &0 < a * (&1 - t)`];
4482     BY((ASM_MESON_TAC [ REAL_LT_MUL ; arith `t < &1 <=> &0 < &1 - t`]));
4483   DISCH_TAC;
4484   COMMENT "u0";
4485   SUBGOAL_THEN `(u0:real^3) IN c3` ASSUME_TAC;
4486     ENOUGH_TO_SHOW_TAC `(u0:real^3) IN fchanged c3 /\ (u0 IN affine hull c3)`;
4487       REWRITE_TAC[ GSYM IN_INTER];
4488       BY((ASM_MESON_TAC[FCHANGED_AFFINE; SUBSET; IN; RELATIVE_INTERIOR_SUBSET ]));
4489     CONJ_TAC;
4490       BY((ASM_MESON_TAC[SUBSET; IN]));
4491     GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w[`P`;`c3`;`v`;`b`]) affine_facet_hyper )));
4492     ANTS_TAC;
4493       ASM_REWRITE_TAC[];
4494       CONJ_TAC;
4495         MATCH_MP_TAC Polyhedron.INTERIOR_AFFINIE_HUL_EQ_UNIV;
4496         BY((ASM_MESON_TAC[]));
4497       EXPAND_TAC "c3";
4498       AP_TERM_TAC;
4499       MATCH_MP_TAC EQ_EXT;
4500       REWRITE_TAC[ IN_ELIM_THM ];
4501       BY((MESON_TAC[ DOT_SYM ]));
4502     DISCH_THEN SUBST1_TAC;
4503     REWRITE_TAC[ IN_ELIM_THM ];
4504     EXPAND_TAC "u0";
4505     REWRITE_TAC [ DOT_RMUL ];
4506     CALC_ID_TAC;
4507     BY((REPEAT (FIRST_X_ASSUM MP_TAC ) THEN REAL_ARITH_TAC));
4508   ASM_REWRITE_TAC[];
4509   COMMENT "1";
4510   MATCH_MP_TAC SUBSET_TRANS;
4511   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `A INTER WF'`)));
4512   CONJ_TAC;
4513     REPEAT (FIRST_X_ASSUM_ST `rcone_gt` MP_TAC);
4514     BY(SET_TAC[]);
4515   BY(ASM_MESON_TAC[c3_lemma])
4516   ]);;
4517   (* }}} *)
4518
4519
4520
4521 let azim_pos = prove_by_refinement(
4522   `!x v u w1 w2.
4523     azim x v u w1 < azim x v u w2 /\
4524      ~collinear {x, v, w1} /\
4525           ~collinear {x, v, w2} /\
4526           ~collinear {x, v, u}
4527           ==> &0 < azim x v w1 w2`,
4528   (* {{{ proof *)
4529   [
4530   REPEAT WEAK_STRIP_TAC;
4531   GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`x`;`v`;`u`;`w1`;`w2`]) Fan.sum4_azim_fan )));
4532   ASM_REWRITE_TAC[];
4533   ANTS_TAC;
4534     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
4535   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
4536   ]);;
4537   (* }}} *)
4538
4539 let convex_sum_corollary = prove_by_refinement(
4540   `!n t bet. 0 < n /\
4541   &0 < t /\ t < &1 /\
4542     sum (1..n) bet = pi /\
4543   (!i. i IN 1..n ==> &0 <= bet i /\ bet i <= pi) ==>
4544   (pi - &n * asn (sin (pi / &n) * t)) <= sum (1..n) (\i. bet i - asn (sin (bet i) * t))`,
4545   (* {{{ proof *)
4546   [
4547   REPEAT GEN_TAC;
4548   REWRITE_TAC[TAUT `(a /\ b ==> c) <=> (a ==> (b ==> c))`];
4549   DISCH_TAC;
4550   ASM_SIMP_TAC[ SUM_OFFSET_0 ; arith `0 < n ==> 1 <= n`];
4551   REPEAT WEAK_STRIP_TAC;
4552   MATCH_MP_TAC GOTCJAH_convex_sum;
4553   ASM_REWRITE_TAC[];
4554   SUBGOAL_THEN `pi <= &n * pi /\ &0 <= pi` (fun t -> REWRITE_TAC[t]);
4555     ASSUME_TAC PI_POS;
4556     SIMP_TAC[ arith `pi <= &n * pi <=> &0 <= pi * (&n - &1)`;];
4557     GMATCH_SIMP_TAC Real_ext.REAL_PROP_NN_MUL2;
4558     ONCE_REWRITE_TAC[arith `&0 <= &n - &1 <=> &1 <= &n`];
4559     REWRITE_TAC[Real_ext.REAL_LE];
4560     BY(ASM_MESON_TAC[arith `0<n ==> 1<=n`;arith `&0 < pi ==> &0 <= pi`]);
4561   REPEAT WEAK_STRIP_TAC;
4562   FIRST_X_ASSUM MATCH_MP_TAC;
4563   REWRITE_TAC[IN_NUMSEG];
4564   BY(ASM_SIMP_TAC[arith `i < n ==> i+1 <=n`;arith `1 <= i + 1`])
4565   ]);;
4566   (* }}} *)
4567
4568 let SOL_SUBSET = prove_by_refinement(
4569   `!x s t r. r > &0 /\
4570          measurable (s INTER normball x r) /\
4571          measurable (t INTER normball x r) /\
4572          s SUBSET t /\
4573          radial_norm r x (s INTER normball x r) /\
4574          radial_norm r x (t INTER normball x r)
4575          ==> sol x s <= sol x t`,
4576   (* {{{ proof *)
4577   [
4578   REPEAT WEAK_STRIP_TAC;
4579   GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`x`;`s`;`t DIFF s`;`r`]) Conforming.SOL_DISJOINT_UNION)));
4580   ASM_REWRITE_TAC[];
4581   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `s UNION t DIFF s = t`) SUBST1_TAC));
4582     FIRST_X_ASSUM_ST `SUBSET` MP_TAC;
4583     BY(SET_TAC[]);
4584   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `DISJOINT s (t DIFF s)`) (fun t -> ONCE_REWRITE_TAC[t])));
4585     BY(SET_TAC[]);
4586   REWRITE_TAC[];
4587   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!u. (t DIFF s) INTER u = (t INTER u DIFF (s INTER u))`) ASSUME_TAC));
4588     GEN_TAC;
4589     FIRST_X_ASSUM_ST `SUBSET` MP_TAC;
4590     BY(SET_TAC[]);
4591   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `measurable ((t DIFF s) INTER normball x r)`) ASSUME_TAC));
4592     ASM_SIMP_TAC[];
4593     MATCH_MP_TAC MEASURABLE_DIFF;
4594     BY(ASM_REWRITE_TAC[]);
4595   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `radial_norm r x ((t DIFF s) INTER normball x r)`) ASSUME_TAC));
4596     ASM_SIMP_TAC[];
4597     MATCH_MP_TAC Conforming.RADIAL_DIFF;
4598     ASM_REWRITE_TAC[];
4599     FIRST_X_ASSUM_ST `SUBSET` MP_TAC;
4600     BY(SET_TAC[]);
4601   ASM_REWRITE_TAC[];
4602   ENOUGH_TO_SHOW_TAC ( `&0 <= sol x (t DIFF s)`);
4603     BY(REAL_ARITH_TAC);
4604   GMATCH_SIMP_TAC Vol1.sol;
4605   EXISTS_TAC `r:real`;
4606   ASM_REWRITE_TAC[];
4607   MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2;
4608   CONJ_TAC;
4609     BY(REAL_ARITH_TAC);
4610   MATCH_MP_TAC REAL_LE_DIV;
4611   CONJ_TAC;
4612     MATCH_MP_TAC MEASURE_POS_LE;
4613     BY(ASM_MESON_TAC[]);
4614   MATCH_MP_TAC REAL_POW_LE;
4615   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
4616   ]);;
4617   (* }}} *)
4618
4619 let GOTCJAH_concl = `!c v b P  WF t n.
4620     polyhedron P /\ bounded P /\  (&0 < b) /\
4621     (vec 0 IN interior P) /\
4622     c facet_of P /\
4623     fchanged c = WF /\
4624     (&0 < t /\ t < &1) /\
4625     (c = P INTER { p | p dot v = b } /\ rcone_gt (vec 0) v t SUBSET WF) /\
4626     ( {u | u facet_of c } HAS_SIZE n)
4627    ==> &2 * pi - &2* &n * asn (t* sin(pi/ &n)) <= sol (vec 0)  WF`;;
4628
4629 let GOTCJAH = prove_by_refinement(
4630   GOTCJAH_concl,
4631   (* {{{ proof *)
4632   [
4633   X_GENv_TAC "c3";
4634   REPEAT WEAK_STRIP_TAC;
4635   TYPED_ABBREV_TAC (`A = { (p:real^3) | p dot v = b}`);
4636   TYPED_ABBREV_TAC `u0 = (b / (v dot v)) % (v:real^3)`;
4637   GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`c3`; `v`; `b`; `P`; `WF'`; `t`; `n`; `u0`; `A`]) gotcjah_prep)));
4638   ASM_REWRITE_TAC[];
4639   REPEAT WEAK_STRIP_TAC;
4640   GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`P`; `c3`; `A`; `n`; `{ c | c facet_of c3 }`; `t`; `u`; `v`; `b`] ) EUSOTYP2_general)));
4641   ASM_REWRITE_TAC[];
4642   REPEAT WEAK_STRIP_TAC;
4643   SUBGOAL_THEN `1 IN 1..n /\ (!i. (i IN 1..n) ==> (i+1) IN 1..n \/ (i=n))` ASSUME_TAC;
4644     FIRST_X_ASSUM_ST `1 < n` MP_TAC;
4645     REWRITE_TAC[ IN_NUMSEG ];
4646     BY((ARITH_TAC));
4647   SUBGOAL_THEN `&0 < b/ ((v:real^3) dot v)` ASSUME_TAC;
4648     MATCH_MP_TAC REAL_LT_DIV;
4649     BY((ASM_REWRITE_TAC[]));
4650   SUBGOAL_THEN `!i.  (?bet X. (i IN 1..n) ==> (azim (vec 0) v (g i) (g (i+1)) / &2 = bet) /\ X SUBSET (wedge (vec 0) v (g i) (g (i+1)) INTER WF') /\ measurable (X INTER normball (vec 0) (&1)) /\ radial_norm (&1) (vec 0) (X INTER normball (vec 0) (&1)) /\ (&2 * (bet - asn (sin bet * t)) = sol (vec 0) X))` ASSUME_TAC;
4651     GEN_TAC;
4652     REWRITE_TAC [MESON[] `(?X bet. (p ==> q X bet)) <=> p ==> (?X bet. q X bet)`];
4653     DISCH_TAC;
4654     TYPED_ABBREV_TAC (`bet = azim (vec 0) v (g i) (g (i+1))/ &2 `);
4655     EXISTS_TAC `bet:real`;
4656     REWRITE_TAC[];
4657     MATCH_MP_TAC ( gotcjah_sol_lemma);
4658     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `c3`)));
4659     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `b`)));
4660     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `P`)));
4661     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `h i`)));
4662     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `b / (v dot v)`)));
4663     ASM_REWRITE_TAC[];
4664     ASM_SIMP_TAC[arith `&0 < &1`];
4665     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `g (i+1) IN P INTER A /\ cos (arcV (vec 0) v (g (i+1))) = t` ) ASSUME_TAC));
4666       ASM_CASES_TAC `i=(n:num)`;
4667         ASM_REWRITE_TAC[];
4668         FIRST_X_ASSUM MATCH_MP_TAC;
4669         BY((ASM_REWRITE_TAC[]));
4670       FIRST_X_ASSUM MATCH_MP_TAC;
4671       FIRST_X_ASSUM MP_TAC;
4672       REPLICATE_TAC 2 (FIRST_X_ASSUM_ST `1..n` MP_TAC);
4673       BY((MESON_TAC[]));
4674     ASM_REWRITE_TAC[];
4675     ASM_CASES_TAC `i = (n:num)`;
4676       ASM_REWRITE_TAC[];
4677       FIRST_X_ASSUM MATCH_MP_TAC;
4678       BY((ASM_REWRITE_TAC[]));
4679     FIRST_X_ASSUM MATCH_MP_TAC;
4680     FIRST_X_ASSUM MP_TAC;
4681     REPLICATE_TAC 2 (FIRST_X_ASSUM_ST `1..n` MP_TAC);
4682     BY((MESON_TAC[]));
4683   FIRST_X_ASSUM MP_TAC;
4684   REWRITE_TAC[SKOLEM_THM];
4685   REPEAT WEAK_STRIP_TAC;
4686   COMMENT "Have bet and X";
4687   ONCE_REWRITE_TAC[arith `&2 * pi - &2 * u <= s <=> (pi - u) <= s/ &2`];
4688   MATCH_MP_TAC REAL_LE_TRANS;
4689   EXISTS_TAC `sum (1..n) (\i. bet i - asn (sin (bet i) * t))`;
4690   ONCE_REWRITE_TAC [arith `t * sin u = sin u * t`];
4691   CONJ_TAC;
4692     MATCH_MP_TAC convex_sum_corollary;
4693     ASM_SIMP_TAC [arith `1 < n ==> 0 < n`];
4694     MATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`);
4695     CONJ_TAC;
4696       REPEAT WEAK_STRIP_TAC;
4697       SUBGOAL_THEN (`bet i = azim (vec 0) v (g i ) (g (i+1)) / &2`) SUBST1_TAC;
4698         BY((ASM_SIMP_TAC[]));
4699       GMATCH_SIMP_TAC(arith `&0 <= x ==> &0 <= x/ &2`);
4700       GMATCH_SIMP_TAC(arith `x < &2 * pi ==> x / &2 <= pi`);
4701       BY((REWRITE_TAC[ Local_lemmas.AZIM_RANGE ]));
4702     SUBGOAL_THEN `sum (1..n) bet = sum (1..n) (\i. (&1/ &2) * azim (vec 0) v (g i) (g (i+1)))` SUBST1_TAC;
4703       MATCH_MP_TAC SUM_EQ;
4704       REPEAT WEAK_STRIP_TAC;
4705       BETA_TAC;
4706       ONCE_REWRITE_TAC[arith ` (&1/ &2) * u = u / &2`];
4707       BY((ASM_SIMP_TAC[]));
4708     REWRITE_TAC[ SUM_LMUL ];
4709     REWRITE_TAC[arith `(&1 / &2) * t = pi <=> t = &2 * pi`];
4710     MATCH_MP_TAC ORDER_AZIM_SUM2Pi;
4711     EXISTS_TAC `u:real^3`;
4712     BY((ASM_REWRITE_TAC[]));
4713   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`!i j. (i IN 1..n) /\ (j IN 1..n) /\ ~(i = j) ==> DISJOINT (X i) (X j)`) ASSUME_TAC));
4714     REPEAT WEAK_STRIP_TAC;
4715     REWRITE_TAC[DISJOINT];
4716     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(?a1 a2. X i SUBSET a1 /\ X j SUBSET a2 /\ ( a1 INTER a2 = {})) ==> (X i INTER X j = {})`) MATCH_MP_TAC));
4717       BY((SET_TAC[]));
4718     EXISTS_TAC `wedge (vec 0) v (g i) (g (i+1))`;
4719     EXISTS_TAC `wedge (vec 0) v (g j) (g (j+1))`;
4720     CONJ_TAC;
4721       BY((ASM_MESON_TAC[SUBSET_INTER]));
4722     CONJ_TAC;
4723       BY((ASM_MESON_TAC[SUBSET_INTER]));
4724     GMATCH_SIMP_TAC WEDGE_ORDER_DISJOINT;
4725     EXISTS_TAC `u:real^3`;
4726     EXISTS_TAC `n:num`;
4727     BY((ASM_REWRITE_TAC[]));
4728   COMMENT "1a";
4729   ONCE_REWRITE_TAC[arith `x <= u/ &2 <=> &2 * x <= u`; ];
4730   SUBGOAL_THEN `sol ((vec 0):real^3) (UNIONS (IMAGE X (1..n))) = sum ((IMAGE X (1..n))) (\s. sol (vec 0) s)` ASSUME_TAC;
4731     MATCH_MP_TAC Conforming.SOL_UNIONS;
4732     EXISTS_TAC `&1`;
4733     REWRITE_TAC[ arith `&1 > &0`; IN_IMAGE ];
4734     CONJ_TAC;
4735       MATCH_MP_TAC FINITE_IMAGE;
4736       BY((REWRITE_TAC[ FINITE_NUMSEG ]));
4737     CONJ_TAC;
4738       GEN_TAC;
4739       BY((ASM_MESON_TAC[]));
4740     REPEAT WEAK_STRIP_TAC;
4741     ASM_REWRITE_TAC[];
4742     FIRST_X_ASSUM MATCH_MP_TAC;
4743     BY((ASM_MESON_TAC[]));
4744   FIRST_X_ASSUM MP_TAC;
4745   GMATCH_SIMP_TAC SUM_IMAGE_NONZERO;
4746   CONJ_TAC;
4747     REWRITE_TAC[ FINITE_NUMSEG];
4748     REPEAT WEAK_STRIP_TAC;
4749     GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `X x = {}`)));
4750       DISCH_THEN SUBST1_TAC;
4751       BY((REWRITE_TAC[ Conforming.SOL_EMPTY ]));
4752     REPLICATE_TAC 5 (FIRST_X_ASSUM MP_TAC);
4753     REWRITE_TAC[ DISJOINT; Local_lemmas.EMPTY_NOT_EXISTS_IN; IN_INTER ];
4754     BY((MESON_TAC[]));
4755   COMMENT "1b";
4756   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(\s. sol (vec 0) s) o X = (\i. sol (vec 0) (X i))`) SUBST1_TAC));
4757     ONCE_REWRITE_TAC[FUN_EQ_THM];
4758     BETA_TAC;
4759     BY((REWRITE_TAC[o_THM]));
4760   DISCH_TAC;
4761   MATCH_MP_TAC REAL_LE_TRANS;
4762   EXISTS_TAC (`sol ((vec 0):real^3) (UNIONS (IMAGE X (1..n)))`);
4763   CONJ_TAC;
4764     ASM_REWRITE_TAC[];
4765     MATCH_MP_TAC (arith `x = y ==> x<= y`);
4766     ONCE_REWRITE_TAC[ GSYM SUM_LMUL ];
4767     MATCH_MP_TAC SUM_EQ;
4768     REPEAT WEAK_STRIP_TAC;
4769     BETA_TAC;
4770     BY((ASM_MESON_TAC[]));
4771   (COMMENT "1c");
4772   MATCH_MP_TAC SOL_SUBSET;
4773   EXISTS_TAC `&1`;
4774   CONJ_TAC;
4775     BY(REAL_ARITH_TAC);
4776   CONJ_TAC;
4777     REWRITE_TAC[ Conforming.UNIONS_INTER ];
4778     MATCH_MP_TAC MEASURABLE_UNIONS;
4779     CONJ_TAC;
4780       GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{s INTER normball (vec 0) (&1) | s IN IMAGE X (1..n)} = IMAGE (\k. X k INTER normball (vec 0) (&1)) (1..n)`) SUBST1_TAC));
4781         ONCE_REWRITE_TAC[ FUN_EQ_THM];
4782         REWRITE_TAC[ IN; IMAGE ;IN_ELIM_THM];
4783         BY(MESON_TAC[ ]);
4784       MATCH_MP_TAC FINITE_IMAGE;
4785       BY(REWRITE_TAC[ FINITE_NUMSEG]);
4786     REWRITE_TAC[IN_ELIM_THM];
4787     REWRITE_TAC[ IN_IMAGE ];
4788     FIRST_X_ASSUM_ST `azim` MP_TAC;
4789     BY(MESON_TAC[]);
4790   CONJ_TAC;
4791     EXPAND_TAC "WF'";
4792     MATCH_MP_TAC FCHANGED_MEASURABLE;
4793     BY(ASM_MESON_TAC[]);
4794   CONJ_TAC;
4795     REWRITE_TAC[ UNIONS_SUBSET ];
4796     REWRITE_TAC[ IN_IMAGE ];
4797     FIRST_X_ASSUM_ST `azim` MP_TAC;
4798     BY(MESON_TAC[ SUBSET_INTER ]);
4799   CONJ_TAC;
4800     REWRITE_TAC[ Conforming.UNIONS_INTER ];
4801     MATCH_MP_TAC Conforming.RADIAL_UNIONS;
4802     CONJ_TAC;
4803       GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{s INTER normball (vec 0) (&1) | s IN IMAGE X (1..n)} = IMAGE (\k. X k INTER normball (vec 0) (&1)) (1..n)`) SUBST1_TAC));
4804         ONCE_REWRITE_TAC[ FUN_EQ_THM];
4805         REWRITE_TAC[ IN; IMAGE ;IN_ELIM_THM];
4806         BY(MESON_TAC[ ]);
4807       MATCH_MP_TAC FINITE_IMAGE;
4808       BY(REWRITE_TAC[ FINITE_NUMSEG]);
4809     REWRITE_TAC[IN_ELIM_THM];
4810     REWRITE_TAC[ IN_IMAGE ];
4811     FIRST_X_ASSUM_ST `azim` MP_TAC;
4812     BY(MESON_TAC[]);
4813   EXPAND_TAC "WF'";
4814   REWRITE_TAC[ GSYM Marchal_cells_2_new.RADIAL_VS_RADIAL_NORM ];
4815   MATCH_MP_TAC FCHANGED_RADIAL;
4816   BY(ASM_MESON_TAC[])
4817   ]);;
4818   (* }}} *)
4819
4820 (* Lemmas related to last two theorems in "Counting Spheres" *)
4821
4822
4823
4824 let rcone_def_alt = prove_by_refinement(
4825   `!(v:real^A) t p. p IN rcone_gt (vec 0) v t <=> norm p * norm v * t < p dot v`,
4826   (* {{{ proof *)
4827   [
4828   REWRITE_TAC[Sphere.rcone_gt;Sphere.rconesgn;varith `(x:real^A) - vec 0  = x`;IN;IN_ELIM_THM; DIST_0 ];
4829   BY(REAL_ARITH_TAC)
4830   ]);;
4831   (* }}} *)
4832
4833 let rcone_refl = prove_by_refinement(
4834   `!(v:real^A) t.  t < &1 /\ ~(v = vec 0) ==> v IN rcone_gt (vec 0) v t`,
4835   (* {{{ proof *)
4836   [
4837   REWRITE_TAC[rcone_def_alt];
4838   REPEAT WEAK_STRIP_TAC;
4839   REWRITE_TAC[ DOT_SQUARE_NORM ];
4840   REWRITE_TAC[ arith `x * x * t < x pow 2 <=> &0 < (&1 - t ) * (x * x)`];
4841   (MATCH_MP_TAC REAL_LT_MUL );
4842   CONJ_TAC;
4843     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
4844   (MATCH_MP_TAC REAL_LT_MUL);
4845   BY(ASM_REWRITE_TAC [ NORM_POS_LT ])
4846   ]);;
4847   (* }}} *)
4848
4849 let rcone_nz = prove_by_refinement(
4850   `!(v:real^A) p t.  (&0 < t ) /\ (p IN rcone_gt (vec 0) v t) ==> ~(p = vec 0) /\ ~(v = vec 0)`,
4851   (* {{{ proof *)
4852   [
4853   REWRITE_TAC[ rcone_def_alt ];
4854   REPEAT WEAK_STRIP_TAC;
4855   BY(CONJ_TAC THEN DISCH_TAC THEN (FIRST_X_ASSUM_ST `norm` MP_TAC) THEN ASM_REWRITE_TAC[ NORM_0 ; DOT_LZERO ; DOT_RZERO ; ] THEN REAL_ARITH_TAC)
4856   ]);;
4857   (* }}} *)
4858
4859 let rcone_dot_pos = prove_by_refinement(
4860   `!(v:real^A) t p.  &0 < t /\
4861       p IN rcone_gt (vec 0) v t ==> &0 < p dot v`,
4862   (* {{{ proof *)
4863   [
4864   REPEAT WEAK_STRIP_TAC;
4865   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w` ~(p = vec 0) /\ ~(v = vec 0)`) ASSUME_TAC));
4866     BY(ASM_MESON_TAC[rcone_nz]);
4867   FIRST_X_ASSUM_ST `rcone_gt` MP_TAC;
4868   REWRITE_TAC[rcone_def_alt];
4869   REPEAT WEAK_STRIP_TAC;
4870   MATCH_MP_TAC REAL_LT_TRANS;
4871   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `norm p * norm v * t`)));
4872   ASM_REWRITE_TAC[];
4873   MATCH_MP_TAC REAL_LT_MUL;
4874   CONJ_TAC;
4875     BY(ASM_REWRITE_TAC[ NORM_POS_LT ]);
4876   MATCH_MP_TAC REAL_LT_MUL;
4877   BY(ASM_REWRITE_TAC [ NORM_POS_LT ])
4878   ]);;
4879   (* }}} *)
4880
4881 let rcone_hyperplane = prove_by_refinement(
4882   `!(v:real^A) t b q p.
4883     (&0 < t /\ t < &1) /\
4884     (p IN rcone_gt (vec 0) v t) /\
4885      ( ( b / (p dot v)) % p = q) ==>
4886         (q dot v = b)`,
4887   (* {{{ proof *)
4888   [
4889   REWRITE_TAC[ rcone_def_alt];
4890   REPEAT WEAK_STRIP_TAC;
4891   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`&0 < (p dot v)`) ASSUME_TAC));
4892     MATCH_MP_TAC rcone_dot_pos;
4893     BY(ASM_MESON_TAC[ rcone_def_alt ]);
4894   EXPAND_TAC "q";
4895   REWRITE_TAC[ DOT_LMUL ];
4896   Calc_derivative.CALC_ID_TAC;
4897   BY(FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC)
4898   ]);;
4899   (* }}} *)
4900
4901 let rcone_gt_arcV = prove_by_refinement(
4902   `!(v:real^3) g p.
4903     (&0 < g) /\ (g < pi / &2) /\
4904     p IN rcone_gt (vec 0) v (cos g) ==>
4905     arcV (vec 0) p v < g `,
4906   (* {{{ proof *)
4907   [
4908   REPEAT WEAK_STRIP_TAC;
4909   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w` ~(p = vec 0) /\ ~(v = vec 0)`) ASSUME_TAC));
4910     MATCH_MP_TAC rcone_nz;
4911     BY(ASM_MESON_TAC[COS_POS_PI2]);
4912   GMATCH_SIMP_TAC (GSYM COS_MONO_LT_EQ);
4913   REWRITE_TAC[ Local_lemmas1.ARCV_BOUNDS ];
4914   ASSUME_TAC PI_POS;
4915   ASM_SIMP_TAC [arith `&0 < pi /\ g < pi / &2 ==> g <= pi`;arith `&0 < g ==> &0 <= g`];
4916   FIRST_X_ASSUM_ST `IN` MP_TAC;
4917   REWRITE_TAC[ rcone_def_alt];
4918   REWRITE_TAC[ Trigonometry1.DOT_COS ];
4919   GMATCH_SIMP_TAC REAL_LT_LMUL_EQ;
4920   ASM_SIMP_TAC[ NORM_POS_LT ];
4921   GMATCH_SIMP_TAC REAL_LT_LMUL_EQ;
4922   BY(ASM_SIMP_TAC[ NORM_POS_LT ])
4923    ]);;
4924   (* }}} *)
4925
4926 let cos_bounds_0_Pi2 = prove_by_refinement(
4927   `!x. &0 < x /\ x < pi / &2 ==>
4928     &0 < cos x /\ cos x < &1`,
4929   (* {{{ proof *)
4930   [
4931   REPEAT WEAK_STRIP_TAC;
4932   CONJ_TAC;
4933     BY(ASM_SIMP_TAC[ Trigonometry.CFXEKKP2 ]);
4934   SUBGOAL_THEN `cos x <= &1` MP_TAC;
4935     BY(MESON_TAC[ COS_BOUNDS ]);
4936   DISCH_TAC;
4937   GMATCH_SIMP_TAC ( arith `u <= &1 /\ ~( u = &1) ==> (u < &1 )`);
4938   ASM_REWRITE_TAC[];
4939   DISCH_TAC;
4940   FIRST_X_ASSUM MP_TAC;
4941   REWRITE_TAC[ COS_ONE_2PI ];
4942   REWRITE_TAC[ NOT_EXISTS_THM; DE_MORGAN_THM ];
4943   CONJ_TAC;
4944     STRIP_TAC;
4945     DISJ_CASES_TAC (ARITH_RULE `n = 0 \/ 1 <= n`);
4946       ASM_REWRITE_TAC[];
4947       BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
4948     FIRST_X_ASSUM MP_TAC;
4949     REWRITE_TAC[ GSYM REAL_OF_NUM_LE ];
4950     REPEAT WEAK_STRIP_TAC;
4951     FIRST_X_ASSUM_ST `pi / &2` MP_TAC;
4952     ASM_REWRITE_TAC[];
4953     REWRITE_TAC[ arith `~(&n * &2 * pi < pi/ &2)  <=> (&0 <= pi * (&n * &2 - &1 / &2))` ];
4954     MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2;
4955     CONJ_TAC;
4956       BY(MP_TAC PI_POS THEN REAL_ARITH_TAC);
4957     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
4958   STRIP_TAC;
4959   MATCH_MP_TAC (arith `(&0 < x /\ &0 <= u ==> ~(x = -- u))`);
4960   ASM_REWRITE_TAC[];
4961   MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2;
4962   GMATCH_SIMP_TAC Real_ext.REAL_PROP_NN_MUL2;
4963   MP_TAC PI_POS;
4964   BY(REAL_ARITH_TAC)
4965   ]);;
4966   (* }}} *)
4967
4968 let rcone_gt_arc_triangle = prove_by_refinement(
4969   `!(p:real^3) v w gv gw.
4970     ~(w = vec 0) /\
4971     (&0 < gv) /\ (gv < pi / &2) /\
4972     p IN rcone_gt (vec 0) v (cos gv) /\
4973     gv + gw <= arcV (vec 0) v w ==>
4974     gw < arcV (vec 0) p w`,
4975   (* {{{ proof *)
4976   [
4977   REPEAT WEAK_STRIP_TAC;
4978   SUBGOAL_THEN `&0 < cos gv /\ cos gv < &1` ASSUME_TAC;
4979     BY(ASM_SIMP_TAC[ cos_bounds_0_Pi2 ]);
4980   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`~(p = vec 0) /\ ~(v = vec 0)`) ASSUME_TAC));
4981     BY(ASM_MESON_TAC[rcone_nz]);
4982   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`arcV (vec 0) v w <= arcV (vec 0) v p + arcV (vec 0) p w`) ASSUME_TAC));
4983     MATCH_MP_TAC Trigonometry2.ARCV_INEQUALTY;
4984     BY(ASM_REWRITE_TAC[]);
4985   GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`v`;`gv`;`p`]) rcone_gt_arcV)));
4986   ASM_REWRITE_TAC[];
4987   DISCH_TAC;
4988   FIRST_X_ASSUM (fun t -> MP_TAC (ONCE_REWRITE_RULE[ Trigonometry2.ARC_SYM ] t));
4989   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
4990   ]);;
4991   (* }}} *)
4992
4993 let rcone_gt_facet = prove_by_refinement(
4994   `!gv gw v w q (p:real^3).
4995     (&0 < gv /\ gv < pi / &2) /\
4996     (&0 < gw /\ gw < pi / &2) /\
4997     ~(w = vec 0) /\
4998     (p IN rcone_gt (vec 0) v (cos (gv))) /\
4999     (q = (((norm v) * cos (gv)) / (p dot v)) % p) /\
5000     (gv + gw <= arcV (vec 0) v w) ==>
5001     (q dot w < norm w * cos gw)`,
5002   (* {{{ proof *)
5003   [
5004   REPEAT WEAK_STRIP_TAC;
5005   SUBGOAL_THEN `&0 < cos gv /\ cos gv < &1 /\ &0 < cos gw /\ cos gw < &1` ASSUME_TAC;
5006     BY((ASM_SIMP_TAC[ cos_bounds_0_Pi2 ]));
5007   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`~(p = vec 0) /\ ~(v = vec 0)`) ASSUME_TAC));
5008     BY((ASM_MESON_TAC[rcone_nz]));
5009   SUBGOAL_THEN `&0 < p dot (v:real^3)` ASSUME_TAC;
5010     GMATCH_SIMP_TAC rcone_dot_pos;
5011     BY(ASM_MESON_TAC[]);
5012   ASM_REWRITE_TAC[];
5013   REWRITE_TAC[ DOT_LMUL ];
5014   GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `(p dot v) * ((norm v * cos gv) / (p dot v) * (p dot w)) < (p dot v) * norm w * cos gw`)));
5015     BY(ASM_MESON_TAC[ REAL_LT_LMUL_EQ ]);
5016   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(p dot v) * (norm v * cos gv) / (p dot v) * (p dot w) =  (norm v * cos gv) * (p dot w)`) (fun t -> ONCE_REWRITE_TAC[t])));
5017     Calc_derivative.CALC_ID_TAC;
5018     BY(FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC);
5019   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `&0 < norm w /\ &0 < norm p /\ &0 < norm v`) ASSUME_TAC));
5020     BY(ASM_SIMP_TAC[ NORM_POS_LT ]);
5021   ASM_SIMP_TAC [ Trigonometry1.DOT_COS ];
5022   ONCE_REWRITE_TAC [arith `(a * b) * c * d *e < (c * a * f ) * d * g <=> (a * c * d) * b * e < (a*c*d)* (f *g)`];
5023   GMATCH_SIMP_TAC REAL_LT_LMUL_EQ;
5024   CONJ_TAC;
5025     GMATCH_SIMP_TAC REAL_LT_MUL;
5026     ASM_SIMP_TAC[];
5027     GMATCH_SIMP_TAC REAL_LT_MUL;
5028     BY(ASM_SIMP_TAC[]);
5029   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`&0 < cos (arcV (vec 0) p v)`) ASSUME_TAC));
5030     FIRST_X_ASSUM_ST `dot` MP_TAC;
5031     REWRITE_TAC[ Trigonometry1.DOT_COS ];
5032     BY(ASM_SIMP_TAC[ REAL_LT_MUL_EQ ]);
5033   GOAL_TERM (fun w -> (ASM_CASES_TAC ( env w`&0 < cos (arcV (vec 0) p w)`)));
5034     MATCH_MP_TAC REAL_LT_TRANS;
5035     GOAL_TERM (fun w -> ((EXISTS_TAC ( env w`cos (arcV (vec 0) p v) * cos (arcV (vec 0) p w)`))));
5036     CONJ_TAC;
5037       ONCE_REWRITE_TAC[arith `x * y = y * x`];
5038       GMATCH_SIMP_TAC REAL_LT_LMUL_EQ;
5039       ASM_REWRITE_TAC[];
5040       GMATCH_SIMP_TAC COS_MONO_LT_EQ;
5041       ASM_SIMP_TAC[ Local_lemmas1.ARCV_BOUNDS ];
5042       CONJ_TAC;
5043         MP_TAC PI_POS;
5044         BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
5045       MATCH_MP_TAC rcone_gt_arcV;
5046       BY(ASM_SIMP_TAC[]);
5047     GMATCH_SIMP_TAC REAL_LT_LMUL_EQ;
5048     ASM_REWRITE_TAC[];
5049     GMATCH_SIMP_TAC COS_MONO_LT_EQ;
5050     ASM_SIMP_TAC[ Local_lemmas1.ARCV_BOUNDS ];
5051     CONJ_TAC;
5052       MP_TAC PI_POS;
5053       BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
5054     MATCH_MP_TAC rcone_gt_arc_triangle;
5055     BY(ASM_MESON_TAC[]);
5056   MATCH_MP_TAC REAL_LET_TRANS;
5057   EXISTS_TAC `&0`;
5058   CONJ_TAC;
5059     REWRITE_TAC[ arith `x * y <= &0 <=> &0 <= x * --y`];
5060     MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2;
5061     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
5062   MATCH_MP_TAC REAL_LT_MUL;
5063   BY(ASM_REWRITE_TAC[])
5064   ]);;
5065   (* }}} *)
5066
5067
5068 let edges_of_facet_of = prove_by_refinement(
5069   `!(P:real^3->bool)  f.
5070     polyhedron P /\ bounded P /\ (vec 0 IN interior P) ==>
5071     (f edge_of P <=> (?c. f facet_of c /\ c facet_of P))`,
5072   (* {{{ proof *)
5073   [
5074   REPEAT WEAK_STRIP_TAC;
5075   REWRITE_TAC[edge_of];
5076   REWRITE_TAC [ Geomdetail.EQ_EXPAND ];
5077   CONJ_TAC;
5078     REPEAT WEAK_STRIP_TAC;
5079     INTRO_TAC FACE_OF_POLYHEDRON_SUBSET_FACET [`P`;`f`];
5080     ASM_REWRITE_TAC[];
5081     ANTS_TAC;
5082       REWRITE_TAC[ GSYM AFF_DIM_POS_LE ];
5083       CONJ_TAC;
5084         ASM_REWRITE_TAC[];
5085         BY(INT_ARITH_TAC);
5086       DISCH_TAC;
5087       INTRO_TAC Polyhedron.AFF_DIM_INTERIOR_EQ_3 [`(vec 0):real^3`;`P`];
5088       ASM_REWRITE_TAC[];
5089       EXPAND_TAC "P";
5090       ASM_REWRITE_TAC[];
5091       BY(INT_ARITH_TAC);
5092     REPEAT WEAK_STRIP_TAC;
5093     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `f'`)));
5094     ASM_REWRITE_TAC[ ];
5095     REWRITE_TAC[ facet_of ];
5096     ASM_REWRITE_TAC[];
5097     CONJ_TAC;
5098       GMATCH_SIMP_TAC FACE_OF_FACE;
5099       BY(ASM_MESON_TAC[ facet_of ]);
5100     CONJ_TAC;
5101       REWRITE_TAC[ GSYM AFF_DIM_POS_LE ];
5102       ASM_REWRITE_TAC[];
5103       BY(INT_ARITH_TAC);
5104     GMATCH_SIMP_TAC FACET_AFF_DIM_2;
5105     CONJ_TAC;
5106       BY(ASM_MESON_TAC[]);
5107     BY(INT_ARITH_TAC);
5108   REPEAT WEAK_STRIP_TAC;
5109   CONJ_TAC;
5110     BY(ASM_MESON_TAC [ FACE_OF_TRANS ; facet_of ]);
5111   INTRO_TAC FACET_AFF_DIM_2 [`P`;`c`];
5112   ANTS_TAC;
5113     BY(ASM_REWRITE_TAC[]);
5114   FIRST_X_ASSUM kill;
5115   FIRST_X_ASSUM MP_TAC;
5116   REWRITE_TAC[ facet_of ];
5117   DISCH_THEN (fun t-> REWRITE_TAC[t]);
5118   DISCH_THEN (fun t-> REWRITE_TAC[t]);
5119   BY(INT_ARITH_TAC)
5120   ]);;
5121   (* }}} *)
5122
5123 let BIJ_SYM = prove_by_refinement(
5124   `!(a:A->bool) (b:B->bool).
5125     (?f. BIJ f a b) ==> (?g. BIJ g b a)`,
5126   (* {{{ proof *)
5127   [
5128   BY(MESON_TAC[ Misc_defs_and_lemmas.INVERSE_BIJ ])
5129   ]);;
5130   (* }}} *)
5131
5132 let BIJ_TRANS = prove_by_refinement(
5133   `! (B:B->bool)  (A:A->bool) (C:C->bool) .
5134     (?pab. BIJ pab A B) /\ (?pbc. BIJ pbc B C) ==> (?pab. BIJ pab A C)`,
5135   (* {{{ proof *)
5136   [
5137   MESON_TAC[ Hypermap.COMPOSE_BIJ ]
5138   ]);;
5139   (* }}} *)
5140
5141 let SND_BIJ = prove_by_refinement(
5142   `!(a:A) B:(B->bool). BIJ SND { (x,y) | x = a /\ B y } B`,
5143   (* {{{ proof *)
5144   [
5145   REWRITE_TAC[BIJ;INJ;SURJ;IN_ELIM_THM;IN];
5146   BY(MESON_TAC[FST;SND])
5147   ]);;
5148   (* }}} *)
5149
5150 let FST_BIJ = prove_by_refinement(
5151   `!(A:A->bool) b:B. BIJ FST { (x,y) | A x  /\ ( y = b) } A`,
5152   (* {{{ proof *)
5153   [
5154   REWRITE_TAC[BIJ;INJ;SURJ;IN_ELIM_THM;IN];
5155   BY(MESON_TAC[FST;SND])
5156   ]);;
5157   (* }}} *)
5158
5159 let PREIMAGE_BIJ = prove_by_refinement(
5160   `!(A:A->bool) (B:B->bool) (C:C->bool) f g.
5161     (!a. (a IN A) ==> (f a IN C) ) /\
5162     (!b. (b IN B) ==> (g b IN C)) /\
5163     (!c. (c IN C) ==> ?p. BIJ p (preimage A f {c}) (preimage B g {c})) ==>
5164     (?q. BIJ q A B)`,
5165   (* {{{ proof *)
5166   [
5167   REPEAT GEN_TAC;
5168   DISCH_THEN (fun t -> MP_TAC(ONCE_REWRITE_RULE[ RIGHT_IMP_EXISTS_THM ] t));
5169   ONCE_REWRITE_TAC[SKOLEM_THM];
5170   REPEAT WEAK_STRIP_TAC;
5171   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `\a. p (f a) a`)));
5172   FIRST_X_ASSUM MP_TAC;
5173   REWRITE_TAC[BIJ;INJ;SURJ; Misc_defs_and_lemmas.in_preimage ;IN_SING];
5174   BY(ASM_MESON_TAC[])
5175   ]);;
5176   (* }}} *)
5177
5178 let BIJ_FACET_HYPERFACE = prove_by_refinement(
5179   `!(p:real^3->bool).
5180    polyhedron p /\ bounded p /\ (vec 0 IN interior p) ==>
5181     (?b. BIJ b {f | f facet_of p} (face_set(hypermap1_of_fanx (vec 0,vertices p,edges p))))
5182     `,
5183   (* {{{ proof *)
5184   [
5185   REPEAT WEAK_STRIP_TAC;
5186   MATCH_MP_TAC (INST_TYPE [`:(real^3->bool)`,`:B`] BIJ_TRANS);
5187   EXISTS_TAC (`(topological_component_yfan (vec 0,vertices p,edges p))`);
5188   SUBGOAL_THEN `{(f:real^3 -> bool) | f facet_of p } = \f. f facet_of p` MP_TAC;
5189     ONCE_REWRITE_TAC[FUN_EQ_THM];
5190     BETA_TAC;
5191     BY(REWRITE_TAC[IN;IN_ELIM_THM]);
5192   DISCH_THEN SUBST1_TAC;
5193   CONJ_TAC;
5194     BY(ASM_MESON_TAC[ Polyhedron.AMHFNXP_BIJ]);
5195   BY(ASM_MESON_TAC[ Cfyxfty.WBLARHH_BIJ; BIJ_SYM; ])
5196   ]);;
5197   (* }}} *)
5198
5199 let POLYHEDRON_CONFORMING_FAN = prove_by_refinement(
5200   `!(p:real^3->bool). bounded p /\ polyhedron p /\ vec 0 IN interior p ==>
5201     (conforming_fan ((vec 0), vertices p, edges p))`,
5202   (* {{{ proof *)
5203   [
5204   REPEAT WEAK_STRIP_TAC;
5205   MATCH_MP_TAC Conforming.PIIJBJK;
5206   ASM_SIMP_TAC[ Polyhedron.POLYHEDRON_FAN ];
5207   ASM_SIMP_TAC[ Polyhedron.POLYTOPE_FAN80 ];
5208   BY(ASM_SIMP_TAC[ Polyhedron.CARD_SET_OF_EDGE_INEQ_1_POLYHEDRON ])
5209   ]);;
5210   (* }}} *)
5211
5212 let POLYHEDRON_D1_D = prove_by_refinement(
5213   `!(p:real^3->bool). bounded p /\ polyhedron p /\ vec 0 IN interior p ==>
5214     d_fan ((vec 0), vertices p,edges p) = d1_fan((vec 0),vertices p,edges p)`,
5215   (* {{{ proof *)
5216   [
5217   REPEAT WEAK_STRIP_TAC;
5218   MATCH_MP_TAC Fan.dartset_fully_surrounded_is_non_isolated_fan;
5219   BY(ASM_MESON_TAC[ Polyhedron.POLYHEDRON_FAN ; Polyhedron.CARD_SET_OF_EDGE_INEQ_1_POLYHEDRON])
5220   ]);;
5221   (* }}} *)
5222
5223 let POLYHEDRON_PLAIN = prove_by_refinement(
5224   `!(p:real^3->bool). bounded p /\ polyhedron p /\ vec 0 IN interior p ==>
5225     (plain_hypermap (hypermap1_of_fanx ((vec 0), vertices p, edges p)))`,
5226   (* {{{ proof *)
5227   [
5228   REPEAT WEAK_STRIP_TAC;
5229   INTRO_TAC POLYHEDRON_CONFORMING_FAN [`p`];
5230   INTRO_TAC Polyhedron.POLYHEDRON_FAN [`p`;`(vec 0):real^3`];
5231   ASM_REWRITE_TAC[];
5232   REPEAT WEAK_STRIP_TAC;
5233   REWRITE_TAC[Hypermap.plain_hypermap];
5234   REWRITE_TAC[FUN_EQ_THM];
5235   REWRITE_TAC[I_DEF;o_DEF];
5236   GEN_TAC;
5237   TYPED_ABBREV_TAC `r = (\t. res (t ((vec 0):real^3) (vertices p) (edges p)) (d1_fan (((vec 0):real^3),(vertices p), edges p)))`;
5238   INTRO_TAC Fan.hypermap_of_fan_rep [`(vec 0):real^3`;`vertices p`;`edges p`;`r`];
5239   ASM_REWRITE_TAC[];
5240   REPEAT WEAK_STRIP_TAC;
5241   ASM_REWRITE_TAC[];
5242   INTRO_TAC POLYHEDRON_D1_D [`p`];
5243   ASM_REWRITE_TAC[];
5244   DISCH_TAC;
5245   GOAL_TERM (fun w -> (ASM_CASES_TAC ( env w `x IN d1_fan((vec 0),vertices p,edges p)`)));
5246     INTRO_TAC (GEN_ALL Fan.into_domain_e_fan) [`r`;`(vec 0):real^3`;`vertices p`;`edges p`];
5247     ASM_REWRITE_TAC[];
5248     DISCH_TAC;
5249     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `r e_fan x IN d1_fan (vec 0,vertices p,edges p)`) ASSUME_TAC));
5250       FIRST_X_ASSUM MATCH_MP_TAC;
5251       BY(ASM_REWRITE_TAC[]);
5252     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `r e_fan (r e_fan x) = e_fan  (vec 0) (vertices p) (edges p)  (r e_fan x)`) SUBST1_TAC));
5253       BY(ASM_MESON_TAC[ Fan.into_domain_efn_fan ]);
5254     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `r e_fan x = e_fan (vec 0) (vertices p) (edges p) x`) SUBST1_TAC));
5255       BY(ASM_MESON_TAC[ Fan.into_domain_efn_fan ]);
5256     BY(ASM_MESON_TAC[ Fan.plain_hypermap_fan; ]);
5257   INTRO_TAC (GEN_ALL Fan.id_enf_fan ) [`r`;`(vec 0):real^3`;`vertices p`;`edges p`;`x`];
5258   BY(ASM_SIMP_TAC[])
5259   ]);;
5260   (* }}} *)
5261
5262 let POLYHEDRON_NODE_3 = prove_by_refinement(
5263   `!(p:real^3->bool) x. bounded p /\ polyhedron p /\ vec 0 IN interior p /\
5264     x IN d_fan (vec 0,vertices p,edges p) ==>
5265     3 <= CARD (node (hypermap1_of_fanx (vec 0,vertices p,edges p)) x)`,
5266   (* {{{ proof *)
5267   [
5268   REPEAT WEAK_STRIP_TAC;
5269   INTRO_TAC POLYHEDRON_CONFORMING_FAN [`p`];
5270   ASM_REWRITE_TAC[];
5271   DISCH_TAC;
5272   INTRO_TAC Polyhedron.POLYHEDRON_FAN [`p`;`(vec 0):real^3`];
5273   ASM_REWRITE_TAC[];
5274   REPEAT WEAK_STRIP_TAC;
5275   INTRO_TAC Polyhedron.BSXAQBQ [`p`];
5276   ASM_SIMP_TAC[];
5277   DISCH_TAC;
5278   MATCH_MP_TAC (arith `~(u <= 2) ==> (3 <= u)`);
5279   DISCH_TAC;
5280   INTRO_TAC Conforming.SUM_AZIM_FAN_OF_NODE_EQ_2PI_I_FAN [`(vec 0):real^3`;`vertices p`;`edges p`;`node (hypermap1_of_fanx ((vec 0):real^3,vertices p,edges p)) x`];
5281   ASM_REWRITE_TAC[];
5282   (ASM_SIMP_TAC[ Polyhedron.CARD_SET_OF_EDGE_INEQ_1_POLYHEDRON ]);
5283   REWRITE_TAC[ GSYM Hypermap.lemma_in_node_set ];
5284   TYPED_ABBREV_TAC `r = (\t. res (t ((vec 0):real^3) (vertices p) (edges p)) (d1_fan (((vec 0):real^3),(vertices p), edges p)))`;
5285   INTRO_TAC Fan.hypermap_of_fan_rep [`(vec 0):real^3`;`vertices p`;`edges p`;`r`];
5286   ASM_REWRITE_TAC[];
5287   REPEAT WEAK_STRIP_TAC;
5288   FIRST_X_ASSUM MP_TAC;
5289   ASM_REWRITE_TAC[];
5290   MATCH_MP_TAC (arith `(a < b) ==> ~(a = b)`);
5291   MATCH_MP_TAC REAL_LTE_TRANS;
5292   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `sum (node (hypermap1_of_fanx (vec 0,vertices p,edges p)) x) (\y. pi)`)));
5293   CONJ_TAC;
5294     MATCH_MP_TAC SUM_LT_ALL;
5295     BETA_TAC;
5296     CONJ_TAC;
5297       BY(REWRITE_TAC[ Hypermap.NODE_FINITE ]);
5298     CONJ_TAC;
5299       REWRITE_TAC[ Misc_defs_and_lemmas.EMPTY_EXISTS ];
5300       BY(MESON_TAC[ Hypermap.node_refl ]);
5301     REPEAT WEAK_STRIP_TAC;
5302     FIRST_X_ASSUM MATCH_MP_TAC;
5303     BY(ASM_MESON_TAC[ Hypermap.lemma_node_subset ; SUBSET; IN ]);
5304   GMATCH_SIMP_TAC SUM_CONST;
5305   REWRITE_TAC[ Hypermap.NODE_FINITE ];
5306   GMATCH_SIMP_TAC REAL_LE_RMUL_EQ;
5307   REWRITE_TAC[PI_POS];
5308   BY(ASM_MESON_TAC[ REAL_OF_NUM_LE ])
5309   ]);;
5310   (* }}} *)
5311
5312 let POLYHEDRON_TGJISOK = prove_by_refinement(
5313   `!(p:real^3->bool) H. bounded p /\ polyhedron p /\ vec 0 IN interior p /\
5314     (H= hypermap1_of_fanx ((vec 0), vertices p, edges p)) ==>
5315     CARD (dart (H)) <= 6 * number_of_faces H - 12`,
5316   (* {{{ proof *)
5317   [
5318   REPEAT WEAK_STRIP_TAC;
5319   MATCH_MP_TAC Hypermap.lemmaTGJISOK;
5320   INTRO_TAC POLYHEDRON_CONFORMING_FAN [`p`];
5321   ASM_REWRITE_TAC[];
5322   DISCH_TAC;
5323   INTRO_TAC Polyhedron.POLYHEDRON_FAN [`p`;`(vec 0):real^3`];
5324   ASM_REWRITE_TAC[];
5325   DISCH_TAC;
5326   SUBCONJ_TAC;
5327     MATCH_MP_TAC Conforming.WGVWSKE;
5328     BY(ASM_REWRITE_TAC[ ]);
5329   DISCH_TAC;
5330   SUBCONJ_TAC;
5331     MATCH_MP_TAC POLYHEDRON_PLAIN;
5332     BY(ASM_REWRITE_TAC[]);
5333   DISCH_TAC;
5334   SUBCONJ_TAC;
5335     BY(ASM_SIMP_TAC[ Conforming.GGRLKHP ]);
5336   DISCH_TAC;
5337   GEN_TAC;
5338   DISCH_TAC;
5339   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`dart (hypermap1_of_fanx ((vec 0),vertices p,edges p)) = d_fan ((vec 0),vertices p,edges p)`) ASSUME_TAC));
5340     BY(ASM_MESON_TAC[ Fan.hypermap_of_fan_rep ]);
5341   TYPED_ABBREV_TAC `r = (\t. res (t ((vec 0):real^3) (vertices p) (edges p)) (d1_fan (((vec 0):real^3),(vertices p), edges p)))`;
5342   INTRO_TAC Fan.hypermap_of_fan_rep [`(vec 0):real^3`;`vertices p`;`edges p`;`r`];
5343   ASM_REWRITE_TAC[];
5344   REPEAT WEAK_STRIP_TAC;
5345   FIRST_X_ASSUM MP_TAC;
5346   ASM_REWRITE_TAC[];
5347   INTRO_TAC POLYHEDRON_D1_D [`p`];
5348   ASM_REWRITE_TAC[];
5349   DISCH_TAC;
5350   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `r e_fan x = e_fan (vec 0) (vertices p) (edges p) x`) SUBST1_TAC));
5351     BY((ASM_MESON_TAC[ Fan.into_domain_efn_fan ]));
5352   DISCH_TAC;
5353   MATCH_MP_TAC (TAUT `a /\ b ==> b/\ a`);
5354   CONJ_TAC;
5355     BY(ASM_MESON_TAC[POLYHEDRON_NODE_3]);
5356   BY(ASM_MESON_TAC[ Fan.e_fan_no_fix_point ])
5357   ]);;
5358   (* }}} *)
5359
5360 let EDGE_PAIR_pr23 = prove_by_refinement(
5361   `!x V E d d'.
5362     e_fan x V E d = d' ==>
5363     pr2 d = pr3 d' /\ pr3 d = pr2 d'`,
5364   (* {{{ proof *)
5365   [
5366   REWRITE_TAC[ Fan.e_fan ];
5367   REPEAT GEN_TAC;
5368   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?x0 v w w1. d = (x0,v,w,w1)`) MP_TAC));
5369     BY(MESON_TAC[PAIR_SURJECTIVE]);
5370   WEAK_STRIP_TAC;
5371   ASM_REWRITE_TAC[];
5372   DISCH_THEN (fun t -> ONCE_REWRITE_TAC[GSYM t ]);
5373   REWRITE_TAC[ Fan.pr2; Fan.pr3];
5374   ]);;
5375   (* }}} *)
5376
5377 let EDGE_pr23 = prove_by_refinement(
5378   `!x V E y y1.
5379           FAN (x,V,E) /\
5380           (!v. v IN V ==> CARD (set_of_edge v V E) > 1) /\
5381           y IN d1_fan (x,V,E) /\
5382           y1 IN d1_fan (x,V,E) /\
5383           {pr2 y,pr3 y} = {pr2 y1,pr3 y1} /\ ~(y = y1) ==>
5384        y = edge_map (hypermap1_of_fanx (x,V,E)) y1`,
5385   (* {{{ proof *)
5386   [
5387   REPEAT WEAK_STRIP_TAC;
5388   TYPED_ABBREV_TAC `r = (\t. res (t (x:real^3) (V:real^3->bool) E ) (d1_fan (x,V,E)))`;
5389   INTRO_TAC Fan.hypermap_of_fan_rep [`x`;`V`;`E`;`r`];
5390   ASM_REWRITE_TAC[];
5391   REPEAT WEAK_STRIP_TAC;
5392   ASM_REWRITE_TAC[];
5393   INTRO_TAC (GEN_ALL Fan.into_domain_efn_fan) [`r`;`x`;`V`;`E`];
5394   ASM_REWRITE_TAC[];
5395   DISCH_THEN (fun t -> ASM_SIMP_TAC[t]);
5396   FIRST_X_ASSUM_ST `pr2` MP_TAC;
5397   REWRITE_TAC[ Geomdetail.PAIR_EQ_EXPAND ];
5398   DISCH_THEN DISJ_CASES_TAC;
5399     PROOF_BY_CONTR_TAC;
5400     FIRST_X_ASSUM kill;
5401     FIRST_X_ASSUM_ST `~` MP_TAC;
5402     REWRITE_TAC[];
5403     MATCH_MP_TAC Planarity.EQ_PAIR_IMP_EQ_4_FAN;
5404     ASM_REWRITE_TAC[];
5405     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `x`)));
5406     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `V`)));
5407     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `E`)));
5408     ASM_REWRITE_TAC[];
5409     BY(ASM_MESON_TAC[ Fan.dartset_fully_surrounded_is_non_isolated_fan; PAIR_EQ ]);
5410   INTRO_TAC EDGE_PAIR_pr23 [`x`;`V`;`E`;`y1`;`e_fan x V E y1`];
5411   ASM_REWRITE_TAC[];
5412   REPEAT WEAK_STRIP_TAC;
5413   TYPED_ABBREV_TAC `y2 = e_fan x V E y1`;
5414   MATCH_MP_TAC Planarity.EQ_PAIR_IMP_EQ_4_FAN;
5415   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `x`)));
5416   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `V`)));
5417   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `E`)));
5418   ASM_REWRITE_TAC[];
5419   BY(ASM_MESON_TAC[ Fan.dartset_fully_surrounded_is_non_isolated_fan; Fan.into_domain_e_fan ; Fan.into_domain_efn_fan ])
5420   ]);;
5421   (* }}} *)
5422
5423 let SIMPLE_FACE_EDGE_INJ = prove_by_refinement(
5424   `!H (y:A) y1. simple_hypermap H /\ (1 < CARD(node H (face_map H y))) /\
5425     (y IN dart H) /\
5426     (y IN face H y1) ==>
5427     ~(y = edge_map H y1)`,
5428   (* {{{ proof *)
5429   [
5430   REPEAT WEAK_STRIP_TAC;
5431   SUBGOAL_THEN `(y1:A) = (node_map H o face_map H) y` MP_TAC;
5432     ONCE_REWRITE_TAC[ GSYM Hypermap.inverse_hypermap_maps ];
5433     ONCE_REWRITE_TAC[ EQ_SYM_EQ ];
5434     GMATCH_SIMP_TAC PERMUTES_INVERSE_EQ;
5435     ASM_REWRITE_TAC[];
5436     BY(MESON_TAC [Hypermap.edge_map_and_darts]);
5437   REWRITE_TAC[o_THM];
5438   TYPED_ABBREV_TAC `(y2:A) = face_map H y`;
5439   DISCH_TAC;
5440   SUBGOAL_THEN `y2 = node_map H (y2:A)` ASSUME_TAC;
5441     MATCH_MP_TAC Hypermap_and_fan.SIMPLE_HYPERMAP_IMP_FACE_INJ;
5442     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `H`)));
5443     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `y2`)));
5444     ASM_REWRITE_TAC[];
5445     CONJ_TAC;
5446       BY(ASM_MESON_TAC[ Hypermap.lemma_dart_invariant ]);
5447     CONJ_TAC;
5448       BY(REWRITE_TAC[ Hypermap.node_refl ]);
5449     CONJ_TAC;
5450       BY(ASM_MESON_TAC [Hypermap.lemma_in_node2; Hypermap.POWER_1]);
5451     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `face H y2 = face H y`) SUBST1_TAC));
5452       ONCE_REWRITE_TAC[ EQ_SYM_EQ ];
5453       MATCH_MP_TAC Hypermap.lemma_face_identity;
5454       BY(ASM_MESON_TAC[ Hypermap.lemma_in_face ; Hypermap.POWER_1 ]);
5455     ONCE_REWRITE_TAC[ EQ_SYM_EQ ];
5456     MATCH_MP_TAC Hypermap.lemma_face_identity;
5457     BY(ASM_MESON_TAC[]);
5458   SUBGOAL_THEN `node H (y2:A) = {y2 }` ASSUME_TAC;
5459     REWRITE_TAC[ Hypermap.node ];
5460     GMATCH_SIMP_TAC Hypermap.orbit_cyclic;
5461     EXISTS_TAC `1`;
5462     REWRITE_TAC[arith `~(1=0)`;Hypermap.POWER_1];
5463     CONJ_TAC;
5464       BY(ASM_MESON_TAC[]);
5465     ONCE_REWRITE_TAC[FUN_EQ_THM];
5466     REWRITE_TAC[REWRITE_RULE[IN] IN_SING;IN_ELIM_THM];
5467     REWRITE_TAC[ arith `k < 1 <=> k=0`];
5468     BY(MESON_TAC[ Hypermap.POWER_0 ; I_DEF]);
5469   FIRST_X_ASSUM_ST `CARD` MP_TAC;
5470   ASM_REWRITE_TAC[];
5471   REWRITE_TAC[ Hypermap.CARD_SINGLETON ];
5472   BY(ARITH_TAC)
5473   ]);;
5474   (* }}} *)
5475
5476 let INJ_EDGES_FACE_pr23 = prove_by_refinement(
5477   `!p:real^3->bool f y1 y.
5478         bounded p /\ polyhedron p /\ vec 0 IN interior p /\
5479         f IN face_set (hypermap1_of_fanx  (vec 0,vertices p,edges p)) /\
5480         y IN f /\
5481         y1 IN f /\
5482         { pr2 y,pr3 y} = {pr2 y1,pr3 y1} ==>
5483     (y = y1)
5484  `,
5485   (* {{{ proof *)
5486   [
5487   REPEAT WEAK_STRIP_TAC;
5488   PROOF_BY_CONTR_TAC;
5489   INTRO_TAC POLYHEDRON_CONFORMING_FAN [`p`];
5490   ASM_REWRITE_TAC[];
5491   DISCH_TAC;
5492   INTRO_TAC Polyhedron.POLYHEDRON_FAN [`p`;`(vec 0):real^3`];
5493   ASM_REWRITE_TAC[];
5494   DISCH_TAC;
5495   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(y = edge_map (hypermap1_of_fanx  (vec 0,vertices p,edges p)) y1)`) ASSUME_TAC));
5496     MATCH_MP_TAC SIMPLE_FACE_EDGE_INJ;
5497     CONJ_TAC;
5498       BY(ASM_MESON_TAC[ Conforming.SRPRNPL ]);
5499     CONJ_TAC;
5500       MATCH_MP_TAC (arith `3 <= x ==> 1 < x`);
5501       MATCH_MP_TAC POLYHEDRON_NODE_3;
5502       ASM_REWRITE_TAC[];
5503       TYPED_ABBREV_TAC `H = hypermap1_of_fanx  (vec 0,vertices p,edges p)`;
5504       GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`d_fan (vec 0,vertices p,edges p)= dart H `) ASSUME_TAC));
5505         BY(ASM_MESON_TAC [Fan.hypermap_of_fan_rep]);
5506       ASM_REWRITE_TAC[];
5507       GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `y IN dart H`) ASSUME_TAC));
5508         BY(ASM_MESON_TAC[ Hypermap.lemma_face_representation; Hypermap.lemma_face_subset; SUBSET]);
5509       BY(ASM_SIMP_TAC[ Hypermap.lemma_dart_invariant ]);
5510     CONJ_TAC;
5511       BY(ASM_MESON_TAC[ Hypermap.lemma_face_representation; Hypermap.lemma_face_subset; SUBSET]);
5512     FIRST_X_ASSUM (fun t -> MP_TAC (MATCH_MP Hypermap.lemma_face_representation t));
5513     REPEAT WEAK_STRIP_TAC;
5514     BY(ASM_MESON_TAC[ Hypermap.face_refl; Hypermap.lemma_face_identity]);
5515   COMMENT "1";
5516   FIRST_X_ASSUM MP_TAC;
5517   REWRITE_TAC[];
5518   MATCH_MP_TAC EDGE_pr23;
5519   ASM_REWRITE_TAC[];
5520   TYPED_ABBREV_TAC `H = hypermap1_of_fanx  (vec 0,vertices p,edges p)`;
5521   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`d_fan (vec 0,vertices p,edges p)= dart H `) ASSUME_TAC));
5522     BY(ASM_MESON_TAC [Fan.hypermap_of_fan_rep]);
5523   INTRO_TAC POLYHEDRON_D1_D[`p`];
5524   ASM_REWRITE_TAC[];
5525   DISCH_TAC;
5526   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `y IN dart H /\ y1 IN dart H`) ASSUME_TAC));
5527     BY(ASM_MESON_TAC[ Hypermap.lemma_face_representation; Hypermap.lemma_face_subset; SUBSET]);
5528   ASM_REWRITE_TAC[];
5529   CONJ_TAC;
5530     BY(ASM_SIMP_TAC[ Polyhedron.CARD_SET_OF_EDGE_INEQ_1_POLYHEDRON ]);
5531   BY(ASM_MESON_TAC[])
5532   ]);;
5533   (* }}} *)
5534
5535 let BIJ_EDGES_DART_FACE = prove_by_refinement(
5536   `!p:real^3->bool f f1.
5537      bounded (p:real^3->bool) /\ polyhedron p /\ vec 0 IN interior p
5538      /\ f IN face_set (hypermap1_of_fanx  (vec 0,vertices p,edges p))
5539      /\ f1 facet_of p /\
5540     fchanged f1 =dartset_leads_into_fan (vec 0) (vertices p) (edges p) f
5541     ==>
5542     (?b. BIJ b (edges f1) f)`,
5543   (* {{{ proof *)
5544   [
5545   REPEAT WEAK_STRIP_TAC;
5546   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `edges f1 = {{pr2 e,pr3 e} | e IN f}`) SUBST1_TAC));
5547     ASM_SIMP_TAC[GSYM Cfyxfty.CFYXFTY0];
5548     BY(ASM_SIMP_TAC[GSYM Cfyxfty.CFYXFTY1]);
5549   MATCH_MP_TAC BIJ_SYM;
5550   EXISTS_TAC (`(\e. {pr2 e, pr3 e}):real^3#real^3#real^3#real^3->real^3->bool`);
5551   REWRITE_TAC[BIJ;SURJ];
5552   MATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`);
5553   SUBCONJ_TAC;
5554     REWRITE_TAC[IN;IN_ELIM_THM];
5555     BY(MESON_TAC[]);
5556   DISCH_TAC;
5557   REWRITE_TAC[INJ];
5558   (ASM_REWRITE_TAC[]);
5559   BY(ASM_MESON_TAC[ INJ_EDGES_FACE_pr23])
5560   ]);;
5561   (* }}} *)
5562
5563 let SEGMENT_EDGE_ONTO = prove_by_refinement(
5564   `!(p:real^3->bool) e.
5565     polyhedron p /\ bounded p /\
5566     e edge_of p ==>
5567     (?v w. e = segment [v,w])`,
5568   (* {{{ proof *)
5569   [
5570   BY(ASM_MESON_TAC[ Polyhedron.EXPAND_EDGE_POLYTOPE; edge_of; POLYTOPE_EQ_BOUNDED_POLYHEDRON])
5571   ]);;
5572   (* }}} *)
5573
5574 let EDGE_OF_FACET_OF = prove_by_refinement(
5575   `!(p:real^3->bool) c f.
5576     polyhedron p /\ bounded p /\ (vec 0 IN interior p) /\ c facet_of p ==>
5577     ((e edge_of c) <=> (e facet_of c))`,
5578   (* {{{ proof *)
5579   [
5580   REPEAT WEAK_STRIP_TAC;
5581   REWRITE_TAC[edge_of;facet_of];
5582   MATCH_MP_TAC (TAUT `(a ==> (b <=>c)) ==> ((a /\ b) <=> (a /\ c))`);
5583   DISCH_TAC;
5584   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`aff_dim c = &2`) ASSUME_TAC));
5585     BY(ASM_MESON_TAC[ FACET_AFF_DIM_2 ]);
5586   ASM_REWRITE_TAC[];
5587   SUBGOAL_THEN `int_of_num 2 - &1 = &1` SUBST1_TAC;
5588     BY(INT_ARITH_TAC);
5589   MATCH_MP_TAC (TAUT `(a ==> (c)) ==> ((a) <=> (c /\ a))`);
5590   ONCE_REWRITE_TAC [ GSYM AFF_DIM_POS_LE ];
5591   BY(INT_ARITH_TAC)
5592   ]);;
5593   (* }}} *)
5594
5595 let EDGE_OF_FACET_EDGE = prove_by_refinement(
5596   `!(p:real^3->bool) c e.
5597    polyhedron p /\ bounded p /\ (vec 0 IN interior p) /\ c facet_of p /\ e facet_of c ==>
5598     ((e edge_of p))
5599     `,
5600   (* {{{ proof *)
5601   [
5602   REPEAT WEAK_STRIP_TAC;
5603   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`e edge_of c`) MP_TAC));
5604     BY(ASM_MESON_TAC[EDGE_OF_FACET_OF]);
5605   REWRITE_TAC[ edge_of ];
5606   BY(ASM_MESON_TAC[ FACE_OF_TRANS ; facet_of ])
5607   ]);;
5608   (* }}} *)
5609
5610 let BIJ_FACET2_EDGE = prove_by_refinement(
5611   `!(p:real^3 -> bool) c.
5612    polyhedron p /\ bounded p /\ (vec 0 IN interior p) /\ c facet_of p ==>
5613     (?b. BIJ b {e | e IN edges c } {u | u facet_of c} )
5614     `,
5615   (* {{{ proof *)
5616   [
5617   REPEAT WEAK_STRIP_TAC;
5618   (REWRITE_TAC[edges;IN_ELIM_THM]);
5619   EXISTS_TAC ( `((hull) convex):(real^3->bool)->real^3->bool`);
5620   REWRITE_TAC[BIJ];
5621   REWRITE_TAC[INJ];
5622   SUBCONJ_TAC;
5623     REWRITE_TAC[IN_ELIM_THM];
5624     SUBCONJ_TAC;
5625       BY(ASM_MESON_TAC[ SEGMENT_CONVEX_HULL ; EDGE_OF_FACET_OF ]);
5626     DISCH_TAC;
5627     BY(ASM_MESON_TAC[ SEGMENT_CONVEX_HULL ; SEGMENT_EQ; Collect_geom.PER_SET2 ]);
5628   REWRITE_TAC[SURJ];
5629   REPEAT WEAK_STRIP_TAC;
5630   ASM_REWRITE_TAC[];
5631   REWRITE_TAC[IN_ELIM_THM];
5632   REPEAT WEAK_STRIP_TAC;
5633   MATCH_MP_TAC (MESON[] (`(?v w. p v w /\ R {v,w}) ==> (?y. (?v w. p v w /\ y = {v,w}) /\ R y)`));
5634   INTRO_TAC SEGMENT_EDGE_ONTO [`p`;`x`];
5635   ASM_REWRITE_TAC[];
5636   ANTS_TAC;
5637     MATCH_MP_TAC EDGE_OF_FACET_EDGE;
5638     BY(ASM_MESON_TAC[]);
5639   BY(ASM_MESON_TAC[ SEGMENT_CONVEX_HULL ; EDGE_OF_FACET_OF ])
5640   ]);;
5641   (* }}} *)
5642
5643 let HYPERFACE_EXISTS = prove_by_refinement(
5644  `!P:real^3->bool U.
5645      bounded (P:real^3->bool) /\ polyhedron P /\ vec 0 IN interior P /\
5646         topological_component_yfan (vec 0,vertices P,edges P) U ==>
5647    (?!f. f IN (face_set (hypermap1_of_fanx (vec 0,vertices P,edges P))) /\
5648       (dartset_leads_into_fan (vec 0) (vertices P) (edges P) f = U))`,
5649   (* {{{ proof *)
5650   [
5651   REPEAT WEAK_STRIP_TAC;
5652   INTRO_TAC Polyhedron.WBLARHH_BIJ [`P`];
5653   ASM_REWRITE_TAC[BIJ;INJ;SURJ];
5654   BY(ASM_MESON_TAC[IN])
5655   ]);;
5656   (* }}} *)
5657
5658 let BIJ_DART_POLYEDGE = prove_by_refinement(
5659   `!P:real^3->bool.
5660      bounded (P:real^3->bool) /\ polyhedron P /\ vec 0 IN interior P ==>
5661    (?b. BIJ b (dart(hypermap1_of_fanx (vec 0,vertices P,edges P)))
5662       {(e,f1) | e facet_of f1 /\ f1 facet_of P })`,
5663   (* {{{ proof *)
5664   [
5665   REPEAT WEAK_STRIP_TAC;
5666   MATCH_MP_TAC (INST_TYPE [`:(real^3)->bool`,`:C`] PREIMAGE_BIJ);
5667   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `IMAGE fchanged { f1 | f1 facet_of P }`)));
5668   TYPED_ABBREV_TAC `H = hypermap1_of_fanx (vec 0,vertices P,edges P)`;
5669   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `dartset_leads_into_fan (vec 0) (vertices P) (edges P) o (face H)`)));
5670   EXISTS_TAC (`(fchanged o SND): (real^3->bool)#(real^3->bool)->real^3->bool`);
5671   SUBCONJ_TAC;
5672     REWRITE_TAC[IN_IMAGE;o_THM];
5673     REWRITE_TAC[IN_ELIM_THM];
5674     REPEAT WEAK_STRIP_TAC;
5675     INTRO_TAC Polyhedron.WBLARHH [`P`];
5676     ASM_REWRITE_TAC[];
5677     DISCH_THEN (C INTRO_TAC[`(face H a)`]);
5678     ASM_REWRITE_TAC[ GSYM Hypermap.lemma_in_face_set ];
5679     REWRITE_TAC[ EXISTS_UNIQUE_THM ];
5680     REPEAT WEAK_STRIP_TAC;
5681     BY(ASM_MESON_TAC[]);
5682   DISCH_TAC;
5683   COMMENT "1";
5684   SUBCONJ_TAC;
5685     REWRITE_TAC[IN_IMAGE;IN_ELIM_THM;o_THM];
5686     BY(ASM_MESON_TAC[SND]);
5687   DISCH_TAC;
5688   GEN_TAC;
5689   REWRITE_TAC[IN_IMAGE;IN_ELIM_THM];
5690   REPEAT WEAK_STRIP_TAC;
5691   COMMENT "1";
5692   GOAL_TERM (fun w -> (MATCH_MP_TAC ( ISPEC ( env w `{e | e facet_of x}`) BIJ_TRANS)));
5693   MATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`);
5694   CONJ_TAC;
5695     MATCH_MP_TAC BIJ_SYM;
5696     EXISTS_TAC `FST:((real^3)->bool)#((real^3)->bool) -> real^3 -> bool`;
5697     REWRITE_TAC[ Misc_defs_and_lemmas.preimage ];
5698     REWRITE_TAC[o_THM; IN_SING ];
5699     REWRITE_TAC[BIJ];
5700     REWRITE_TAC[INJ];
5701     SUBCONJ_TAC;
5702       REWRITE_TAC[IN_ELIM_THM];
5703       SUBCONJ_TAC;
5704         X_GENv_TAC "ef";
5705         REPEAT WEAK_STRIP_TAC;
5706         ASM_REWRITE_TAC[];
5707         FIRST_X_ASSUM MP_TAC;
5708         ASM_REWRITE_TAC[];
5709         DISCH_TAC;
5710         GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `f1 = x`)));
5711           BY(ASM_MESON_TAC[]);
5712         MATCH_MP_TAC Polyhedron.FCHANGED_ONE_TO_ONE;
5713         GOAL_TERM (fun w -> (EXISTS_TAC ( env w `P`)));
5714         ASM_REWRITE_TAC[];
5715         REWRITE_TAC[INTER_IDEMPOT];
5716         REWRITE_TAC[ Misc_defs_and_lemmas.EMPTY_EXISTS];
5717         MATCH_MP_TAC Polyhedron.EXISTS_POINT_IN_FCHANGED;
5718         BY(ASM_MESON_TAC[]);
5719       REPEAT WEAK_STRIP_TAC;
5720       ASM_REWRITE_TAC[PAIR_EQ];
5721       REPEAT (FIRST_X_ASSUM_ST `FST` MP_TAC);
5722       REPEAT (FIRST_X_ASSUM_ST `SND` MP_TAC);
5723       ASM_REWRITE_TAC[FST;SND];
5724       REPEAT WEAK_STRIP_TAC;
5725       ASM_REWRITE_TAC[];
5726       MATCH_MP_TAC Polyhedron.FCHANGED_ONE_TO_ONE;
5727       GOAL_TERM (fun w -> (EXISTS_TAC ( env w `P`)));
5728       ASM_REWRITE_TAC[];
5729       REWRITE_TAC[ INTER_IDEMPOT; Misc_defs_and_lemmas.EMPTY_EXISTS ];
5730       MATCH_MP_TAC Polyhedron.EXISTS_POINT_IN_FCHANGED;
5731       BY(ASM_MESON_TAC[]);
5732     DISCH_TAC;
5733     REWRITE_TAC[SURJ];
5734     ASM_REWRITE_TAC[];
5735     REWRITE_TAC[IN_ELIM_THM];
5736     REPEAT WEAK_STRIP_TAC;
5737     BY(ASM_MESON_TAC[FST;SND]);
5738   COMMENT "1g";
5739   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `topological_component_yfan (vec 0,vertices P,edges P) c`) ASSUME_TAC));
5740     BY(ASM_MESON_TAC[Polyhedron.AMHFNXP_BIJ; BIJ;SURJ;IN]);
5741   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?!f. f IN face_set (hypermap1_of_fanx  (vec 0,vertices P,edges P)) /\ (dartset_leads_into_fan (vec 0) (vertices P) (edges P) f = c)`) MP_TAC));
5742     MATCH_MP_TAC HYPERFACE_EXISTS;
5743     BY(ASM_REWRITE_TAC[]);
5744   REWRITE_TAC[ EXISTS_UNIQUE ];
5745   REPEAT WEAK_STRIP_TAC;
5746   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(preimage (dart H)       (dartset_leads_into_fan (vec 0) (vertices P) (edges P) o face H)      {c}) = f`) SUBST1_TAC));
5747     REWRITE_TAC[Misc_defs_and_lemmas.preimage];
5748     REWRITE_TAC[o_THM;IN_SING];
5749     ONCE_REWRITE_TAC[FUN_EQ_THM];
5750     GEN_TAC;
5751     REWRITE_TAC[IN_ELIM_THM];
5752     REWRITE_TAC[ Geomdetail.EQ_EXPAND ];
5753     CONJ_TAC;
5754       REPEAT WEAK_STRIP_TAC;
5755       GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `face H x' = f`) ASSUME_TAC));
5756         FIRST_X_ASSUM MATCH_MP_TAC;
5757         BY(ASM_MESON_TAC[IN;Hypermap.lemma_in_face_set;Conforming.identity_face_in_face_set]);
5758       BY(ASM_MESON_TAC[IN;Hypermap.face_refl;Hypermap.lemma_in_face_set;Conforming.identity_face_in_face_set]);
5759     BY(ASM_MESON_TAC[IN;Hypermap.face_refl;Hypermap.lemma_in_face_set;Conforming.identity_face_in_face_set]);
5760   COMMENT "1h";
5761   GOAL_TERM (fun w -> (MATCH_MP_TAC (ISPEC ( env w`{e | e IN edges x}`) BIJ_TRANS)));
5762   CONJ2_TAC;
5763     MATCH_MP_TAC BIJ_FACET2_EDGE;
5764     BY(ASM_MESON_TAC[]);
5765   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{e | e IN edges x} = edges x`) SUBST1_TAC));
5766     ONCE_REWRITE_TAC[FUN_EQ_THM];
5767     BY(REWRITE_TAC[IN_ELIM_THM;IN]);
5768   MATCH_MP_TAC BIJ_SYM;
5769   MATCH_MP_TAC BIJ_EDGES_DART_FACE;
5770   BY(ASM_MESON_TAC[])
5771   ]);;
5772   (* }}} *)
5773
5774 let FINITE_EDGE = prove_by_refinement(
5775   `!P:real^A->bool. polyhedron P  /\ bounded P ==>
5776     (!f. f facet_of P ==> FINITE { e | e facet_of f}) /\
5777         FINITE { f | f facet_of P } /\
5778    FINITE  {(f,e) | f facet_of P /\ e facet_of f}`,
5779   (* {{{ proof *)
5780   [
5781   REPEAT WEAK_STRIP_TAC;
5782   CONJ_TAC;
5783     REPEAT WEAK_STRIP_TAC;
5784     GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `{e' | e' facet_of f } SUBSET {e' | e' face_of P}`)));
5785       BY(ASM_MESON_TAC[FINITE_SUBSET; FINITE_POLYHEDRON_FACES ]);
5786     REWRITE_TAC[SUBSET;IN_ELIM_THM];
5787     BY(ASM_MESON_TAC[FACET_OF_IMP_FACE_OF; FACE_OF_TRANS; SUBSET]);
5788   CONJ_TAC;
5789     MATCH_MP_TAC FINITE_POLYTOPE_FACETS;
5790     BY(ASM_MESON_TAC[ POLYTOPE_EQ_BOUNDED_POLYHEDRON ]);
5791   GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w ` {(f,e) | f facet_of P /\ e facet_of f} SUBSET { f | f face_of P } CROSS {f | f face_of P}`)));
5792     BY(BY(ASM_MESON_TAC[ FINITE_SUBSET; FINITE_CROSS ; FINITE_POLYHEDRON_FACES ]));
5793   REWRITE_TAC[CROSS;SUBSET];
5794   REWRITE_TAC[IN_ELIM_THM];
5795   REPEAT WEAK_STRIP_TAC;
5796   BY(BY(ASM_MESON_TAC[PAIR; FACET_OF_IMP_FACE_OF; FACE_OF_TRANS]))
5797   ]);;
5798   (* }}} *)
5799
5800 let polyhedron_sum_sum_edge = prove_by_refinement(
5801   `!(P:real^3->bool) . bounded P /\ polyhedron P ==>
5802    sum {f | f facet_of P } (\f. &(CARD {e | e facet_of f })) =
5803      &( CARD {(f,e) | f facet_of P /\ e facet_of f})`,
5804   (* {{{ proof *)
5805   [
5806   REPEAT WEAK_STRIP_TAC;
5807   GMATCH_SIMP_TAC CARD_EQ_SUM;
5808   ASM_SIMP_TAC[FINITE_EDGE];
5809   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `sum {f,e | f facet_of P /\ e facet_of f} (\x. &1) = sum {f,e | f IN {f' | f facet_of P} /\ e IN {e' | e' facet_of f}} (\ (f,e). &1 )`) SUBST1_TAC));
5810     ONCE_REWRITE_TAC[ GSYM CARD_EQ_SUM ];
5811     BINOP_TAC;
5812       BY(REWRITE_TAC[IN_ELIM_THM]);
5813     REWRITE_TAC[FUN_EQ_THM];
5814     BY(REWRITE_TAC[ LAMBDA_PAIR ]);
5815   INTRO_TAC SUM_SUM_PRODUCT [`{f | f facet_of P}`;`\f. {e' | e' facet_of (f:real^3->bool)}`];
5816   DISCH_THEN (fun t -> MP_TAC (ISPEC (`(\ f e. &1):(real^3->bool)->(real^3->bool)->real`) t));
5817   ANTS_TAC;
5818     REWRITE_TAC[IN_ELIM_THM];
5819     ASM_SIMP_TAC[FINITE_EDGE];
5820     BY(ASM_MESON_TAC[FINITE_EDGE]);
5821   MATCH_MP_TAC (MESON[] (`(x = x') /\ (y = y') ==> ((x = y) ==> (x' = y'))`));
5822   CONJ_TAC;
5823     MATCH_MP_TAC SUM_EQ;
5824     REWRITE_TAC[IN_ELIM_THM];
5825     REPEAT WEAK_STRIP_TAC;
5826     GMATCH_SIMP_TAC CARD_EQ_SUM;
5827     BY(ASM_MESON_TAC[FINITE_EDGE]);
5828   BETA_TAC;
5829   BY(REWRITE_TAC[IN_ELIM_THM])
5830   ]);;
5831   (* }}} *)
5832
5833 let polyhedron_edge_sum = prove_by_refinement(
5834  `(!(P:real^3->bool) n. bounded P /\ polyhedron P /\ (vec 0) IN interior P /\
5835      {f | f facet_of P} HAS_SIZE n /\ (2 <= n) ==>
5836      sum {f | f facet_of P } (\f. &(CARD {e | e facet_of f })) <= &6 * &n - &12)`,
5837   (* {{{ proof *)
5838   [
5839   REPEAT WEAK_STRIP_TAC;
5840   ASM_SIMP_TAC[polyhedron_sum_sum_edge];
5841   TYPED_ABBREV_TAC `m = CARD {f,e | f facet_of (P:real^3->bool) /\ e facet_of f}`;
5842   GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `m <= 6 * n - 12`)));
5843     REWRITE_TAC[arith `&m <= x - &12 <=> &m + &12 <= x`];
5844     REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_MUL;REAL_OF_NUM_LE];
5845     FIRST_X_ASSUM_ST `2` MP_TAC;
5846     BY(ARITH_TAC);
5847   TYPED_ABBREV_TAC `H = hypermap1_of_fanx (vec 0,vertices P,edges (P:real^3->bool))`;
5848   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `n = number_of_faces H`) SUBST1_TAC));
5849     REWRITE_TAC[ Hypermap.number_of_faces ];
5850     FIRST_X_ASSUM_ST `HAS_SIZE` MP_TAC;
5851     REWRITE_TAC[HAS_SIZE];
5852     REPEAT WEAK_STRIP_TAC;
5853     EXPAND_TAC "n";
5854     MATCH_MP_TAC Misc_defs_and_lemmas.BIJ_CARD;
5855     ASM_REWRITE_TAC[];
5856     BY(ASM_MESON_TAC[ BIJ_FACET_HYPERFACE]);
5857   GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `m = CARD(dart H)`)));
5858     BY(ASM_MESON_TAC[POLYHEDRON_TGJISOK]);
5859   EXPAND_TAC "m";
5860   MATCH_MP_TAC Misc_defs_and_lemmas.BIJ_CARD;
5861   ASM_SIMP_TAC[FINITE_EDGE];
5862   GOAL_TERM (fun w -> (MATCH_MP_TAC (ISPEC ( env w`{(e,f) | e facet_of f /\ f facet_of P }`) BIJ_TRANS)));
5863   CONJ_TAC;
5864     GOAL_TERM (fun w -> (EXISTS_TAC ( env w`(\x. SND x,FST x): (real^3->bool)#(real^3->bool)->(real^3->bool)#(real^3->bool)`)));
5865     REWRITE_TAC[BIJ;INJ;SURJ;IN_ELIM_THM;FST;SND;PAIR_EQ];
5866     BY(ASM_MESON_TAC[PAIR;FST;SND]);
5867   MATCH_MP_TAC BIJ_SYM;
5868   EXPAND_TAC "H";
5869   MATCH_MP_TAC BIJ_DART_POLYEDGE;
5870   BY(ASM_REWRITE_TAC[])
5871   ]);;
5872   (* }}} *)
5873
5874
5875 let  RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT_ALT  = prove_by_refinement(
5876   `!(V:A->bool) (P:real^B ->bool) h a b p v0.
5877     FINITE V /\
5878    (!v. (v IN V ) ==> (h v  = { p | a v dot p <= b v })) /\
5879    P = INTERS (IMAGE h V) /\
5880   (v0 IN V) /\ a v0 dot p = b v0 /\
5881   (!w. (w IN V) /\ ~(w = v0) ==> a w dot p < b w) ==>
5882   (p IN relative_interior (P INTER { p | a v0 dot p= b v0}))`,
5883   (* {{{ proof *)
5884   [
5885   REPEAT WEAK_STRIP_TAC;
5886   REWRITE_TAC[IN_RELATIVE_INTERIOR];
5887   REWRITE_TAC[IN_INTER;IN_INTERS;IN_IMAGE];
5888   REWRITE_TAC[IN_ELIM_THM];
5889   SUBCONJ_TAC;
5890     ASM_REWRITE_TAC[];
5891     ASM_REWRITE_TAC[IN_INTERS;IN_IMAGE];
5892     ASM_REWRITE_TAC[IN_ELIM_THM];
5893     REPEAT WEAK_STRIP_TAC;
5894     ASM_SIMP_TAC[];
5895     REWRITE_TAC[IN_ELIM_THM];
5896     GOAL_TERM (fun w -> (ASM_CASES_TAC ( env w `x = v0`)));
5897       BY(ASM_REWRITE_TAC[arith `u <= u`]);
5898     MATCH_MP_TAC (arith `x < y ==> x <= y`);
5899     BY(ASM_SIMP_TAC[]);
5900   DISCH_TAC;
5901   COMMENT "1";
5902   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(INTERS (IMAGE h (V DIFF {v0})) INTER {p | a v0 dot p = b v0} SUBSET P INTER {p | a v0 dot p = b v0})`) ASSUME_TAC));
5903     ASM_REWRITE_TAC[SUBSET;IN_INTER;IN_INTERS;IN_IMAGE;IN_DIFF;IN_SING];
5904     ASM_REWRITE_TAC[IN_ELIM_THM];
5905     REPEAT WEAK_STRIP_TAC;
5906     ASM_REWRITE_TAC[];
5907     REPEAT WEAK_STRIP_TAC;
5908     ASM_SIMP_TAC[];
5909     REWRITE_TAC[IN_ELIM_THM];
5910     GOAL_TERM (fun w -> (ASM_CASES_TAC ( env w `x' = v0`)));
5911       ASM_REWRITE_TAC[];
5912       BY(REWRITE_TAC[arith `u <= u`]);
5913     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `x IN h x'`) MP_TAC));
5914       FIRST_X_ASSUM MATCH_MP_TAC;
5915       BY(ASM_MESON_TAC[]);
5916     ASM_SIMP_TAC[];
5917     BY(REWRITE_TAC[IN_ELIM_THM]);
5918   COMMENT "1b";
5919   TYPED_ABBREV_TAC `ho = \ (v:A). {(p : real^B) | a v dot p < b v}`;
5920   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!v. ho v = {p | a v dot p < b v}`) ASSUME_TAC));
5921     GEN_TAC;
5922     EXPAND_TAC "ho";
5923     BY(REWRITE_TAC[]);
5924   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `p IN INTERS (IMAGE ho (V DIFF {v0}))`) ASSUME_TAC));
5925     REWRITE_TAC[IN_INTERS;IN_IMAGE;IN_DIFF;IN_SING];
5926     REPEAT WEAK_STRIP_TAC;
5927     ASM_REWRITE_TAC[];
5928     REWRITE_TAC[IN_ELIM_THM];
5929     BY(ASM_MESON_TAC[]);
5930   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `open (INTERS (IMAGE ho (V DIFF {v0})))`) ASSUME_TAC));
5931     MATCH_MP_TAC OPEN_INTERS;
5932     SUBCONJ_TAC;
5933       MATCH_MP_TAC FINITE_IMAGE;
5934       MATCH_MP_TAC FINITE_DIFF;
5935       BY(ASM_REWRITE_TAC[]);
5936     DISCH_TAC;
5937     REWRITE_TAC[IN_IMAGE;IN_DIFF;IN_SING];
5938     REPEAT WEAK_STRIP_TAC;
5939     ASM_REWRITE_TAC[];
5940     BY(REWRITE_TAC[ OPEN_HALFSPACE_LT ]);
5941   FIRST_X_ASSUM MP_TAC;
5942   REWRITE_TAC[ OPEN_CONTAINS_BALL ];
5943   GOAL_TERM (fun w -> (DISCH_THEN (fun t -> MP_TAC (ISPEC ( env w `p`) t))));
5944   ASM_REWRITE_TAC[];
5945   REPEAT WEAK_STRIP_TAC;
5946   EXISTS_TAC `e:real`;
5947   ASM_REWRITE_TAC[];
5948   MATCH_MP_TAC SUBSET_TRANS;
5949   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `ball(p,e) INTER { p | a v0 dot p = b v0}`)));
5950   CONJ_TAC;
5951     GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w ` affine hull (INTERS (IMAGE h V) INTER {p | a v0 dot p = b v0}) SUBSET {p | a v0 dot p = b v0}`)));
5952       BY(SET_TAC[]);
5953     MATCH_MP_TAC SUBSET_TRANS;
5954     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `affine hull {p | a v0 dot p = b v0}`)));
5955     CONJ_TAC;
5956       MATCH_MP_TAC Marchal_cells_2_new.AFFINE_SUBSET_KY_LEMMA;
5957       BY(SET_TAC[]);
5958     GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `affine hull {p | a v0 dot p = b v0 } = {p | a v0 dot p = b v0}`)));
5959       BY(SET_TAC[]);
5960     INTRO_TAC AFFINE_HYPERPLANE [`a v0`;`b v0`];
5961     BY(MESON_TAC[ AFFINE_HULL_EQ ]);
5962   COMMENT "1c";
5963   MATCH_MP_TAC SUBSET_TRANS;
5964   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `INTERS (IMAGE h (V DIFF {v0})) INTER {p  | a v0 dot p = b v0}`)));
5965   CONJ2_TAC;
5966     BY(ASM_MESON_TAC[]);
5967   GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w`INTERS (IMAGE ho (V DIFF {v0})) SUBSET INTERS (IMAGE h (V DIFF {v0}))`)));
5968     FIRST_X_ASSUM MP_TAC;
5969     BY(SET_TAC[]);
5970   REWRITE_TAC[INTERS_IMAGE;SUBSET;IN_ELIM_THM;IN_DIFF;IN_SING];
5971   REPEAT WEAK_STRIP_TAC;
5972   ASM_SIMP_TAC[IN_ELIM_THM];
5973   GOAL_TERM (fun w -> (FIRST_X_ASSUM (fun t -> MP_TAC (ISPEC ( env w `x'`) t))));
5974   EXPAND_TAC "ho";
5975   REWRITE_TAC[IN_ELIM_THM];
5976   ASM_REWRITE_TAC[];
5977   BY(REAL_ARITH_TAC)
5978   ]);;
5979   (* }}} *)
5980
5981 let FACET_RELEVANT = prove_by_refinement(
5982   `!(V:A->bool) a b (p:real^B) v0.
5983     FINITE V /\
5984     (!v. v IN V ==> (&0 < b v)) /\
5985     (a v0 dot p = b v0) /\
5986     (v0 IN V) /\
5987     (!w. w IN V /\ ~(v0 = w) ==> a w dot p < b w) ==>
5988     (?t. b v0 < a v0 dot (t % p) /\
5989        (!w. w IN V /\ ~(v0 = w) ==> a w dot (t % p) < b w))`,
5990   (* {{{ proof *)
5991   [
5992   REPEAT WEAK_STRIP_TAC;
5993   TYPED_ABBREV_TAC `h = (\ (v:A). { q | a v dot (q:real^B)  < b v })`;
5994   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(open:(real^B->bool)->bool) (INTERS (IMAGE (h:A->(real^B->bool)) ((V:A->bool) DIFF {v0})))`) ASSUME_TAC));
5995     MATCH_MP_TAC OPEN_INTERS;
5996     SUBCONJ_TAC;
5997       MATCH_MP_TAC FINITE_IMAGE;
5998       MATCH_MP_TAC FINITE_DIFF;
5999       BY(BY(ASM_REWRITE_TAC[]));
6000     DISCH_TAC;
6001     REWRITE_TAC[IN_IMAGE;IN_DIFF;IN_SING];
6002     REPEAT WEAK_STRIP_TAC;
6003     ASM_REWRITE_TAC[];
6004     EXPAND_TAC "h";
6005     BY(BY(REWRITE_TAC[ OPEN_HALFSPACE_LT ]));
6006   FIRST_X_ASSUM MP_TAC;
6007   REWRITE_TAC[ OPEN_CONTAINS_BALL ];
6008   REWRITE_TAC[IN_IMAGE;IN_DIFF;IN_SING;IN_INTERS;SUBSET];
6009   GOAL_TERM (fun w -> (DISCH_THEN (fun t -> MP_TAC (ISPEC ( env w `p`) t))));
6010   ANTS_TAC;
6011     EXPAND_TAC "h";
6012     REPEAT WEAK_STRIP_TAC;
6013     ASM_REWRITE_TAC[IN_ELIM_THM];
6014     FIRST_X_ASSUM MATCH_MP_TAC;
6015     BY(ASM_MESON_TAC[]);
6016   REPEAT WEAK_STRIP_TAC;
6017   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`~(p = vec 0)`) ASSUME_TAC));
6018     DISCH_TAC;
6019     FIRST_X_ASSUM_ST `u dot v = c` MP_TAC;
6020     ASM_REWRITE_TAC[ DOT_RZERO ];
6021     BY(ASM_MESON_TAC[arith `&0 < x ==> ~(&0 = x)`]);
6022   TYPED_ABBREV_TAC `s = &1 + e / (&2 * norm (p:real^B))`;
6023   EXISTS_TAC `s:real`;
6024   COMMENT "1";
6025   SUBGOAL_THEN `&1 < s` ASSUME_TAC;
6026     EXPAND_TAC "s";
6027     MATCH_MP_TAC (arith `&0 < x ==> &1 < &1 +x `);
6028     MATCH_MP_TAC REAL_LT_DIV;
6029     ASM_REWRITE_TAC[];
6030     MATCH_MP_TAC (arith `&0 < x ==> &0 < &2 * x`);
6031     BY(ASM_REWRITE_TAC[ NORM_POS_LT ]);
6032   CONJ_TAC;
6033     ASM_REWRITE_TAC[ DOT_RMUL ];
6034     MATCH_MP_TAC (arith `&1 * x < s * x ==> x < s * x`);
6035     MATCH_MP_TAC REAL_LT_RMUL;
6036     BY(ASM_SIMP_TAC[]);
6037   COMMENT "1b";
6038   REPEAT WEAK_STRIP_TAC;
6039   GOAL_TERM (fun w -> (FIRST_X_ASSUM (MP_TAC o (ISPEC ( env w `s % p`)))));
6040   ANTS_TAC;
6041     REWRITE_TAC[IN_BALL];
6042     ONCE_REWRITE_TAC[DIST_SYM];
6043     REWRITE_TAC[dist];
6044     GOAL_TERM (fun w -> (REWRITE_TAC[varith ( env w `s % p - p = (s - &1) % p`)]));
6045     REWRITE_TAC[ NORM_MUL ];
6046     ASM_SIMP_TAC[arith `&1 < s ==> abs (s - &1) = (s - &1)`];
6047     EXPAND_TAC "s";
6048     REWRITE_TAC[arith `(&1 + x) - &1 = x`];
6049     GOAL_TERM (fun w -> (SUBGOAL_THEN ( ( env w`(e / (&2 * norm p) * norm p = e / &2)`)) SUBST1_TAC));
6050       Calc_derivative.CALC_ID_TAC;
6051       ASM_REWRITE_TAC[ NORM_EQ_0 ];
6052       BY(REAL_ARITH_TAC);
6053     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
6054   COMMENT "1c";
6055   GOAL_TERM (fun w -> (DISCH_THEN (MP_TAC o (ISPEC ( env w `h w`)))));
6056   EXPAND_TAC "h";
6057   REWRITE_TAC[IN_ELIM_THM];
6058   DISCH_THEN MATCH_MP_TAC;
6059   BY(ASM_MESON_TAC[])
6060   ]);;
6061   (* }}} *)
6062
6063 let FACET_OF_POLYHEDRON_EXPLICIT_ALT  = prove_by_refinement(
6064  `!(V:A->bool) (P:real^B->bool) h a b.
6065    FINITE V /\
6066    (vec 0) IN interior P /\
6067    (!v. (v IN V ) ==> (h v  = { p | a v dot p <= b v })) /\
6068    (!v. v IN V ==> (&0 < b v)) /\
6069    INTERS (IMAGE h V) = P /\
6070   (!v. (v IN V ) ==> ~(a v = (vec 0))) /\
6071   (!v. (v IN V)  ==> (?p. a v dot p = b v /\ (!w. (w IN V) /\ ~(v = w) ==> a w dot p < b w))) ==>
6072   (BIJ (\v. P INTER {p | a v dot p = b v}) V { c | c facet_of P })`,
6073   (* {{{ proof *)
6074   [
6075   REPEAT WEAK_STRIP_TAC;
6076   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!f. (f IN IMAGE h V) ==> (?q. (q IN V) /\ f = h q)`) MP_TAC));
6077     REWRITE_TAC[IN_IMAGE];
6078     BY(MESON_TAC[]);
6079   REWRITE_TAC[ RIGHT_IMP_EXISTS_THM ];
6080   REWRITE_TAC[SKOLEM_THM];
6081   REPEAT WEAK_STRIP_TAC;
6082   INTRO_TAC FACET_OF_POLYHEDRON_EXPLICIT [`P`;`(IMAGE h V)`;`(\f. a (q f))`;`(\f. b (q f))`];
6083   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(FINITE (IMAGE h V))`) ASSUME_TAC));
6084     MATCH_MP_TAC FINITE_IMAGE;
6085     BY(ASM_REWRITE_TAC[]);
6086   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(affine hull P) = (:real^B)`) SUBST1_TAC));
6087     BY(ASM_MESON_TAC[ AFFINE_HULL_NONEMPTY_INTERIOR; NOT_IN_EMPTY ]);
6088   ASM_REWRITE_TAC[ INTER_UNIV ];
6089   COMMENT "1";
6090   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(!f'. f' PSUBSET IMAGE h V ==> P PSUBSET INTERS f')`) ASSUME_TAC));
6091     REWRITE_TAC[PSUBSET];
6092     REWRITE_TAC[SUBSET_IMAGE];
6093     REPEAT WEAK_STRIP_TAC;
6094     CONJ_TAC;
6095       ASM_REWRITE_TAC[];
6096       EXPAND_TAC "P";
6097       FIRST_X_ASSUM_ST `SUBSET` MP_TAC;
6098       REWRITE_TAC[INTERS;IN_IMAGE;SUBSET];
6099       REWRITE_TAC[IN_ELIM_THM];
6100       BY(MESON_TAC[]);
6101     COMMENT "2";
6102     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?v0. v0 IN V /\ ~(h v0 IN f')`) MP_TAC));
6103       REPLICATE_TAC 2 (FIRST_X_ASSUM_ST `IMAGE` MP_TAC);
6104       REWRITE_TAC[IMAGE];
6105       ONCE_REWRITE_TAC[FUN_EQ_THM];
6106       REWRITE_TAC[IN_ELIM_THM];
6107       FIRST_X_ASSUM MP_TAC;
6108       REWRITE_TAC[SUBSET;IN];
6109       BY(MESON_TAC[]);
6110     REPEAT WEAK_STRIP_TAC;
6111     GOAL_TERM (fun w -> (FIRST_X_ASSUM (fun t -> MP_TAC (ISPEC ( env w `v0`) t))));
6112     ASM_REWRITE_TAC[];
6113     REWRITE_TAC[NOT_EXISTS_THM];
6114     REPEAT WEAK_STRIP_TAC;
6115     INTRO_TAC FACET_RELEVANT [`V`;`a`;`b`;`p`;`v0`];
6116     ASM_REWRITE_TAC[];
6117     REWRITE_TAC[ NOT_EXISTS_THM ];
6118     GEN_TAC;
6119     MATCH_MP_TAC (TAUT `(b ==> ~a) ==> ~(a /\ b)`);
6120     DISCH_TAC;
6121     MATCH_MP_TAC (arith `x <= y ==> ~(y < x)`);
6122     GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `t % p IN P`)));
6123       EXPAND_TAC "P";
6124       REWRITE_TAC[INTERS_IMAGE;IN_ELIM_THM];
6125       GOAL_TERM (fun w -> (DISCH_THEN (MP_TAC o (ISPEC ( env w`v0`)))));
6126       ASM_SIMP_TAC[];
6127       BY(REWRITE_TAC[IN_ELIM_THM]);
6128     ASM_REWRITE_TAC[];
6129     REWRITE_TAC[INTERS_IMAGE;IN_ELIM_THM];
6130     REPEAT WEAK_STRIP_TAC;
6131     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(v0 IN u)`) ASSUME_TAC));
6132       DISCH_TAC;
6133       REPEAT (FIRST_X_ASSUM_ST `IN` MP_TAC);
6134       ASM_REWRITE_TAC[IN_IMAGE];
6135       BY(MESON_TAC[]);
6136     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `x IN V`) ASSUME_TAC));
6137       BY(ASM_MESON_TAC[SUBSET]);
6138     ASM_SIMP_TAC[];
6139     REWRITE_TAC[IN_ELIM_THM];
6140     MATCH_MP_TAC (arith `x < y ==> x <= y`);
6141     FIRST_X_ASSUM MATCH_MP_TAC;
6142     BY(ASM_MESON_TAC[]);
6143   COMMENT "1";
6144   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!v w. v IN V /\ w IN V /\ (h v = h w) ==> (v = w)`) ASSUME_TAC));
6145     REPEAT WEAK_STRIP_TAC;
6146     FIRST_X_ASSUM MP_TAC;
6147     ASM_SIMP_TAC[];
6148     ONCE_REWRITE_TAC[FUN_EQ_THM];
6149     REWRITE_TAC[IN_ELIM_THM];
6150     DISCH_TAC;
6151     PROOF_BY_CONTR_TAC;
6152     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `interior {p | a v dot p <= b v} = interior {p | a w dot p <= b w}`) MP_TAC));
6153       AP_TERM_TAC;
6154       ONCE_REWRITE_TAC[FUN_EQ_THM];
6155       REWRITE_TAC[IN_ELIM_THM];
6156       BY(ASM_REWRITE_TAC[]);
6157     ASM_SIMP_TAC[ INTERIOR_HALFSPACE_LE ];
6158     ONCE_REWRITE_TAC[FUN_EQ_THM];
6159     REWRITE_TAC[IN_ELIM_THM];
6160     BY(ASM_MESON_TAC[arith `x = y ==> ~(x < y)`]);
6161   COMMENT "1b";
6162   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!x. x IN V ==> (q(h x) = x)`) MP_TAC));
6163     REPEAT WEAK_STRIP_TAC;
6164     FIRST_X_ASSUM MATCH_MP_TAC;
6165     ASM_REWRITE_TAC[];
6166     ONCE_REWRITE_TAC[ EQ_SYM_EQ ];
6167     FIRST_X_ASSUM MATCH_MP_TAC;
6168     REWRITE_TAC[IN_IMAGE];
6169     BY(ASM_MESON_TAC[]);
6170   DISCH_TAC;
6171   ASM_REWRITE_TAC[];
6172   COMMENT "1b";
6173   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(!hv. hv IN IMAGE h V ==> ~(a (q hv) = vec 0) /\ hv = {x | a (q hv) dot x <= b (q hv)})`) ASSUME_TAC));
6174     REWRITE_TAC[IN_IMAGE];
6175     REPEAT WEAK_STRIP_TAC;
6176     ASM_REWRITE_TAC[];
6177     CONJ_TAC;
6178       FIRST_X_ASSUM MATCH_MP_TAC;
6179       BY(ASM_MESON_TAC[IN_IMAGE]);
6180     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `q (h x) = x`) SUBST1_TAC));
6181       FIRST_X_ASSUM MATCH_MP_TAC;
6182       BY(ASM_REWRITE_TAC[]);
6183     FIRST_X_ASSUM MATCH_MP_TAC;
6184     BY(ASM_REWRITE_TAC[]);
6185   ASM_REWRITE_TAC[];
6186   DISCH_TAC;
6187   COMMENT "1c";
6188   REWRITE_TAC[ BIJ; INJ ];
6189   SUBCONJ_TAC;
6190     SUBCONJ_TAC;
6191       REPEAT WEAK_STRIP_TAC;
6192       GOAL_TERM (fun w -> (FIRST_X_ASSUM (MP_TAC o (ISPEC ( env w `P INTER {p | a x dot p = b x}`)))));
6193       REWRITE_TAC[IN_ELIM_THM];
6194       DISCH_THEN SUBST1_TAC;
6195       BY(ASM_MESON_TAC[IN_IMAGE]);
6196     DISCH_TAC;
6197     REPEAT WEAK_STRIP_TAC;
6198     PROOF_BY_CONTR_TAC;
6199     GOAL_TERM (fun w -> (FIRST_X_ASSUM_ST `<` (MP_TAC o (ISPEC ( env w `y`)))));
6200     ANTS_TAC;
6201       BY(ASM_REWRITE_TAC[]);
6202     REPEAT WEAK_STRIP_TAC;
6203     FIRST_X_ASSUM_ST `INTER` MP_TAC;
6204     REWRITE_TAC[FUN_EQ_THM;X_IN IN_INTER;IN_ELIM_THM];
6205     EXPAND_TAC "P";
6206     REWRITE_TAC[INTERS_IMAGE;IN_ELIM_THM];
6207     RENAME_FREE_VAR (`x:A`,"v");
6208     REBIND_TAC (`x:A`,"w");
6209     REWRITE_TAC[ NOT_FORALL_THM ];
6210     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `p`)));
6211     ASM_REWRITE_TAC[];
6212     MATCH_MP_TAC (TAUT (`a /\ ~b ==> (~(a /\ b <=> a))`));
6213     CONJ2_TAC;
6214       BY(ASM_MESON_TAC[arith `x < y ==> ~(x = y)`]);
6215     REPEAT WEAK_STRIP_TAC;
6216     ASM_SIMP_TAC[];
6217     REWRITE_TAC[IN_ELIM_THM];
6218     GOAL_TERM (fun w -> (ASM_CASES_TAC ( env w `y = w`)));
6219       EXPAND_TAC "w";
6220       REPLICATE_TAC 2 (FIRST_X_ASSUM_ST `dot` MP_TAC);
6221       BY(REAL_ARITH_TAC);
6222     MATCH_MP_TAC (arith `x < y ==> x <=y`);
6223     REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC);
6224     BY(MESON_TAC[]);
6225   REPEAT WEAK_STRIP_TAC;
6226   COMMENT "1d:SUR";
6227   REWRITE_TAC[SURJ];
6228   CONJ_TAC;
6229     BY(ASM_REWRITE_TAC[]);
6230   REWRITE_TAC[IN_ELIM_THM];
6231   REPEAT WEAK_STRIP_TAC;
6232   RENAME_FREE_VAR (`x:real^B->bool`,"c");
6233   FIRST_X_ASSUM MP_TAC;
6234   ASM_SIMP_TAC[];
6235   REWRITE_TAC[IN_IMAGE];
6236   REPEAT WEAK_STRIP_TAC;
6237   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `q h'`)));
6238   ASM_REWRITE_TAC[];
6239   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `h x IN IMAGE h V`) MP_TAC));
6240     BY(ASM_MESON_TAC[IN_IMAGE]);
6241   BY(ASM_MESON_TAC[])
6242   ]);;
6243   (* }}} *)
6244
6245 let EXISTS_M_POLYHEDRON = prove_by_refinement(
6246 `!(V:real^3 -> bool) theta r n.
6247     V SUBSET ball_annulus /\ packing V /\
6248     weakly_saturated V r (&2 * h0) /\
6249     (V HAS_SIZE n) /\
6250    ~(V = {}) /\
6251     (&2 <= r /\ r <= &2 * h0) /\
6252     (!v w. v IN V /\ w IN V /\ ~(v = w) ==> theta v + theta w <= arcV (vec 0) v w) /\
6253     (!v. v IN V ==> &0 < theta v /\ theta v < pi/ &2) ==>
6254     (?b f h P .
6255        (!v. v IN V ==> h v = {p | v dot p <= b v}) /\
6256         INTERS (IMAGE h V) = P /\
6257         (!v. v IN V ==> &0 < b v) /\
6258         polyhedron P /\
6259         bounded P /\
6260         (vec 0 IN interior P) /\
6261         BIJ f V {c |c facet_of P} /\
6262         (!v. v IN V ==> f v = P INTER { p | v dot p = b v}) /\
6263         (!v. v IN V ==> b v = norm v * cos (theta v)) /\
6264         (!v. v IN V ==> rcone_gt (vec 0) v (cos (theta v)) SUBSET fchanged (f v)) /\
6265         (!v. v IN V ==> &0 < cos (theta v) /\ cos(theta v) < &1))
6266     `,
6267   (* {{{ proof *)
6268   [
6269   REPEAT WEAK_STRIP_TAC;
6270   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!v. v IN V ==> ~(v = vec 0)`) ASSUME_TAC));
6271     FIRST_X_ASSUM_ST `ball_annulus` MP_TAC;
6272     REWRITE_TAC[ Pack_defs.ball_annulus ];
6273     REWRITE_TAC[ SUBSET; DIFF ;IN_ELIM_THM;ball;];
6274     ONCE_REWRITE_TAC[DIST_SYM];
6275     REWRITE_TAC[dist;varith `x - vec 0 = x`];
6276     BY(MESON_TAC[ NORM_0 ; arith `&0 < &2`]);
6277   COMMENT "0";
6278   TYPED_ABBREV_TAC `b = \ (v:real^3). norm v * cos (theta v)`;
6279   TYPED_ABBREV_TAC `h = \ (v:real^3). { p | v dot p <= b v }`;
6280   TYPED_ABBREV_TAC `(P:real^3->bool) = INTERS (IMAGE h (V:real^3->bool))`;
6281   TYPED_ABBREV_TAC `f = \ (v:real^3). P INTER { p | v dot p = b v}`;
6282   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `b`)));
6283   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `f`)));
6284   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `h`)));
6285   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `P`)));
6286   SUBCONJ_TAC;
6287     BY(ASM_MESON_TAC[]);
6288   DISCH_TAC;
6289   SUBCONJ_TAC;
6290     BY(ASM_REWRITE_TAC[]);
6291   DISCH_TAC;
6292   SUBGOAL_THEN (`(!v. v IN V ==> &0 < cos (theta v) /\ cos (theta (v:real^3)) < &1)`) ASSUME_TAC;
6293     BY(ASM_MESON_TAC[cos_bounds_0_Pi2]);
6294   ASM_REWRITE_TAC[];
6295   SUBGOAL_THEN (`(!v. v IN V ==> f v = P INTER {p | v dot p = b (v:real^3) })`) ASSUME_TAC;
6296     BY(ASM_MESON_TAC[]);
6297   ASM_REWRITE_TAC[];
6298   SUBGOAL_THEN (` (!v. v IN V ==> b v = norm v * cos (theta (v:real^3)))`) ASSUME_TAC;
6299     BY(ASM_MESON_TAC[]);
6300   ASM_REWRITE_TAC[];
6301   COMMENT "1";
6302   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `polyhedron P`) ASSUME_TAC));
6303     REWRITE_TAC[ polyhedron ];
6304     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `IMAGE h V`)));
6305     ASM_REWRITE_TAC[];
6306     CONJ_TAC;
6307       MATCH_MP_TAC FINITE_IMAGE;
6308       BY(ASM_MESON_TAC[HAS_SIZE]);
6309     REWRITE_TAC[IN_IMAGE];
6310     REPEAT WEAK_STRIP_TAC;
6311     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `x`)));
6312     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `b x`)));
6313     CONJ_TAC;
6314       FIRST_X_ASSUM MATCH_MP_TAC;
6315       BY(ASM_REWRITE_TAC[]);
6316     ASM_REWRITE_TAC[FUN_EQ_THM;IN_ELIM_THM];
6317     EXPAND_TAC "h";
6318     BY(REWRITE_TAC[IN_ELIM_THM]);
6319   ASM_REWRITE_TAC[];
6320   COMMENT "1b";
6321   SUBCONJ_TAC;
6322     REPEAT WEAK_STRIP_TAC;
6323     ASM_SIMP_TAC[];
6324     MATCH_MP_TAC Real_ext.REAL_PROP_POS_MUL2;
6325     ASM_SIMP_TAC[];
6326     REWRITE_TAC[ NORM_POS_LT ];
6327     BY(ASM_SIMP_TAC[]);
6328   DISCH_TAC;
6329   COMMENT "1c";
6330   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(vec 0) IN P`) ASSUME_TAC));
6331     EXPAND_TAC "P";
6332     REWRITE_TAC[INTERS_IMAGE;IN_ELIM_THM];
6333     REPEAT WEAK_STRIP_TAC;
6334     EXPAND_TAC "h";
6335     REWRITE_TAC[IN_ELIM_THM];
6336     REWRITE_TAC[DOT_RZERO];
6337     BY(ASM_MESON_TAC[arith `&0 < x ==> &0 <= x`]);
6338   TYPED_ABBREV_TAC `ho = \ (v:real^3). {(p : real^3) |  v dot p < b v}`;
6339   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!v. ho v = {p | v dot p < b v}`) ASSUME_TAC));
6340     GEN_TAC;
6341     EXPAND_TAC "ho";
6342     BY(BY(REWRITE_TAC[]));
6343   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(vec 0) IN INTERS (IMAGE ho V)`) ASSUME_TAC));
6344     REWRITE_TAC[INTERS_IMAGE;IN_ELIM_THM];
6345     REPEAT WEAK_STRIP_TAC;
6346     EXPAND_TAC "ho";
6347     REWRITE_TAC[IN_ELIM_THM];
6348     REWRITE_TAC[DOT_RZERO];
6349     BY(ASM_MESON_TAC[]);
6350   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `open (INTERS (IMAGE ho (V )))`) ASSUME_TAC));
6351     MATCH_MP_TAC OPEN_INTERS;
6352     SUBCONJ_TAC;
6353       MATCH_MP_TAC FINITE_IMAGE;
6354       BY(ASM_MESON_TAC[HAS_SIZE]);
6355     DISCH_TAC;
6356     REWRITE_TAC[IN_IMAGE];
6357     REPEAT WEAK_STRIP_TAC;
6358     ASM_REWRITE_TAC[];
6359     BY(BY(REWRITE_TAC[ OPEN_HALFSPACE_LT ]));
6360   FIRST_X_ASSUM MP_TAC;
6361   REWRITE_TAC[ OPEN_CONTAINS_BALL ];
6362   GOAL_TERM (fun w -> (DISCH_THEN (fun t -> MP_TAC (ISPEC ( env w `(vec 0):real^3`) t))));
6363   ASM_REWRITE_TAC[];
6364   REPEAT WEAK_STRIP_TAC;
6365   COMMENT "1d";
6366   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `vec 0 IN interior P`) ASSUME_TAC));
6367     REWRITE_TAC[ IN_INTERIOR];
6368     EXISTS_TAC `e:real`;
6369     ASM_REWRITE_TAC[];
6370     MATCH_MP_TAC SUBSET_TRANS;
6371     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `INTERS (IMAGE ho V)`)));
6372     ASM_REWRITE_TAC[];
6373     EXPAND_TAC "P";
6374     REWRITE_TAC[SUBSET;INTERS_IMAGE];
6375     REWRITE_TAC[IN_ELIM_THM];
6376     EXPAND_TAC "ho";
6377     EXPAND_TAC "h";
6378     REWRITE_TAC[IN_ELIM_THM];
6379     REPEAT WEAK_STRIP_TAC;
6380     MATCH_MP_TAC (arith `x < y ==> x <= y`);
6381     FIRST_X_ASSUM MATCH_MP_TAC;
6382     BY(ASM_REWRITE_TAC[]);
6383   ASM_REWRITE_TAC[];
6384   COMMENT "1e";
6385   SUBCONJ_TAC;
6386     MATCH_MP_TAC Tarjjuw.TARJJUW;
6387     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `V`)));
6388     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `b`)));
6389     EXISTS_TAC `r:real`;
6390     EXISTS_TAC `&2 * h0`;
6391     ASM_REWRITE_TAC[];
6392     SUBCONJ_TAC;
6393       FIRST_X_ASSUM_ST `ball_annulus` MP_TAC;
6394       REWRITE_TAC[Pack_defs.ball_annulus];
6395       REWRITE_TAC[SUBSET;DIFF];
6396       REWRITE_TAC[IN_UNIV;IN_ELIM_THM];
6397       BY(MESON_TAC[]);
6398     DISCH_TAC;
6399     SUBCONJ_TAC;
6400       BY(ASM_MESON_TAC[HAS_SIZE]);
6401     DISCH_TAC;
6402     EXPAND_TAC "P";
6403     REWRITE_TAC[INTERS_IMAGE];
6404     REWRITE_TAC[INTERS;IN_ELIM_THM];
6405     REWRITE_TAC[FUN_EQ_THM;IN_ELIM_THM];
6406     REBIND_TAC (`u:real^3`,"w");
6407     EXPAND_TAC "h";
6408     REWRITE_TAC[IN_ELIM_THM; Tarjjuw.half_spaces];
6409     GEN_TAC;
6410     ONCE_REWRITE_TAC[ Geomdetail.EQ_EXPAND];
6411     SUBCONJ_TAC;
6412       REPEAT WEAK_STRIP_TAC;
6413       REWRITE_TAC[IN];
6414       BY(ASM_MESON_TAC[]);
6415     REPEAT WEAK_STRIP_TAC;
6416     GOAL_TERM (fun w -> (FIRST_X_ASSUM (MP_TAC o (ISPEC ( env w `{x | x' dot x <= b x'}`)))));
6417     REWRITE_TAC[IN_ELIM_THM];
6418     DISCH_THEN MATCH_MP_TAC;
6419     BY(ASM_MESON_TAC[]);
6420   DISCH_TAC;
6421   COMMENT "1f";
6422   SUBCONJ_TAC;
6423     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(f = (\v. P INTER {p | I v dot p = b v}))`) SUBST1_TAC));
6424       EXPAND_TAC "f";
6425       BY(REWRITE_TAC[I_DEF]);
6426     MATCH_MP_TAC FACET_OF_POLYHEDRON_EXPLICIT_ALT;
6427     REWRITE_TAC[I_DEF];
6428     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `h`)));
6429     ASM_REWRITE_TAC[];
6430     CONJ_TAC;
6431       BY(ASM_MESON_TAC[HAS_SIZE]);
6432     REPEAT WEAK_STRIP_TAC;
6433     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `(b v / (v dot v)) % v`)));
6434     CONJ_TAC;
6435       REWRITE_TAC[ DOT_RMUL ];
6436       Calc_derivative.CALC_ID_TAC;
6437       BY(ASM_MESON_TAC[ DOT_EQ_0 ]);
6438     REPEAT WEAK_STRIP_TAC;
6439     INTRO_TAC rcone_gt_facet [`theta v`;`theta w`;`v`;`w`;`(b v / (v dot v)) % v`;`v`];
6440     ASM_SIMP_TAC[];
6441     ANTS_TAC;
6442       MATCH_MP_TAC rcone_refl;
6443       BY(ASM_MESON_TAC[]);
6444     MATCH_MP_TAC (arith `(x = y) ==> (x < z ==> y < z)`);
6445     REWRITE_TAC[DOT_RMUL;DOT_LMUL];
6446     BY(MESON_TAC[DOT_SYM]);
6447   DISCH_TAC;
6448   COMMENT "1g";
6449   REWRITE_TAC[SUBSET];
6450   REPEAT WEAK_STRIP_TAC;
6451   REWRITE_TAC[ Polyhedron.fchanged ];
6452   REWRITE_TAC[ IN_ELIM_THM];
6453   TYPED_ABBREV_TAC `s = ((b:real^3->real) v)/ (x dot v)`;
6454   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `s % x`)));
6455   EXISTS_TAC (`&1 / s`);
6456   CONJ_TAC;
6457     REWRITE_TAC[ VECTOR_MUL_ASSOC ];
6458     REWRITE_TAC[ varith ` (x = u % x) <=> &1 % x = u % x `];
6459     REWRITE_TAC[ VECTOR_MUL_RCANCEL ];
6460     DISJ1_TAC;
6461     EXPAND_TAC "s";
6462     Calc_derivative.CALC_ID_TAC;
6463     ASM_SIMP_TAC[arith `~(&1 = &0)`;arith `&0 < x ==> ~(x = &0)`];
6464     MATCH_MP_TAC (arith `&0 < x ==> ~(x = &0)`);
6465     MATCH_MP_TAC rcone_dot_pos;
6466     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `cos (theta v)`)));
6467     BY(ASM_SIMP_TAC[]);
6468   COMMENT "1h";
6469   CONJ2_TAC;
6470     EXPAND_TAC "s";
6471     MATCH_MP_TAC (arith `&0 < x ==> x > &0`);
6472     REWRITE_TAC[ GSYM Collect_geom.POS_EQ_INV_POS ];
6473     MATCH_MP_TAC REAL_LT_DIV;
6474     ASM_SIMP_TAC[];
6475     MATCH_MP_TAC rcone_dot_pos;
6476     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `cos (theta v)`)));
6477     BY(ASM_SIMP_TAC[]);
6478   EXPAND_TAC "f";
6479   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{p | v dot p = b v} = {p |  I v dot p = b v}`) SUBST1_TAC));
6480     BY(REWRITE_TAC[I_DEF]);
6481   MATCH_MP_TAC RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT_ALT;
6482   REWRITE_TAC[I_DEF];
6483   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `V`)));
6484   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `h`)));
6485   ASM_REWRITE_TAC[];
6486   CONJ_TAC;
6487     BY(ASM_MESON_TAC[HAS_SIZE]);
6488   SUBCONJ_TAC;
6489     EXPAND_TAC "s";
6490     REWRITE_TAC[DOT_RMUL];
6491     Calc_derivative.CALC_ID_TAC;
6492     CONJ_TAC;
6493       MATCH_MP_TAC (arith `&0 < x ==> ~(x = &0)`);
6494       MATCH_MP_TAC rcone_dot_pos;
6495       GOAL_TERM (fun w -> (EXISTS_TAC ( env w `cos(theta v)`)));
6496       BY(ASM_SIMP_TAC[]);
6497     BY(ASM_MESON_TAC[DOT_SYM;arith `(x = z) ==> y * x - z * y = &0`]);
6498   REPEAT WEAK_STRIP_TAC;
6499   EXPAND_TAC "b";
6500   ONCE_REWRITE_TAC[DOT_SYM];
6501   MATCH_MP_TAC rcone_gt_facet;
6502   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `theta v`)));
6503   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `v`)));
6504   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `x`)));
6505   ASM_SIMP_TAC[];
6506   EXPAND_TAC "s";
6507   EXPAND_TAC "b";
6508   BY(REWRITE_TAC[])
6509   ]);;
6510   (* }}} *)
6511
6512 let LMFUN_LE_1 = prove_by_refinement(
6513   `!h. &1 <= h ==> lmfun h <= &1`,
6514   (* {{{ proof *)
6515   [
6516   REPEAT WEAK_STRIP_TAC;
6517   REWRITE_TAC[ Pack_defs.lmfun ];
6518   COND_CASES_TAC;
6519     ENOUGH_TO_SHOW_TAC (`(h0 - h)/ (h0 - &1) <= (h0 - &1) / (h0 - &1)`);
6520       MATCH_MP_TAC (arith `(x = y) ==> (z <= x ==> z <= y)`);
6521       Calc_derivative.CALC_ID_TAC;
6522       REWRITE_TAC[ Sphere.h0 ];
6523       BY(REAL_ARITH_TAC);
6524     GMATCH_SIMP_TAC REAL_LE_DIV2_EQ;
6525     REPEAT (FIRST_X_ASSUM MP_TAC);
6526     REWRITE_TAC [Sphere.h0];
6527     BY(REAL_ARITH_TAC);
6528   BY(REAL_ARITH_TAC)
6529   ]);;
6530   (* }}} *)
6531
6532 let LMFUN_INEQ_CENTER_IMP_13 = prove_by_refinement(
6533   `!V. FINITE V /\ (V SUBSET ball_annulus) /\ ~(lmfun_ineq_center V) ==>
6534     (13 <= CARD V)`,
6535   (* {{{ proof *)
6536   [
6537   REWRITE_TAC[ Pack_defs.lmfun_ineq_center ];
6538   REWRITE_TAC[SUBSET; ckq_in_ball_annulus ];
6539   REPEAT WEAK_STRIP_TAC;
6540   MATCH_MP_TAC (arith `~(CARD V <= 12) ==> (13 <= CARD V)`);
6541   DISCH_TAC;
6542   FIRST_X_ASSUM_ST `lmfun` MP_TAC;
6543   REWRITE_TAC[];
6544   MATCH_MP_TAC REAL_LE_TRANS;
6545   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `sum V (\v. &1)`)));
6546   CONJ_TAC;
6547     MATCH_MP_TAC SUM_LE;
6548     ASM_REWRITE_TAC[];
6549     REPEAT WEAK_STRIP_TAC;
6550     REWRITE_TAC[ Marchal_cells_3.HL_2 ];
6551     REWRITE_TAC[ DIST_0 ];
6552     MATCH_MP_TAC LMFUN_LE_1;
6553     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `&2 <= norm x`) MP_TAC));
6554       BY(ASM_MESON_TAC[]);
6555     BY(REAL_ARITH_TAC);
6556   ASM_SIMP_TAC [ GSYM CARD_EQ_SUM ];
6557   BY(ASM_REWRITE_TAC[ REAL_OF_NUM_LE ])
6558   ]);;
6559   (* }}} *)
6560
6561 let  LMFUN_INEQ_CENTER_SUBSET = prove_by_refinement(
6562   `!V W. FINITE V /\ W SUBSET V /\ (lmfun_ineq_center V)  ==>
6563     (lmfun_ineq_center W)`,
6564   (* {{{ proof *)
6565   [
6566   REPEAT GEN_TAC;
6567   REWRITE_TAC[ Pack_defs.lmfun_ineq_center ];
6568   REPEAT WEAK_STRIP_TAC;
6569   MATCH_MP_TAC REAL_LE_TRANS;
6570   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `sum V (\v. lmfun (hl [vec 0; v]))`)));
6571   ASM_REWRITE_TAC[];
6572   MATCH_MP_TAC SUM_SUBSET_SIMPLE;
6573   ASM_REWRITE_TAC[];
6574   BY(ASM_MESON_TAC[ Marchal_cells_3.lmfun_pos_le ])
6575   ]);;
6576   (* }}} *)
6577
6578 let SATURATE_BALL_ANNULUS = prove_by_refinement(
6579   `!W S r. packing W /\ W SUBSET ball_annulus /\ ~(lmfun_ineq_center W) /\ (S SUBSET W) /\
6580      &2 <= r /\ r <= &2 * h0 /\
6581     (!v w. S v /\ W w /\ dist(v,w) < r ==> (v = w)  ) ==>
6582     (?V. V SUBSET ball_annulus /\ packing V /\
6583       weakly_saturated V r (&2 * h0) /\ FINITE V /\ (W SUBSET V) /\
6584       (!v w. S v /\ V w /\ dist(v,w)< r ==> (v = w)) /\
6585     ~(lmfun_ineq_center V) /\ (13 <= CARD V))`,
6586   (* {{{ proof *)
6587   [
6588   REPEAT WEAK_STRIP_TAC;
6589   INTRO_TAC weak_saturation [`W`;`S`;`r`];
6590   ASM_REWRITE_TAC[];
6591   REPEAT WEAK_STRIP_TAC;
6592   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `V`)));
6593   ASM_REWRITE_TAC[];
6594   SUBCONJ_TAC;
6595     BY(ASM_MESON_TAC[ LMFUN_INEQ_CENTER_SUBSET]);
6596   DISCH_TAC;
6597   MATCH_MP_TAC LMFUN_INEQ_CENTER_IMP_13;
6598   BY(ASM_REWRITE_TAC[])
6599   ]);;
6600   (* }}} *)
6601
6602 let POLYHEDRON_FACET_SUM_4Pi = prove_by_refinement(
6603   `!(P:real^3->bool). polyhedron P /\ bounded P /\
6604     (vec 0) IN interior P ==>
6605     (sum {c | c facet_of P } (\c. sol (vec 0) (fchanged c)) = &4 * pi)`,
6606   (* {{{ proof *)
6607   [
6608   REPEAT WEAK_STRIP_TAC;
6609   INTRO_TAC (GSYM Conforming.SUM_SOL_IN_FACE_SET_EQ_4PI) [`(vec 0):real^3`;`vertices P`;`edges P`];
6610   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(FAN (vec 0,vertices P,edges P) /\ conforming_fan (vec 0,vertices P,edges P))`) MP_TAC));
6611     BY(ASM_SIMP_TAC[ Polyhedron.POLYHEDRON_FAN; POLYHEDRON_CONFORMING_FAN]);
6612   WEAK_STRIP_TAC;
6613   ASM_REWRITE_TAC[];
6614   DISCH_THEN SUBST1_TAC;
6615   ASM_SIMP_TAC[GSYM Conforming.SUM_SOL_IN_TOPOLOGICAL_COMPONENET_EQ_IN_FACE_SET];
6616   INTRO_TAC Polyhedron.AMHFNXP_BIJ [`P`];
6617   ASM_REWRITE_TAC[];
6618   REWRITE_TAC[BIJ;INJ];
6619   REPEAT WEAK_STRIP_TAC;
6620   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(topological_component_yfan (vec 0,vertices P,edges P)) = IMAGE fchanged {c | c facet_of P}`) SUBST1_TAC));
6621     MATCH_MP_TAC Misc_defs_and_lemmas.SURJ_IMAGE;
6622     ASM_REWRITE_TAC[];
6623     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{c | c facet_of P} =  (\f. f facet_of P)`) ASSUME_TAC));
6624       BY(REWRITE_TAC[FUN_EQ_THM;IN_ELIM_THM]);
6625     BY(ASM_REWRITE_TAC[]);
6626   GMATCH_SIMP_TAC SUM_IMAGE;
6627   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{c | c facet_of P} =  (\f. f facet_of P)`) SUBST1_TAC));
6628     BY(REWRITE_TAC[FUN_EQ_THM;IN_ELIM_THM]);
6629   ASM_REWRITE_TAC[];
6630   REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
6631   REWRITE_TAC[FUN_EQ_THM];
6632   BY(REWRITE_TAC[o_DEF])
6633   ]);;
6634   (* }}} *)
6635
6636 let COSG = prove_by_refinement(
6637   `!h. -- &2 <= h /\ h <= &2 /\ g = acs (h/ &2) - pi / &6 ==>
6638       cos g = h * sqrt(&3) / &4 + sqrt (&1 - (h / &2) pow 2) / &2`,
6639   (* {{{ proof *)
6640   [
6641   REPEAT WEAK_STRIP_TAC;
6642   ASM_REWRITE_TAC[];
6643   REWRITE_TAC[ COS_SUB];
6644   REWRITE_TAC[ COS_PI6; SIN_PI6];
6645   GMATCH_SIMP_TAC COS_ACS;
6646   GMATCH_SIMP_TAC SIN_ACS;
6647   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
6648   ]);;
6649   (* }}} *)
6650
6651 let FACET_FINITE = prove_by_refinement(
6652   `!(p:real^3->bool) f. polyhedron p /\ f facet_of p ==>
6653     FINITE { e | e facet_of f}`,
6654   (* {{{ proof *)
6655   [
6656   REPEAT WEAK_STRIP_TAC;
6657   MATCH_MP_TAC FINITE_SUBSET;
6658   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `{ e | e face_of p}`)));
6659   ASM_SIMP_TAC[ FINITE_POLYHEDRON_FACES ];
6660   REWRITE_TAC[SUBSET;IN_ELIM_THM];
6661   BY(ASM_MESON_TAC[ FACET_OF_IMP_FACE_OF; FACE_OF_TRANS ])
6662   ]);;
6663   (* }}} *)
6664
6665 let BIJ_SUM = prove_by_refinement(
6666   `!(A:A->bool) (B:B->bool) f ab.
6667     BIJ ab A B ==> (sum A (f o ab) = sum B f)`,
6668   (* {{{ proof *)
6669   [
6670   REWRITE_TAC[BIJ;INJ];
6671   BY(ASM_MESON_TAC[ SUM_IMAGE ; Misc_defs_and_lemmas.SURJ_IMAGE ])
6672   ]);;
6673   (* }}} *)
6674
6675 let CARD_AT_LEAST3 = prove_by_refinement(
6676   `!x y z (A:A->bool). FINITE A /\ x IN A /\ y IN A /\ z IN A /\
6677      ~(x = y) /\ ~(y = z) /\ ~(x = z) ==>
6678     (3 <= CARD A)`,
6679   (* {{{ proof *)
6680   [
6681   REPEAT WEAK_STRIP_TAC;
6682   MATCH_MP_TAC (arith `2 <= CARD A /\ ~(CARD A = 2) ==> (3 <= CARD A)`);
6683   SUBCONJ_TAC;
6684     MATCH_MP_TAC Hypermap.CARD_ATLEAST_2;
6685     BY(ASM_MESON_TAC[]);
6686   REPEAT WEAK_STRIP_TAC;
6687   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `CARD {x,y} < CARD A`) ASSUME_TAC));
6688     MATCH_MP_TAC CARD_PSUBSET;
6689     ASM_REWRITE_TAC[ PSUBSET_MEMBER ];
6690     CONJ_TAC;
6691       BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN SET_TAC[]);
6692     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `z`)));
6693     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN SET_TAC[]);
6694   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `CARD {x,y} = 2`) ASSUME_TAC));
6695     MATCH_MP_TAC Hypermap.CARD_TWO_ELEMENTS;
6696     BY(ASM_REWRITE_TAC[]);
6697   REPLICATE_TAC 4 (FIRST_X_ASSUM MP_TAC);
6698   BY(ARITH_TAC)
6699   ]);;
6700   (* }}} *)
6701
6702 let polyhedron_3_facets = prove_by_refinement(
6703   `!(p:real^A->bool). polyhedron p /\ bounded p /\ (&1 < aff_dim p) ==>
6704     FINITE { c | c facet_of p } /\ 3 <= CARD {c | c facet_of p }    `,
6705   (* {{{ proof *)
6706   [
6707   REPEAT WEAK_STRIP_TAC;
6708   SUBCONJ_TAC;
6709     BY(ASM_MESON_TAC[ FINITE_POLYHEDRON_FACETS ]);
6710   DISCH_TAC;
6711   INTRO_TAC POLYTOPE_FACET_EXISTS [`p`];
6712   ANTS_TAC;
6713     CONJ_TAC;
6714       BY(ASM_REWRITE_TAC[ POLYTOPE_EQ_BOUNDED_POLYHEDRON ]);
6715     FIRST_X_ASSUM_ST `aff_dim` MP_TAC;
6716     BY(INT_ARITH_TAC);
6717   REPEAT WEAK_STRIP_TAC;
6718   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`f SUBSET p`) ASSUME_TAC));
6719     BY(ASM_MESON_TAC[facet_of;FACE_OF_IMP_SUBSET]);
6720   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(f = p)`) ASSUME_TAC));
6721     BY(ASM_MESON_TAC[ FACET_OF_REFL]);
6722   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?x. x IN p DIFF f`) MP_TAC));
6723     REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC);
6724     BY(SET_TAC[]);
6725   REPEAT WEAK_STRIP_TAC;
6726   INTRO_TAC KREIN_MILMAN_MINKOWSKI [`p`];
6727   ANTS_TAC;
6728     CONJ_TAC;
6729       BY(ASM_SIMP_TAC [ POLYHEDRON_IMP_CONVEX ]);
6730     BY(ASM_MESON_TAC[POLYTOPE_IMP_COMPACT;POLYTOPE_EQ_BOUNDED_POLYHEDRON]);
6731   DISCH_TAC;
6732   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?y. y extreme_point_of p /\ ~(y IN f)`) MP_TAC));
6733     GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `~({x | x extreme_point_of p} SUBSET f)`)));
6734       REWRITE_TAC[SUBSET;IN_ELIM_THM];
6735       BY(MESON_TAC[]);
6736     DISCH_TAC;
6737     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `p SUBSET convex hull f`) ASSUME_TAC));
6738       FIRST_X_ASSUM_ST `convex` SUBST1_TAC;
6739       MATCH_MP_TAC Marchal_cells.CONVEX_HULL_SUBSET;
6740       BY(ASM_REWRITE_TAC[]);
6741     FIRST_X_ASSUM MP_TAC;
6742     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`convex hull f = f`) SUBST1_TAC));
6743       REWRITE_TAC[ CONVEX_HULL_EQ ];
6744       BY(ASM_MESON_TAC[ FACET_OF_IMP_FACE_OF; FACE_OF_IMP_CONVEX; ]);
6745     FIRST_X_ASSUM_ST `DIFF` MP_TAC;
6746     BY(SET_TAC[]);
6747   REWRITE_TAC[ GSYM FACE_OF_SING ];
6748   REPEAT WEAK_STRIP_TAC;
6749   INTRO_TAC FACE_OF_POLYHEDRON [`p`;`{y}`];
6750   ASM_REWRITE_TAC[];
6751   ANTS_TAC;
6752     CONJ_TAC;
6753       BY(SET_TAC[]);
6754     INTRO_TAC AFF_DIM_SING [`y`];
6755     REPEAT WEAK_STRIP_TAC;
6756     SUBGOAL_THEN `~(&1 < (int_of_num 0))` ASSUME_TAC;
6757       BY(INT_ARITH_TAC);
6758     BY(ASM_MESON_TAC[]);
6759   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!f. {y} SUBSET f <=>  y IN f`) (fun t -> REWRITE_TAC[t])));
6760     BY(SET_TAC[]);
6761   TYPED_ABBREV_TAC `(A = { c | c facet_of p /\ (y:real^A) IN c })`;
6762   DISCH_TAC;
6763   COMMENT "1";
6764   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(A = {})`) MP_TAC));
6765     DISCH_TAC;
6766     FIRST_X_ASSUM_ST `INTERS` MP_TAC;
6767     ASM_REWRITE_TAC[];
6768     REWRITE_TAC[ INTERS_0 ];
6769     REPEAT WEAK_STRIP_TAC;
6770     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `p SUBSET {y}`) MP_TAC));
6771       BY(ASM_REWRITE_TAC[SUBSET_UNIV]);
6772     DISCH_TAC;
6773     FIRST_X_ASSUM (MP_TAC o (MATCH_MP AFF_DIM_SUBSET));
6774     REWRITE_TAC[ AFF_DIM_SING ];
6775     FIRST_X_ASSUM_ST `aff_dim` MP_TAC;
6776     BY(INT_ARITH_TAC);
6777   REWRITE_TAC[Misc_defs_and_lemmas.EMPTY_EXISTS ];
6778   REPEAT WEAK_STRIP_TAC;
6779   COMMENT "1b";
6780   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `u facet_of p`) ASSUME_TAC));
6781     FIRST_X_ASSUM MP_TAC;
6782     EXPAND_TAC "A";
6783     REWRITE_TAC[IN_ELIM_THM];
6784     BY(MESON_TAC[]);
6785   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `&1 <= aff_dim u`) ASSUME_TAC));
6786     FIRST_X_ASSUM MP_TAC;
6787     REWRITE_TAC[facet_of];
6788     FIRST_X_ASSUM_ST `aff_dim` MP_TAC;
6789     BY(INT_ARITH_TAC);
6790   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `aff_dim {y } = &0`) ASSUME_TAC));
6791     BY(REWRITE_TAC[ AFF_DIM_SING ]);
6792   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~( A = {u})`) MP_TAC));
6793     DISCH_TAC;
6794     FIRST_X_ASSUM_ST `INTERS` MP_TAC;
6795     ASM_REWRITE_TAC[];
6796     REWRITE_TAC[ INTERS_1 ];
6797     DISCH_TAC;
6798     REPEAT (FIRST_X_ASSUM_ST `aff_dim` MP_TAC);
6799     ASM_REWRITE_TAC[];
6800     BY(INT_ARITH_TAC);
6801   DISCH_TAC;
6802   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?v. v IN A /\ ~(v = u)`) ASSUME_TAC));
6803     FIRST_X_ASSUM MP_TAC;
6804     FIRST_X_ASSUM_ST `IN` MP_TAC;
6805     GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `{u} SUBSET A /\ ~(A = {u}) ==> (?v. v IN A DIFF {u})`)));
6806       REWRITE_TAC[SUBSET;IN_DIFF;IN_SING];
6807       BY(MESON_TAC[]);
6808     BY(SET_TAC[]);
6809   FIRST_X_ASSUM MP_TAC;
6810   REPEAT WEAK_STRIP_TAC;
6811   MATCH_MP_TAC CARD_AT_LEAST3;
6812   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `f`)));
6813   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `u`)));
6814   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `v`)));
6815   ASM_REWRITE_TAC[IN_ELIM_THM];
6816   REPLICATE_TAC 2 (FIRST_X_ASSUM_ST `IN` MP_TAC);
6817   EXPAND_TAC "A";
6818   REWRITE_TAC[IN_ELIM_THM];
6819   BY(ASM_MESON_TAC[])
6820   ]);;
6821   (* }}} *)
6822
6823 let facet_3_facets = prove_by_refinement(
6824   `!(p:real^3->bool) f.
6825     polyhedron p  /\ bounded p /\ (vec 0 IN interior p) /\
6826     f facet_of p ==>
6827     FINITE {e | e facet_of f} /\ 3 <= CARD {e | e facet_of f}
6828     `,
6829   (* {{{ proof *)
6830   [
6831   REPEAT WEAK_STRIP_TAC;
6832   MATCH_MP_TAC polyhedron_3_facets;
6833   SUBCONJ_TAC;
6834     MATCH_MP_TAC FACE_OF_POLYHEDRON_POLYHEDRON;
6835     BY(ASM_MESON_TAC[ FACET_OF_IMP_FACE_OF ]);
6836   DISCH_TAC;
6837   CONJ_TAC;
6838     MATCH_MP_TAC BOUNDED_SUBSET;
6839     BY(ASM_MESON_TAC[ FACET_OF_IMP_FACE_OF; FACE_OF_IMP_SUBSET]);
6840   FIRST_X_ASSUM_ST `facet_of` MP_TAC;
6841   REWRITE_TAC[facet_of];
6842   ASM_SIMP_TAC[ (ISPEC `(vec 0):real^3` Polyhedron.AFF_DIM_INTERIOR_EQ_3) ];
6843   BY(INT_ARITH_TAC)
6844   ]);;
6845   (* }}} *)
6846
6847 let YSSKQOY_VECTOR = prove_by_refinement(
6848   `!v (w:real^3) theta. v IN ball_annulus /\ w IN ball_annulus /\ ~(v = w) /\
6849     &2 <= dist(v,w) /\
6850     (\ v. acs(norm v/ &4) - pi/ &6) = theta ==>
6851     theta v + theta w <= arcV (vec 0) v w`,
6852   (* {{{ proof *)
6853   [
6854   REPEAT WEAK_STRIP_TAC;
6855   INTRO_TAC Ysskqoy.YSSKQOY [`norm v / &2`;`norm w / &2 `];
6856   ANTS_TAC;
6857     INTRO_TAC ckq_in_ball_annulus [`v`];
6858     INTRO_TAC ckq_in_ball_annulus [`w`];
6859     ASM_REWRITE_TAC[];
6860     BY(REAL_ARITH_TAC);
6861   EXPAND_TAC "theta";
6862   MATCH_MP_TAC (arith `x = x' /\ y <= y' ==> (x <= y ==> x' <= y')`);
6863   CONJ_TAC;
6864     REWRITE_TAC[arith `x/ &2 / &2 = x/ &4`];
6865     BY(REAL_ARITH_TAC);
6866   GMATCH_SIMP_TAC Trigonometry1.arcVarc;
6867   REWRITE_TAC[DIST_0; arith `&2 * x / &2 = x`];
6868   REPEAT (GMATCH_SIMP_TAC Trigonometry1.ACS_ARCLENGTH);
6869   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `&0 < norm v /\ &0 < norm w /\ norm v <= norm w + &2 /\ norm w <= &2 + norm v /\ &2 <= norm v + norm w /\ ~( v = vec 0) /\ ~(w = vec 0) /\ &0 <= dist (v,w) /\  norm v <= norm w + dist (v,w) /\   norm w <= dist (v,w) + norm v /\ &0 <= &2`) MP_TAC));
6870     INTRO_TAC ckq_in_ball_annulus [`v`];
6871     INTRO_TAC ckq_in_ball_annulus [`w`];
6872     ASM_REWRITE_TAC[];
6873     MP_TAC Sphere.h0;
6874     REPEAT WEAK_STRIP_TAC;
6875     ASM_REWRITE_TAC[];
6876     REPEAT (FIRST_X_ASSUM MP_TAC);
6877     BY(REAL_ARITH_TAC);
6878   REPEAT WEAK_STRIP_TAC;
6879   ASM_REWRITE_TAC[];
6880   COMMENT "1";
6881   SUBCONJ_TAC;
6882     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `norm v = dist (v, vec 0) /\ norm w = dist(vec 0,w)`) (fun t -> REWRITE_TAC[t])));
6883       BY(REWRITE_TAC[DIST_0]);
6884     BY(REWRITE_TAC[DIST_TRIANGLE]);
6885   DISCH_TAC;
6886   MATCH_MP_TAC ACS_MONO_LE;
6887   ASM_SIMP_TAC[ Trigonometry1.TRI_SQUARES_BOUNDS ];
6888   GMATCH_SIMP_TAC REAL_LE_DIV2_EQ;
6889   CONJ_TAC;
6890     BY(ASM_MESON_TAC[ Real_ext.REAL_PROP_POS_MUL2 ; arith `&0 < &2`]);
6891   MATCH_MP_TAC (arith `(c' <= c) ==> (a + b - c <= a + b - c')`);
6892   GMATCH_SIMP_TAC Misc_defs_and_lemmas.ABS_SQUARE_LE;
6893   BY(ASM_REWRITE_TAC[arith `abs(&2) = &2`])
6894   ]);;
6895   (* }}} *)
6896
6897 let PACK_INEQ_DEF_A_797 = prove_by_refinement(
6898   `!v (v0:real^3).
6899     pack_ineq_def_a /\
6900     norm v0 = &2 /\
6901     &2 * h0 <= dist (v,v0) /\
6902     &2 <= norm v /\ norm v <= &2 * h0 ==>
6903     #0.797 + acs(norm v / &4) - pi / &6 < arclength  (norm v) (&2) (dist(v,v0))`,
6904   (* {{{ proof *)
6905   [
6906   REWRITE_TAC[Ysskqoy.pack_ineq_def_a];
6907   REPEAT WEAK_STRIP_TAC;
6908   REPLICATE_TAC 4 (FIRST_X_ASSUM MP_TAC);
6909   FIRST_X_ASSUM_ST `#0.797` MP_TAC;
6910   REPEAT (FIRST_X_ASSUM kill);
6911   REWRITE_TAC[Sphere.ineq];
6912   REWRITE_TAC[Sphere.acs_sqrt_x1_d4];
6913   REWRITE_TAC[Sphere.arclength_x_123];
6914   REPEAT WEAK_STRIP_TAC;
6915   FIRST_X_ASSUM (fun t-> INTRO_TAC t [`(norm v) pow 2`;`(norm v0) pow 2`;`(&2 * h0) pow 2`;`&1`;`&1`;`&1`]);
6916   ASM_REWRITE_TAC[arith `!x. x <= x`;arith `&2 pow 2  = &4`];
6917   ANTS_TAC;
6918     MP_TAC (GSYM Sphere.h0);
6919     REWRITE_TAC[ GSYM REAL_LE_SQUARE_ABS; arith `&4 = &2 pow 2`];
6920     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
6921   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`sqrt(norm v pow 2) = norm v`) SUBST1_TAC));
6922     MATCH_MP_TAC POW_2_SQRT;
6923     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
6924   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`sqrt((&2 * h0) pow 2) = (&2 * h0)`) SUBST1_TAC));
6925     MATCH_MP_TAC POW_2_SQRT;
6926     MP_TAC Sphere.h0;
6927     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
6928   REWRITE_TAC[ Collect_geom2.SQRT4_EQ2 ];
6929   DISCH_TAC;
6930   MATCH_MP_TAC REAL_LTE_TRANS;
6931   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `arclength (norm v) (&2) (&2 * h0)`)));
6932   CONJ_TAC;
6933     BY(FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC);
6934   COMMENT "1";
6935   REPEAT (GMATCH_SIMP_TAC Trigonometry1.ACS_ARCLENGTH);
6936   ASSUME_TAC (GSYM Sphere.h0);
6937   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `&0 < norm v /\ &0 < &2 /\ &0 <= dist (v,v0) /\    norm v <= &2 + dist (v,v0) /\   &2 <= dist (v,v0) + norm v /\   &0 <= &2 * h0 /\   &2 * h0 <= norm v + &2 /\   norm v <= &2 + &2 * h0 /\   &2 <= &2 * h0 + norm v /\ &2 <= &2 * h0 /\ &2 <= &2 * h0 + norm v`) MP_TAC));
6938     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
6939   REPEAT WEAK_STRIP_TAC;
6940   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`dist(v,v0) <= dist(v,(vec 0)) + dist ((vec 0),v0)`) MP_TAC));
6941     BY(REWRITE_TAC[DIST_TRIANGLE]);
6942   ASM_REWRITE_TAC[DIST_0];
6943   DISCH_TAC;
6944   ASM_REWRITE_TAC[];
6945   MATCH_MP_TAC ACS_MONO_LE;
6946   ASM_SIMP_TAC[ Trigonometry1.TRI_SQUARES_BOUNDS ];
6947   GMATCH_SIMP_TAC REAL_LE_DIV2_EQ;
6948   CONJ_TAC;
6949     BY(BY(ASM_MESON_TAC[ Real_ext.REAL_PROP_POS_MUL2 ; arith `&0 < &2`]));
6950   MATCH_MP_TAC (arith `(c' <= c) ==> (a + b - c <= a + b - c')`);
6951   GMATCH_SIMP_TAC Misc_defs_and_lemmas.ABS_SQUARE_LE;
6952   BY(BY(ASM_SIMP_TAC[arith `(#1.26 = h0) ==> abs(&2 * h0) = &2 * h0`]))
6953   ]);;
6954   (* }}} *)
6955
6956 let YSSKQOY_VECTOR2 = prove_by_refinement(
6957   `!v0 (w:real^3). v0 IN ball_annulus /\ w IN ball_annulus /\ ~(w = v0) /\
6958     &2 * h0 <= dist(w,v0) /\
6959     pack_ineq_def_a /\
6960     norm v0 = &2 ==>
6961     #0.797 + acs(norm w/ &4) - pi/ &6 <= arcV (vec 0) v0 w`,
6962   (* {{{ proof *)
6963   [
6964  REPEAT WEAK_STRIP_TAC;
6965   REWRITE_TAC[];
6966   GMATCH_SIMP_TAC Trigonometry1.arcVarc;
6967   REWRITE_TAC[DIST_0];
6968   ASM_REWRITE_TAC[];
6969   ONCE_REWRITE_TAC[ Arc_properties.arc_sym];
6970   REPEAT (FIRST_X_ASSUM_ST `ball_annulus` MP_TAC);
6971   REWRITE_TAC[ ckq_in_ball_annulus];
6972   REPEAT WEAK_STRIP_TAC;
6973   ASM_REWRITE_TAC[];
6974   ONCE_REWRITE_TAC[DIST_SYM];
6975   MATCH_MP_TAC (arith `x < y ==> (x <= y)`);
6976   MATCH_MP_TAC PACK_INEQ_DEF_A_797;
6977   BY(ASM_REWRITE_TAC[])
6978   ]);;
6979   (* }}} *)
6980
6981 let YSSKQOY_VECTOR2_ALT = prove_by_refinement(
6982   `!V v w (v0:real^3) theta.
6983     V SUBSET ball_annulus /\
6984     packing V /\
6985     (v IN V) /\ (w IN V) /\ (v0 IN V) /\
6986     ~(v = w) /\
6987     (!w. w IN V /\ ~(w = v0) ==> &2 * h0 <= dist (w,v0)) /\
6988     pack_ineq_def_a /\
6989     norm v0 = &2 /\
6990     (\ v. (if (v = v0) then #0.797 else acs(norm v/ &4) - pi/ &6)) = theta ==>
6991     theta v + theta w <= arcV (vec 0) v w`,
6992   (* {{{ proof *)
6993   [
6994   REPEAT WEAK_STRIP_TAC;
6995   EXPAND_TAC "theta";
6996   REPEAT (COND_CASES_TAC);
6997         BY(ASM_MESON_TAC[]);
6998       MATCH_MP_TAC YSSKQOY_VECTOR2;
6999       BY(ASM_MESON_TAC[ SUBSET]);
7000     ONCE_REWRITE_TAC[arith `a + b = b + a`];
7001     ASM_REWRITE_TAC[];
7002     ONCE_REWRITE_TAC[ Trigonometry2.ARC_SYM ];
7003     MATCH_MP_TAC YSSKQOY_VECTOR2;
7004     BY(ASM_MESON_TAC[ SUBSET ]);
7005   INTRO_TAC YSSKQOY_VECTOR [`v`;`w`;`(\v. acs (norm (v:real^3) / &4) - pi / &6)`];
7006   ASM_REWRITE_TAC[];
7007   DISCH_THEN MATCH_MP_TAC;
7008   FIRST_X_ASSUM_ST `packing` MP_TAC;
7009   REWRITE_TAC[Sphere.packing];
7010   BY(ASM_MESON_TAC[IN;SUBSET])
7011   ]);;
7012   (* }}} *)
7013
7014 let ACS_ROOT32 = prove_by_refinement(
7015   `acs (sqrt(&3) / &2) = pi / &6`,
7016   (* {{{ proof *)
7017   [
7018   REWRITE_TAC[GSYM COS_PI6];
7019   MATCH_MP_TAC ACS_COS;
7020   MP_TAC PI_POS;
7021   BY(REAL_ARITH_TAC)
7022   ]);;
7023   (* }}} *)
7024
7025 let ASN_HALF = prove_by_refinement(
7026   `asn (&1 / &2) = pi/ &6`,
7027   (* {{{ proof *)
7028   [
7029   REWRITE_TAC[GSYM SIN_PI6];
7030   MATCH_MP_TAC ASN_SIN;
7031   MP_TAC PI_POS;
7032   BY(REAL_ARITH_TAC)
7033   ]);;
7034   (* }}} *)
7035
7036 let THETA_BOUNDS = prove_by_refinement(
7037   `!v theta. (v IN ball_annulus) /\ (\v. acs(norm v / &4) - pi/ &6) = theta
7038     ==> ( &0 < theta v /\ theta v < pi / &2)`,
7039   (* {{{ proof *)
7040   [
7041   REPEAT WEAK_STRIP_TAC;
7042   EXPAND_TAC "theta";
7043   REWRITE_TAC[arith `x - y < u <=> -- y < u -x `;arith `&0 < x - y <=> y < x`];
7044   SUBGOAL_THEN `!x y. y <= x ==> -- (pi/ &6) < x - y` GMATCH_SIMP_TAC;
7045     REPEAT GEN_TAC;
7046     MP_TAC PI_POS;
7047     BY(REAL_ARITH_TAC);
7048   REWRITE_TAC[ GSYM ACS_0 ];
7049   REWRITE_TAC[ GSYM ACS_ROOT32];
7050   GMATCH_SIMP_TAC ACS_MONO_LT;
7051   GMATCH_SIMP_TAC ACS_MONO_LE;
7052   FIRST_X_ASSUM_ST `IN` MP_TAC;
7053   REWRITE_TAC[ ckq_in_ball_annulus ];
7054   MP_TAC Sphere.h0;
7055   MP_TAC Flyspeck_constants.bounds;
7056   REWRITE_TAC[Sphere.sqrt3];
7057   BY(REAL_ARITH_TAC)
7058   ]);;
7059   (* }}} *)
7060
7061 let INJ_FINITE_EXISTS = prove_by_refinement(
7062   `!n (A:A->bool) (B:B->bool).
7063     A HAS_SIZE n /\ FINITE B /\ n <= CARD B  ==>
7064     (?j. INJ j A B)
7065     `,
7066   (* {{{ proof *)
7067   [
7068   INDUCT_TAC;
7069     REWRITE_TAC[HAS_SIZE];
7070     REPEAT WEAK_STRIP_TAC;
7071     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `A = {}`) (fun t -> REWRITE_TAC[t])));
7072       BY(ASM_MESON_TAC[ CARD_EQ_0; SUBSET_EMPTY]);
7073     BY(REWRITE_TAC[INJ;NOT_IN_EMPTY]);
7074   REPEAT WEAK_STRIP_TAC;
7075   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(A = {}) /\ ~(B = {})`) (fun t -> ASSUME_TAC t THEN MP_TAC t)));
7076     REWRITE_TAC[ GSYM HAS_SIZE_0];
7077     REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC);
7078     REWRITE_TAC[HAS_SIZE];
7079     BY(MESON_TAC[ arith `~(0 = SUC n) /\ ~(SUC n <= 0)`]);
7080   REWRITE_TAC[ Misc_defs_and_lemmas.EMPTY_EXISTS ];
7081   REPEAT WEAK_STRIP_TAC;
7082   FIRST_X_ASSUM (C INTRO_TAC[`A DELETE u`;`B DELETE u'`]);
7083   ANTS_TAC;
7084     ASM_REWRITE_TAC[ FINITE_DELETE ];
7085     CONJ_TAC;
7086       FIRST_X_ASSUM_ST `HAS_SIZE` MP_TAC;
7087       REWRITE_TAC[ HAS_SIZE_SUC ];
7088       BY(ASM_MESON_TAC[]);
7089     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?m. (n <= m) /\  B HAS_SIZE (SUC m)`) MP_TAC));
7090       ASM_REWRITE_TAC[HAS_SIZE];
7091       GOAL_TERM (fun w -> (EXISTS_TAC ( env w `PRE (CARD B)`)));
7092       FIRST_X_ASSUM_ST `SUC` MP_TAC;
7093       BY(ARITH_TAC);
7094     REPEAT WEAK_STRIP_TAC;
7095     FIRST_X_ASSUM MP_TAC;
7096     REWRITE_TAC[ HAS_SIZE_SUC ];
7097     BY(ASM_MESON_TAC[HAS_SIZE]);
7098   REPEAT WEAK_STRIP_TAC;
7099   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `\ a. if (a = u) then u' else j a`)));
7100   REWRITE_TAC[INJ];
7101   SUBCONJ_TAC;
7102     REPEAT WEAK_STRIP_TAC;
7103     COND_CASES_TAC;
7104       BY(ASM_REWRITE_TAC[]);
7105     FIRST_X_ASSUM_ST `INJ` MP_TAC;
7106     REWRITE_TAC[INJ;IN_DELETE];
7107     BY(ASM_MESON_TAC[]);
7108   DISCH_TAC;
7109   REPEAT GEN_TAC;
7110   FIRST_X_ASSUM_ST `INJ` MP_TAC;
7111   REWRITE_TAC[INJ;IN_DELETE];
7112   BY(REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN TRY (ASM_MESON_TAC[]))
7113   ]);;
7114   (* }}} *)
7115
7116 let INJ_EXTENSION = prove_by_refinement(
7117   `!(A:A->bool) (B:B->bool) A' j'.
7118     INJ j' A' B /\ A' SUBSET A /\ FINITE A /\ FINITE B /\ CARD A <= CARD B ==>
7119      (?j. INJ j A B /\ (!a. a IN A' ==> j a = j' a))`,
7120   (* {{{ proof *)
7121   [
7122   REPEAT WEAK_STRIP_TAC;
7123   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?k. INJ k (A DIFF A') (B DIFF (IMAGE j' A'))`) MP_TAC));
7124     MATCH_MP_TAC INJ_FINITE_EXISTS;
7125     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `CARD (A DIFF A')`)));
7126     SUBCONJ_TAC;
7127       BY(ASM_MESON_TAC[HAS_SIZE;FINITE_DIFF]);
7128     DISCH_TAC;
7129     CONJ_TAC;
7130       BY(ASM_MESON_TAC[FINITE_DIFF]);
7131     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `IMAGE j' A' SUBSET B`) MP_TAC));
7132       FIRST_X_ASSUM_ST `INJ` MP_TAC;
7133       REWRITE_TAC[INJ;SUBSET;IN_IMAGE];
7134       BY(MESON_TAC[]);
7135     DISCH_TAC;
7136     ASM_SIMP_TAC[ CARD_DIFF ];
7137     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `CARD (IMAGE j' A') <= CARD (A')`) MP_TAC));
7138       MATCH_MP_TAC CARD_IMAGE_LE;
7139       BY(ASM_MESON_TAC[FINITE_SUBSET]);
7140     FIRST_X_ASSUM_ST `(<=):(num->num->bool)` MP_TAC;
7141     BY(ARITH_TAC);
7142   REPEAT WEAK_STRIP_TAC;
7143   REPEAT (FIRST_X_ASSUM MP_TAC);
7144   REWRITE_TAC[SUBSET;INJ;IN_DIFF;IN_IMAGE];
7145   REPEAT WEAK_STRIP_TAC;
7146   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `\v. if (v IN A') then j' v else k v`)));
7147   BY(REPEAT (COND_CASES_TAC) THEN TRY (ASM_MESON_TAC[]))
7148   ]);;
7149   (* }}} *)
7150
7151 let BIJ_EXTENDS_INJ = prove_by_refinement(
7152   `! (A:A->bool) (B:B->bool) A' j'.
7153      FINITE A /\ FINITE B /\ A' SUBSET A /\ (INJ j' A' B) /\
7154     (CARD A = CARD B)  ==>
7155     (?j. BIJ j A B /\ (!a. a IN A' ==> j' a = j a))`,
7156   (* {{{ proof *)
7157   [
7158   REPEAT WEAK_STRIP_TAC;
7159   INTRO_TAC INJ_EXTENSION [`A`;`B`;`A'`;`j'`];
7160   ASM_REWRITE_TAC[];
7161   ANTS_TAC;
7162     FIRST_X_ASSUM MP_TAC;
7163     BY(ARITH_TAC);
7164   REPEAT WEAK_STRIP_TAC;
7165   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `j`)));
7166   ASM_REWRITE_TAC[BIJ];
7167   BY(ASM_MESON_TAC[Ysskqoy.INJ_IFF_SURJ])
7168   ]);;
7169   (* }}} *)
7170
7171 let DLWCHEM_VECTOR_sum = prove_by_refinement(
7172   `!k (V:real^3->bool) n theta. pack_ineq_def_a /\
7173     (\v. acs (norm v / &4) - pi / &6) = theta /\
7174     (!v. v IN V ==> (3 <= k v)) /\
7175     (12 < n) /\
7176     (V HAS_SIZE n) /\
7177     (V SUBSET ball_annulus) /\
7178     (sum V (\v. &(k v)) <= (&6 * &n - &12)) /\
7179     (sum V (\v. max (&0) (regular_spherical_polygon_area (cos(theta v)) (&(k v)))) <= &4 * pi) /\
7180     ~(lmfun_ineq_center V)
7181  ==> (n < 16)`,
7182   (* {{{ proof *)
7183   [
7184   REPEAT WEAK_STRIP_TAC;
7185   MATCH_MP_TAC DLWCHEM_sum;
7186   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?b. BIJ b (0..(n-1)) V`) MP_TAC));
7187     INTRO_TAC BIJ_EXTENDS_INJ [`(0..(n-1))`;`V`;`{}:num->bool`];
7188     REWRITE_TAC[EMPTY_SUBSET;INJ;NOT_IN_EMPTY];
7189     DISCH_THEN MATCH_MP_TAC;
7190     INTRO_TAC HAS_SIZE_NUMSEG [`0`;`n-1`];
7191     FIRST_X_ASSUM_ST `HAS_SIZE` MP_TAC;
7192     REWRITE_TAC[HAS_SIZE];
7193     FIRST_X_ASSUM_ST `12 < n` MP_TAC;
7194     BY(MESON_TAC[arith `12 < n ==> (n - 1 + 1) - 0 =  n`]);
7195   REPEAT WEAK_STRIP_TAC;
7196   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `(\v. (norm v) / &2) o b`)));
7197   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `k o b`)));
7198   ASM_REWRITE_TAC[];
7199   SUBCONJ_TAC;
7200     REPEAT WEAK_STRIP_TAC;
7201     REWRITE_TAC[o_DEF];
7202     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `b i IN V`) ASSUME_TAC));
7203       FIRST_X_ASSUM_ST `BIJ` MP_TAC;
7204       REWRITE_TAC[BIJ;INJ;IN_NUMSEG];
7205       BY(ASM_MESON_TAC[arith `i < n ==> 0 <= i /\ i <= n-1`]);
7206     ASM_SIMP_TAC[];
7207     FIRST_X_ASSUM_ST `ball_annulus` MP_TAC;
7208     REWRITE_TAC[ckq_in_ball_annulus; SUBSET];
7209     DISCH_THEN (C INTRO_TAC[`b i`]);
7210     ASM_REWRITE_TAC[];
7211     MP_TAC Sphere.h0;
7212     BY(REAL_ARITH_TAC);
7213   DISCH_TAC;
7214   COMMENT "1";
7215   CONJ_TAC;
7216     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(\i. &((k o b) i)) = (\v. &(k v)) o b`) SUBST1_TAC));
7217       BY(REWRITE_TAC[FUN_EQ_THM;o_DEF]);
7218     GMATCH_SIMP_TAC BIJ_SUM;
7219     BY(ASM_MESON_TAC[]);
7220   CONJ_TAC;
7221     INTRO_TAC SUM_EQ [`(\i. max (&0)       (regular_spherical_polygon_area       (((\v. norm v / &2) o b) i * sqrt3 /  #4.0 +        sqrt (&1 - (((\v. norm v / &2) o b) i / &2) pow 2) / &2)      (&((k o b) i))))`;`(\v. max (&0) (regular_spherical_polygon_area (cos (theta v)) (&(k v)))) o b`;`(0..(n-1))`];
7222     DISCH_THEN GMATCH_SIMP_TAC;
7223     CONJ_TAC;
7224       GEN_TAC;
7225       REWRITE_TAC[FUN_EQ_THM;o_DEF;IN_NUMSEG];
7226       REPEAT WEAK_STRIP_TAC;
7227       REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
7228       GMATCH_SIMP_TAC COSG;
7229       GOAL_TERM (fun w -> (EXISTS_TAC ( env w `norm (b x) / &2`)));
7230       EXPAND_TAC "theta";
7231       REWRITE_TAC[arith `x / &2 / &2 = x / &4`;arith `#4.0 = &4`;Sphere.sqrt3];
7232       FIRST_X_ASSUM (MP_TAC o (ISPEC `x:num`));
7233       ANTS_TAC;
7234         REPEAT (FIRST_X_ASSUM MP_TAC);
7235         BY(ARITH_TAC);
7236       REWRITE_TAC[o_DEF];
7237       MP_TAC Sphere.h0;
7238       BY(REAL_ARITH_TAC);
7239     GMATCH_SIMP_TAC BIJ_SUM;
7240     BY(ASM_MESON_TAC[]);
7241   FIRST_X_ASSUM_ST `lmfun_ineq_center` MP_TAC;
7242   REWRITE_TAC[ Pack_defs.lmfun_ineq_center ; arith `~(x <= &12) <=> (&12 < x)`];
7243   INTRO_TAC SUM_EQ [`(\i. lfun (((\v. norm v / &2) o b) i))`;`(\v. lmfun (hl [vec 0; v])) o b`;`(0..(n-1))`];
7244   DISCH_THEN GMATCH_SIMP_TAC;
7245   CONJ_TAC;
7246     REWRITE_TAC[FUN_EQ_THM;IN_NUMSEG;o_DEF];
7247     REPEAT WEAK_STRIP_TAC;
7248     REWRITE_TAC[ Marchal_cells_3.HL_2 ; DIST_0; arith `inv (&2) *x = x/ &2`];
7249     GMATCH_SIMP_TAC Nonlinear_lemma.lmfun_lfun;
7250     FIRST_X_ASSUM (MP_TAC o (ISPEC `x:num`));
7251     ANTS_TAC;
7252       REPEAT (FIRST_X_ASSUM MP_TAC);
7253       BY(ARITH_TAC);
7254     REWRITE_TAC[o_DEF];
7255     MP_TAC Sphere.h0;
7256     BY(REAL_ARITH_TAC);
7257   GMATCH_SIMP_TAC BIJ_SUM;
7258   BY(ASM_MESON_TAC[])
7259   ]);;
7260   (* }}} *)
7261
7262 let XULJEPR_VECTOR_sum = prove_by_refinement(
7263   `!k V n theta v0. ( pack_ineq_def_a /\
7264     (v0 IN V) /\
7265     (\v. (if (v = v0) then (#0.797) else acs (norm v / &4) - pi / &6)) = theta /\
7266     (12 < n) /\
7267     (norm v0 = &2) /\
7268     (!v. (v IN V ==> 3 <= k v)) /\
7269     V HAS_SIZE n /\
7270     V SUBSET ball_annulus /\
7271     sum V (\v. &(k v)) <= &6 * &n - &12 /\
7272     sum V (\v. max (&0)  (regular_spherical_polygon_area (cos (theta v)) (&(k v)))) <=  &4 * pi /\
7273     ~lmfun_ineq_center V ==> F)`,
7274   (* {{{ proof *)
7275   [
7276   REPEAT WEAK_STRIP_TAC;
7277   MATCH_MP_TAC XULJEPR_sum;
7278   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?b. BIJ b (0..(n-1)) V /\ b 0 = v0`) MP_TAC));
7279     INTRO_TAC BIJ_EXTENDS_INJ [`(0..(n-1))`;`V`;`{0}`;`\ (i:num). v0`];
7280     REWRITE_TAC[IN_SING];
7281     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(!(j:num->real^3). (!a. a = 0 ==> (v0 = j a)) <=> (j 0 = v0))`) (fun t -> REWRITE_TAC[t])));
7282       BY(MESON_TAC[]);
7283     DISCH_THEN MATCH_MP_TAC;
7284     INTRO_TAC HAS_SIZE_NUMSEG [`0`;`n-1`];
7285     FIRST_X_ASSUM_ST `HAS_SIZE` MP_TAC;
7286     REWRITE_TAC[HAS_SIZE];
7287     FIRST_X_ASSUM_ST `12 < n` MP_TAC;
7288     REWRITE_TAC[INJ;SUBSET;IN_SING;IN_NUMSEG];
7289     BY(BY(ASM_MESON_TAC[arith `12 < n ==> (n - 1 + 1) - 0 =  n`;arith `0 <= 0 /\ (12 < n==> 0 <= n-1)`]));
7290   REPEAT WEAK_STRIP_TAC;
7291   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `(\v. (norm v) / &2) o b`)));
7292   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `k o b`)));
7293   EXISTS_TAC `n:num`;
7294   ASM_REWRITE_TAC[];
7295   COMMENT "1";
7296   CONJ_TAC;
7297     ASM_REWRITE_TAC[o_DEF];
7298     BY(REAL_ARITH_TAC);
7299   SUBCONJ_TAC;
7300     REPEAT WEAK_STRIP_TAC;
7301     REWRITE_TAC[o_DEF];
7302     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `b i IN V`) ASSUME_TAC));
7303       FIRST_X_ASSUM_ST `BIJ` MP_TAC;
7304       REWRITE_TAC[BIJ;INJ;IN_NUMSEG];
7305       BY(BY(ASM_MESON_TAC[arith `i < n ==> 0 <= i /\ i <= n-1`]));
7306     ASM_SIMP_TAC[];
7307     FIRST_X_ASSUM_ST `ball_annulus` MP_TAC;
7308     REWRITE_TAC[ckq_in_ball_annulus; SUBSET];
7309     DISCH_THEN (C INTRO_TAC[`b i`]);
7310     ASM_REWRITE_TAC[];
7311     MP_TAC Sphere.h0;
7312     BY(BY(REAL_ARITH_TAC));
7313   DISCH_TAC;
7314   COMMENT "1a 6n-12";
7315   CONJ_TAC;
7316     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(\i. &((k o b) i)) = (\v. &(k v)) o b`) SUBST1_TAC));
7317       BY(BY(REWRITE_TAC[FUN_EQ_THM;o_DEF]));
7318     GMATCH_SIMP_TAC BIJ_SUM;
7319     BY(BY(ASM_MESON_TAC[]));
7320   CONJ2_TAC;
7321     FIRST_X_ASSUM_ST `lmfun_ineq_center` MP_TAC;
7322     REWRITE_TAC[ Pack_defs.lmfun_ineq_center ; arith `~(x <= &12) <=> (&12 < x)`];
7323     INTRO_TAC SUM_EQ [`(\i. lfun (((\v. norm v / &2) o b) i))`;`(\v. lmfun (hl [vec 0; v])) o b`;`(0..(n-1))`];
7324     DISCH_THEN GMATCH_SIMP_TAC;
7325     CONJ_TAC;
7326       REWRITE_TAC[FUN_EQ_THM;IN_NUMSEG;o_DEF];
7327       REPEAT WEAK_STRIP_TAC;
7328       REWRITE_TAC[ Marchal_cells_3.HL_2 ; DIST_0; arith `inv (&2) *x = x/ &2`];
7329       GMATCH_SIMP_TAC Nonlinear_lemma.lmfun_lfun;
7330       FIRST_X_ASSUM (MP_TAC o (ISPEC `x:num`));
7331       ANTS_TAC;
7332         REPEAT (FIRST_X_ASSUM MP_TAC);
7333         BY(BY(ARITH_TAC));
7334       REWRITE_TAC[o_DEF];
7335       MP_TAC Sphere.h0;
7336       BY(BY(REAL_ARITH_TAC));
7337     GMATCH_SIMP_TAC BIJ_SUM;
7338     BY(BY(ASM_MESON_TAC[]));
7339   COMMENT "1b last conjunct";
7340   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `max (&0) (regular_spherical_polygon_area (cos  #0.797) (&((k o b) 0))) + sum (1..n - 1) (\i. max (&0)      (regular_spherical_polygon_area       (((\v. norm v / &2) o b) i * sqrt3 /  #4.0 +        sqrt (&1 - (((\v. norm v / &2) o b) i / &2) pow 2) / &2)      (&((k o b) i)))) = sum (0.. n-1) ( (\v. max (&0) (regular_spherical_polygon_area (cos (theta v)) (&(k v)))) o b)`) SUBST1_TAC));
7341     INTRO_TAC (GSYM SUM_COMBINE_R) [` ((\v. max (&0) (regular_spherical_polygon_area (cos (theta v)) (&(k v)))) o  b)`;`0`;`0`;`n - 1`];
7342     ANTS_TAC;
7343       BY(ARITH_TAC);
7344     DISCH_THEN SUBST1_TAC;
7345     REWRITE_TAC[arith `0+1 = 1`;SUM_SING_NUMSEG];
7346     MATCH_MP_TAC (arith `a = a' /\ b = b' ==> (a + b = a'+b')`);
7347     CONJ_TAC;
7348       REWRITE_TAC[o_DEF];
7349       ASM_REWRITE_TAC[];
7350       REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
7351       EXPAND_TAC "theta";
7352       BY(REWRITE_TAC[]);
7353     MATCH_MP_TAC SUM_EQ;
7354     GEN_TAC;
7355     REWRITE_TAC[FUN_EQ_THM;o_DEF;IN_NUMSEG];
7356     REPEAT WEAK_STRIP_TAC;
7357     REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
7358     GMATCH_SIMP_TAC COSG;
7359     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `norm (b x) / &2`)));
7360     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `theta (b x) = acs(norm (b x) / &4) - pi / &6`) SUBST1_TAC));
7361       EXPAND_TAC "theta";
7362       COND_CASES_TAC;
7363         SUBGOAL_THEN `x = 0` MP_TAC;
7364           FIRST_X_ASSUM_ST `BIJ` MP_TAC;
7365           REWRITE_TAC[BIJ;INJ;IN_NUMSEG];
7366           BY(ASM_MESON_TAC[arith `0 <= 0 /\ (12 < n ==> 0 <= n-1) /\ (1 <= x ==> 0 <= x)`]);
7367         REPLICATE_TAC 2 (FIRST_X_ASSUM_ST `1` MP_TAC);
7368         BY(ARITH_TAC);
7369       BY(REWRITE_TAC[]);
7370     REWRITE_TAC[arith `x / &2 / &2 = x / &4`;arith `#4.0 = &4`;Sphere.sqrt3];
7371     FIRST_X_ASSUM (MP_TAC o (ISPEC `x:num`));
7372     ANTS_TAC;
7373       REPEAT (FIRST_X_ASSUM MP_TAC);
7374       BY(BY(ARITH_TAC));
7375     REWRITE_TAC[o_DEF];
7376     MP_TAC Sphere.h0;
7377     BY(BY(REAL_ARITH_TAC));
7378   GMATCH_SIMP_TAC BIJ_SUM;
7379   BY(BY(ASM_MESON_TAC[]))
7380   ]);;
7381   (* }}} *)
7382
7383 let SOL_NN = prove_by_refinement(
7384   `!x U. (?r. &0 < r /\ measurable (U INTER normball x r) /\
7385       radial_norm r x (U INTER normball x r)) ==> &0 <= sol x U`,
7386   (* {{{ proof *)
7387   [
7388   REPEAT WEAK_STRIP_TAC;
7389   GMATCH_SIMP_TAC Vol1.sol;
7390   EXISTS_TAC `r:real`;
7391   ASM_REWRITE_TAC[];
7392   CONJ_TAC;
7393     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
7394   MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2;
7395   CONJ_TAC;
7396     BY(BY(REAL_ARITH_TAC));
7397   MATCH_MP_TAC REAL_LE_DIV;
7398   CONJ_TAC;
7399     MATCH_MP_TAC MEASURE_POS_LE;
7400     BY(BY(ASM_MESON_TAC[]));
7401   MATCH_MP_TAC REAL_POW_LE;
7402   BY(BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC))
7403   ]);;
7404   (* }}} *)
7405
7406 let FACET_SOL_NN = prove_by_refinement(
7407   `!p c. polyhedron p /\ bounded p /\ (vec 0) IN interior p /\
7408     c facet_of p ==>
7409     &0 <= sol (vec 0) (fchanged c)`,
7410   (* {{{ proof *)
7411   [
7412   REPEAT WEAK_STRIP_TAC;
7413   MATCH_MP_TAC SOL_NN;
7414   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `&1`)));
7415   ASM_SIMP_TAC[FCHANGED_RADIAL;FCHANGED_MEASURABLE];
7416   BY(ASM_MESON_TAC[Marchal_cells_2_new.RADIAL_VS_RADIAL_NORM;FCHANGED_RADIAL;FCHANGED_MEASURABLE;arith `&0 < &1`])
7417   ]);;
7418   (* }}} *)
7419
7420 let DLWCHEM = prove_by_refinement(
7421 `!V. packing V /\ pack_ineq_def_a /\
7422   V SUBSET ball_annulus /\ ~(lmfun_ineq_center V) ==>
7423    (CARD V = 13 \/ CARD V = 14 \/ CARD V = 15)`,
7424   (* {{{ proof *)
7425   [
7426   X_GENv_TAC "W";
7427   REPEAT WEAK_STRIP_TAC;
7428   INTRO_TAC LMFUN_INEQ_CENTER_IMP_13 [`W`];
7429   ASM_SIMP_TAC[fat_lemma1];
7430   GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `CARD W < 16`)));
7431     BY((ARITH_TAC));
7432   INTRO_TAC SATURATE_BALL_ANNULUS [`W`;`{}:real^3->bool`;`&2`];
7433   ASM_REWRITE_TAC[arith `&2 <= &2`;EMPTY_SUBSET];
7434   ANTS_TAC;
7435     CONJ_TAC;
7436       MP_TAC Sphere.h0;
7437       BY((REAL_ARITH_TAC));
7438     BY((REWRITE_TAC[X_IN NOT_IN_EMPTY]));
7439   REWRITE_TAC[X_IN NOT_IN_EMPTY];
7440   REPEAT WEAK_STRIP_TAC;
7441   GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `CARD V < 16`)));
7442     MATCH_MP_TAC (arith `y <= x ==> x < z ==> y < (z:num)`);
7443     MATCH_MP_TAC CARD_SUBSET;
7444     BY((ASM_REWRITE_TAC[]));
7445   FIRST_X_ASSUM_ST `SUBSET` kill;
7446   REPLICATE_TAC 6 (FIRST_X_ASSUM MP_TAC);
7447   FIRST_X_ASSUM_ST `pack_ineq_def_a` MP_TAC;
7448   REPEAT (FIRST_X_ASSUM kill);
7449   REPEAT WEAK_STRIP_TAC;
7450   COMMENT "1 saturated";
7451   TYPED_ABBREV_TAC (`n = CARD (V:real^3 ->bool)`);
7452   TYPED_ABBREV_TAC (`theta = \ (v:real^3). acs(norm v / &4) - pi / &6`);
7453   INTRO_TAC EXISTS_M_POLYHEDRON [`V`;`theta`;`&2`;`n`];
7454   ASM_REWRITE_TAC[];
7455   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `V HAS_SIZE n`) ASSUME_TAC));
7456     BY((ASM_MESON_TAC[HAS_SIZE]));
7457   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(V = {})`) ASSUME_TAC));
7458     BY((ASM_MESON_TAC[CARD_CLAUSES;arith `~(13 <= 0)`]));
7459   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w ` (!v w. v IN V /\ w IN V /\ ~(v = w) ==> theta v + theta w <= arcV (vec 0) v w)`) ASSUME_TAC));
7460     REPEAT WEAK_STRIP_TAC;
7461     MATCH_MP_TAC YSSKQOY_VECTOR;
7462     ASM_REWRITE_TAC[];
7463     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `&2 <= dist(v,w)`) (fun t -> REWRITE_TAC[t])));
7464       FIRST_X_ASSUM_ST `packing` MP_TAC;
7465       REWRITE_TAC[Sphere.packing];
7466       DISCH_THEN MATCH_MP_TAC;
7467       BY((ASM_MESON_TAC[IN]));
7468     BY((ASM_MESON_TAC[SUBSET]));
7469   ASM_REWRITE_TAC[];
7470   (COMMENT "1a");
7471   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w ` (!v. v IN V ==> &0 < theta v /\ theta v < pi / &2)`) ASSUME_TAC));
7472     REPEAT WEAK_STRIP_TAC;
7473     MATCH_MP_TAC THETA_BOUNDS;
7474     ASM_REWRITE_TAC[];
7475     BY(ASM_MESON_TAC[SUBSET]);
7476   ASM_REWRITE_TAC[];
7477   ANTS_TAC;
7478     MP_TAC Sphere.h0;
7479     BY(REAL_ARITH_TAC);
7480   REPEAT WEAK_STRIP_TAC;
7481   MATCH_MP_TAC DLWCHEM_VECTOR_sum;
7482   TYPED_ABBREV_TAC `k = \ (v:real^3). CARD { (e:real^3->bool) | e facet_of (f v) }`;
7483   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `k`)));
7484   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `V`)));
7485   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `theta`)));
7486   ASM_REWRITE_TAC[];
7487   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!v. v IN V ==> f v facet_of P`) ASSUME_TAC));
7488     FIRST_X_ASSUM_ST `BIJ` MP_TAC;
7489     REWRITE_TAC[BIJ;INJ;IN_ELIM_THM];
7490     BY(MESON_TAC[]);
7491   SUBCONJ_TAC;
7492     EXPAND_TAC "k";
7493     BY(ASM_MESON_TAC[facet_3_facets]);
7494   DISCH_TAC;
7495   CONJ_TAC;
7496     FIRST_X_ASSUM_ST `13` MP_TAC;
7497     BY(ARITH_TAC);
7498   CONJ_TAC;
7499     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(\v. &(k v)) = (\ c. &(CARD {e | e facet_of c })) o f`) SUBST1_TAC));
7500       EXPAND_TAC "k";
7501       BY(REWRITE_TAC[FUN_EQ_THM;o_DEF]);
7502     GMATCH_SIMP_TAC BIJ_SUM;
7503     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `{ c | c facet_of P }`)));
7504     ASM_REWRITE_TAC[];
7505     MATCH_MP_TAC polyhedron_edge_sum;
7506     ASM_SIMP_TAC[arith `13 <= n ==> 2 <= n`];
7507     REWRITE_TAC[HAS_SIZE];
7508     BY(ASM_MESON_TAC[ Misc_defs_and_lemmas.BIJ_CARD; Misc_defs_and_lemmas.FINITE_BIJ]);
7509   COMMENT "last conjunct: 4 pi";
7510   ASM_SIMP_TAC[GSYM POLYHEDRON_FACET_SUM_4Pi];
7511   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `sum {c | c facet_of P} (\c. sol (vec 0) (fchanged c)) = sum V ((\c. sol (vec 0) (fchanged c)) o f)`) SUBST1_TAC));
7512     GMATCH_SIMP_TAC BIJ_SUM;
7513     BY(ASM_MESON_TAC[]);
7514   MATCH_MP_TAC SUM_LE;
7515   ASM_REWRITE_TAC[];
7516   X_GENv_TAC "v";
7517   DISCH_TAC;
7518   REWRITE_TAC[o_DEF];
7519   MATCH_MP_TAC (arith `a <= x /\ b <= x==>    (max a b <= x)`);
7520   SUBCONJ_TAC;
7521     MATCH_MP_TAC FACET_SOL_NN;
7522     BY(ASM_MESON_TAC[]);
7523   DISCH_TAC;
7524   REWRITE_TAC[ Sphere.regular_spherical_polygon_area ];
7525   MATCH_MP_TAC GOTCJAH;
7526   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `f v`)));
7527   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `v`)));
7528   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `b v`)));
7529   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `P`)));
7530   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{u | u facet_of f v} HAS_SIZE k v`) (fun t -> REWRITE_TAC[t])));
7531     EXPAND_TAC "k";
7532     REWRITE_TAC[HAS_SIZE];
7533     MATCH_MP_TAC FACET_FINITE;
7534     BY(ASM_MESON_TAC[]);
7535   ASM_SIMP_TAC[];
7536   AP_TERM_TAC;
7537   REWRITE_TAC[FUN_EQ_THM;IN_ELIM_THM];
7538   GEN_TAC;
7539   REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
7540   BY(MESON_TAC[DOT_SYM])
7541   ]);;
7542   (* }}} *)
7543
7544 let XULJEPR_concl = `!V. packing V /\ V SUBSET ball_annulus /\ pack_ineq_def_a /\
7545  (?v.  v IN V /\ norm (v) = &2 /\ (!u.  (u IN V) /\ ~(u = v) ==> &2 * h0 <= dist(u,v) ))
7546 ==> (lmfun_ineq_center V)`;;
7547
7548 let XULJEPR = prove_by_refinement(
7549 `!V. packing V /\ V SUBSET ball_annulus /\ pack_ineq_def_a /\
7550  (?v.  v IN V /\ norm (v) = &2 /\ (!u.  (u IN V) /\ ~(u = v) ==> &2 * h0 <= dist(u,v) ))
7551 ==> (lmfun_ineq_center V)`,
7552   (* {{{ proof *)
7553   [
7554   X_GENv_TAC "W";
7555   REPEAT WEAK_STRIP_TAC;
7556   PROOF_BY_CONTR_TAC;
7557   INTRO_TAC LMFUN_INEQ_CENTER_IMP_13 [`W`];
7558   ASM_SIMP_TAC[fat_lemma1];
7559   DISCH_TAC;
7560   INTRO_TAC SATURATE_BALL_ANNULUS [`W`;`{v}`;`&2 * h0`];
7561   ANTS_TAC;
7562     ASM_REWRITE_TAC[arith `&2 * h0 <= &2 * h0`];
7563     CONJ_TAC;
7564       ASM_REWRITE_TAC[IN_SING;SUBSET];
7565       BY(ASM_MESON_TAC[]);
7566     CONJ_TAC;
7567       MP_TAC Sphere.h0;
7568       BY(((REAL_ARITH_TAC)));
7569     REWRITE_TAC[X_IN IN_SING];
7570     REPEAT WEAK_STRIP_TAC;
7571     BY(ASM_MESON_TAC[IN;arith `x <= y ==> ~(y < x)`;DIST_SYM]);
7572   REPEAT WEAK_STRIP_TAC;
7573   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `v IN V`) MP_TAC));
7574     BY(ASM_MESON_TAC[SUBSET]);
7575   REPLICATE_TAC 8 (FIRST_X_ASSUM MP_TAC);
7576   REWRITE_TAC[X_IN IN_SING];
7577   FIRST_X_ASSUM_ST `norm` MP_TAC;
7578   FIRST_X_ASSUM_ST `pack_ineq_def_a` MP_TAC;
7579   REPEAT (FIRST_X_ASSUM kill);
7580   REPEAT WEAK_STRIP_TAC;
7581   COMMENT "1 saturated";
7582   TYPED_ABBREV_TAC (`n = CARD (V:real^3 ->bool)`);
7583   RENAME_FREE_VAR (`v:real^3`,"v0");
7584   TYPED_ABBREV_TAC (`theta = \ (v:real^3). if (v = v0) then (#0.797) else acs(norm v / &4) - pi / &6`);
7585   INTRO_TAC EXISTS_M_POLYHEDRON [`V`;`theta`;`&2 * h0`;`n`];
7586   ASM_REWRITE_TAC[];
7587   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `V HAS_SIZE n`) ASSUME_TAC));
7588     BY(((ASM_MESON_TAC[HAS_SIZE])));
7589   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(V = {})`) ASSUME_TAC));
7590     BY(((ASM_MESON_TAC[CARD_CLAUSES;arith `~(13 <= 0)`])));
7591   COMMENT "1 still on M polyhedron ";
7592   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w ` (!v w. v IN V /\ w IN V /\ ~(v = w) ==> theta v + theta w <= arcV (vec 0) v w)`) ASSUME_TAC));
7593     REPEAT WEAK_STRIP_TAC;
7594     MATCH_MP_TAC YSSKQOY_VECTOR2_ALT;
7595     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `V`)));
7596     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `v0`)));
7597     ASM_REWRITE_TAC[];
7598     REWRITE_TAC[IN];
7599     BY(ASM_MESON_TAC[IN;DIST_SYM;arith `~(x < y) ==> (y <= x)`]);
7600   ASM_REWRITE_TAC[];
7601   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!v w. v IN V /\ w IN V /\ ~(v = w) ==> &2 <= dist(v,w)`) (fun t -> REWRITE_TAC[t])));
7602     REPEAT WEAK_STRIP_TAC;
7603     FIRST_X_ASSUM_ST `packing` MP_TAC;
7604     REWRITE_TAC[Sphere.packing];
7605     DISCH_THEN MATCH_MP_TAC;
7606     BY(((ASM_MESON_TAC[IN])));
7607   (COMMENT "1a");
7608   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w ` (!v. v IN V ==> &0 < theta v /\ theta v < pi / &2)`) ASSUME_TAC));
7609     REPEAT WEAK_STRIP_TAC;
7610     GOAL_TERM (fun w -> (ASM_CASES_TAC ( env w `v = v0`)));
7611       EXPAND_TAC "theta";
7612       ASM_REWRITE_TAC[];
7613       MP_TAC Flyspeck_constants.bounds;
7614       BY(REAL_ARITH_TAC);
7615     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `theta v = (\ v . acs (norm v / &4) - pi / &6 ) v`) SUBST1_TAC));
7616       EXPAND_TAC "theta";
7617       BY(ASM_REWRITE_TAC[]);
7618     MATCH_MP_TAC THETA_BOUNDS;
7619     ASM_REWRITE_TAC[];
7620     BY((ASM_MESON_TAC[SUBSET]));
7621   ASM_REWRITE_TAC[];
7622   SUBGOAL_THEN `&2 <= &2 * h0 /\ &2 * h0 <= &2 * h0` (fun t -> REWRITE_TAC[t]);
7623     MP_TAC Sphere.h0;
7624     BY((REAL_ARITH_TAC));
7625   MATCH_MP_TAC (TAUT `( p ==> F) ==> ~p`);
7626   REPEAT WEAK_STRIP_TAC;
7627   MATCH_MP_TAC XULJEPR_VECTOR_sum;
7628   TYPED_ABBREV_TAC `k = \ (v:real^3). CARD { (e:real^3->bool) | e facet_of (f v) }`;
7629   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `k`)));
7630   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `V`)));
7631   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `n`)));
7632   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `theta`)));
7633   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `v0`)));
7634   ASM_REWRITE_TAC[];
7635   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!v. v IN V ==> f v facet_of P`) ASSUME_TAC));
7636     FIRST_X_ASSUM_ST `BIJ` MP_TAC;
7637     REWRITE_TAC[BIJ;INJ;IN_ELIM_THM];
7638     BY((MESON_TAC[]));
7639   CONJ_TAC;
7640     FIRST_X_ASSUM_ST `13` MP_TAC;
7641     BY(ARITH_TAC);
7642   SUBCONJ_TAC;
7643     EXPAND_TAC "k";
7644     BY((ASM_MESON_TAC[facet_3_facets]));
7645   DISCH_TAC;
7646   CONJ_TAC;
7647     GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(\v. &(k v)) = (\ c. &(CARD {e | e facet_of c })) o f`) SUBST1_TAC));
7648       EXPAND_TAC "k";
7649       BY((REWRITE_TAC[FUN_EQ_THM;o_DEF]));
7650     GMATCH_SIMP_TAC BIJ_SUM;
7651     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `{ c | c facet_of P }`)));
7652     ASM_REWRITE_TAC[];
7653     MATCH_MP_TAC polyhedron_edge_sum;
7654     ASM_SIMP_TAC[arith `13 <= n ==> 2 <= n`];
7655     REWRITE_TAC[HAS_SIZE];
7656     BY((ASM_MESON_TAC[ Misc_defs_and_lemmas.BIJ_CARD; Misc_defs_and_lemmas.FINITE_BIJ]));
7657   COMMENT "last conjunct: 4 pi";
7658   ASM_SIMP_TAC[GSYM POLYHEDRON_FACET_SUM_4Pi];
7659   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `sum {c | c facet_of P} (\c. sol (vec 0) (fchanged c)) = sum V ((\c. sol (vec 0) (fchanged c)) o f)`) SUBST1_TAC));
7660     GMATCH_SIMP_TAC BIJ_SUM;
7661     BY((ASM_MESON_TAC[]));
7662   MATCH_MP_TAC SUM_LE;
7663   ASM_REWRITE_TAC[];
7664   X_GENv_TAC "v";
7665   DISCH_TAC;
7666   REWRITE_TAC[o_DEF];
7667   MATCH_MP_TAC (arith `a <= x /\ b <= x==>    (max a b <= x)`);
7668   SUBCONJ_TAC;
7669     MATCH_MP_TAC FACET_SOL_NN;
7670     BY((ASM_MESON_TAC[]));
7671   DISCH_TAC;
7672   REWRITE_TAC[ Sphere.regular_spherical_polygon_area ];
7673   MATCH_MP_TAC GOTCJAH;
7674   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `f v`)));
7675   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `v`)));
7676   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `b v`)));
7677   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `P`)));
7678   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{u | u facet_of f v} HAS_SIZE k v`) (fun t -> REWRITE_TAC[t])));
7679     EXPAND_TAC "k";
7680     REWRITE_TAC[HAS_SIZE];
7681     MATCH_MP_TAC FACET_FINITE;
7682     BY((ASM_MESON_TAC[]));
7683   ASM_SIMP_TAC[];
7684   AP_TERM_TAC;
7685   REWRITE_TAC[FUN_EQ_THM;IN_ELIM_THM];
7686   GEN_TAC;
7687   REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
7688   BY((MESON_TAC[DOT_SYM]))
7689   ]);;
7690   (* }}} *)
7691
7692 end;;