(* ========================================================================== *)
(* FLYSPECK - BOOK FORMALIZATION                                              *)
(* Section: Counting Spheres                                                  *)
(* Chapter: packing                                                           *)
(* Author: Thomas C. Hales                                                    *)
(* Date: 2011-06-18                                                           *)
(* ========================================================================== *)

module Counting_spheres = struct

  open Tactics_jordan;;
open Ysskqoy;;
open Hales_tactic;;

let CALC_ID_TAC = Calc_derivative.CALC_ID_TAC;;
let DIHV_SYM = Trigonometry2.DIHV_SYM;;

(* -------------- *)


(* fat_lemma1 = Fatugpd.lemma1  *)
let fat_lemma1 = 
prove_by_refinement(
 `! (S:real^3->bool). packing S /\ S SUBSET ball_annulus ==> FINITE S`,

[
  (REPEAT STRIP_TAC);
  (SUBGOAL_THEN ` (S:real^3->bool) = S INTER ball (vec 0,&3 * h0)` ASSUME_TAC);
    (MATCH_MP_TAC (SET_RULE `! U V. U SUBSET ball_annulus /\ ball_annulus SUBSET V ==> (U = U INTER V)`));
    (ASM_SIMP_TAC[Pack_defs.ball_annulus;ball;cball;IN_DIFF;SUBSET;IN_ELIM_THM;Sphere.h0]);
    (REPEAT STRIP_TAC );
    (MATCH_MP_TAC (ARITH_RULE ` u <= &2 * #1.26 ==> u < &3 * #1.26`));
    BY((ASM_SIMP_TAC[]));
  (ONCE_ASM_REWRITE_TAC[]);
  BY((ASM_SIMP_TAC[Pack2.KIUMVTC]))
]);;
(* ckq_in_ball_annulus = Ckqowsa_3_points.in_ball_annulus *)

let ckq_in_ball_annulus = 
prove(`!v. v IN ball_annulus <=> &2 <= norm v /\ norm v <= &2 * h0 /\ ~(v = vec 0)`,

   REWRITE_TAC[Pack_defs.ball_annulus] THEN
     REWRITE_TAC[IN_DIFF; cball; ball; IN_ELIM_THM; DIST_0] THEN
     REWRITE_TAC[GSYM NORM_EQ_0] THEN
     REAL_ARITH_TAC);;

let lemma = 
prove_by_refinement(
  `!a2 b c. (&0 < a2)  /\ (&0 < c) /\ (!t. &0 <= t /\ t < c ==> a2*t <= b) ==> (!t. &0 <= t /\ t <= c ==> a2*t <= b)`,

  (* {{{ proof *)
[
  REPEAT STRIP_TAC;
  DISJ_CASES_TAC (REAL_ARITH `t < c \/  ~(t <= c) \/ t=c `);
    BY(ASM_MESON_TAC []);
  HASH_UNDISCH_TAC 9516;
  ASM_REWRITE_TAC [];
  DISCH_THEN SUBST1_TAC;
  HASH_UNDISCH_TAC 6171;
  DISCH_THEN (fun loc_t -> ASSUME_TAC loc_t THEN ASSUME_TAC loc_t);
  HASH_RULE_TAC 6171 (SPEC `(b/(&2 * a2) + c/(&2))`);
  HASH_RULE_TAC 6171 (SPEC `&0`);
  ANTS_TAC;
    BY(ASM_REAL_ARITH_TAC);
  REWRITE_TAC [REAL_ARITH`x* &0= &0`];
  DISCH_TAC;
  SUBGOAL_THEN `(&0 <= b / (&2 * a2) + c / &2)=T` SUBST1_TAC;
    ASM_REWRITE_TAC [];
    MATCH_MP_TAC (REAL_ARITH `&0 <= x /\( &0 < y) ==> &0 <= x + y/ &2`);
    ASM_REWRITE_TAC [];
    MATCH_MP_TAC REAL_LE_DIV;
    BY(ASM_REAL_ARITH_TAC);
  REWRITE_TAC [];
  ONCE_REWRITE_TAC [REAL_ARITH `((x < y) = (x - y < &0)) /\((x <= y) = (x - y <= &0))`];
  MP_TAC (Calc_derivative.rational_identity `(b / (&2 * a2) + c / &2) - c = -- (a2*c - b)/(&2 * a2)`);
  MP_TAC (Calc_derivative.rational_identity `(a2 * (b/ (&2 * a2) + c / &2) - b) = (a2 * c - b) /(&2)`);
  ASM_SIMP_TAC [REAL_ARITH `~(&2 = &0) /\( &0 < a2 ==> ~(a2 = &0))`];
  DISCH_THEN SUBST1_TAC;
  DISCH_THEN SUBST1_TAC;
  ABBREV_TAC `u = a2 * c - b `;
  HASH_UNDISCH_TAC 3659;
  REWRITE_TAC[REAL_ARITH `--x / a < &0 <=> &0 < x / a`];
  SIMP_TAC [REAL_ARITH`&0 < x ==> &0 < &2 * x`;Trigonometry2.REAL_LT_DIV_0];
  BY(REAL_ARITH_TAC )
]
);;
  (* }}} *)

let eus1 = 
prove_by_refinement(
  `!(P:real^2 -> bool) c. polyhedron P /\ c facet_of P  ==>  
     (?a b.  (norm a = &1) /\
        (!r. (&0 < r) /\ (!p. norm p < r ==> P p) ==> (r <= b)) /\
                    P SUBSET {x | a dot x <= b} /\
                    c = P INTER {x | a dot x = b})`,

  (* {{{ proof *)
[
REPEAT STRIP_TAC ;
MP_TAC (SPECL[`P:real^2->bool`;`c:real^2->bool`] (INST_TYPE [(`:2`,`:N`)] FACET_OF_POLYHEDRON));
ASM_REWRITE_TAC [];
REPEAT STRIP_TAC ;
EXISTS_TAC  `&1/ norm a % (a:real^2)`;
EXISTS_TAC  `&1/ norm (a:real^2) * (b:real)`;
ASM_REWRITE_TAC [GSYM Trigonometry2.NOT_VEC0_UNITABLE];
SUBGOAL_THEN  `&0 < norm (a:real^2)` ASSUME_TAC;
ASM_REWRITE_TAC [NORM_POS_LT];
SUBGOAL_THEN `&0 < &1/ norm (a:real^2)` ASSUME_TAC;
MATCH_MP_TAC  REAL_LT_DIV THEN CONJ_TAC THEN TRY REAL_ARITH_TAC THEN ASM_REWRITE_TAC[];
HASH_UNDISCH_TAC 7978 ;
REWRITE_TAC  [DOT_LMUL];
ASM_SIMP_TAC [REAL_LE_LMUL_EQ];
REWRITE_TAC [REAL_EQ_MUL_LCANCEL];
SIMP_TAC [REAL_ARITH `&0 < d==> ~(d= &0)`];
DISCH_TAC ;
REPEAT STRIP_TAC;
SUBGOAL_THEN `!p. norm (p:real^2) < r ==> (a:real^2) dot p <= b` ASSUME_TAC;
REPEAT STRIP_TAC ;
HASH_UNDISCH_TAC 5889 ;
REWRITE_TAC [SUBSET;IN;IN_ELIM_THM];
DISCH_THEN MATCH_MP_TAC;
FIRST_X_ASSUM MATCH_MP_TAC;
ASM_REWRITE_TAC [];
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));
CONJ_TAC ;
HASH_UNDISCH_TAC 7435 ;
REWRITE_TAC [GSYM Trigonometry2.NOT_ZERO_EQ_POW2_LT];
REAL_ARITH_TAC ;
CONJ_TAC ;
MATCH_MP_TAC REAL_LT_DIV;
ASM_REWRITE_TAC [];
REPEAT STRIP_TAC ;
HASH_RULE_TAC 4896 (SPEC `t % (a:real^2)`);
ASM_SIMP_TAC [NORM_MUL;REAL_ARITH `&0 <= t ==> (abs t = t)`];
REWRITE_TAC [DOT_RMUL];
REWRITE_TAC [DOT_SQUARE_NORM];
ANTS_TAC;
HASH_RULE_TAC 7310 (Calc_derivative.rational_ineq_rule);
HASH_UNDISCH_TAC 7435 ;
SIMP_TAC [REAL_LT_MUL_EQ];
MP_TAC (REAL_ARITH `&0 < x ==> ~(x = &0)`);
REAL_ARITH_TAC ;
REAL_ARITH_TAC ;
DISCH_THEN (fun t-> MP_TAC (SPEC `r/ norm (a:real^2)` t));
ANTS_TAC;
REWRITE_TAC [REAL_ARITH `x <= x`];
REWRITE_TAC [Calc_derivative.invert_den_le];
MATCH_MP_TAC REAL_LE_MUL;
ASM_REAL_ARITH_TAC;
DISCH_THEN (MP_TAC o Calc_derivative.rational_ineq_rule);
DISCH_TAC ;
MATCH_MP_TAC (REAL_ARITH `((x < y) ==> F) ==> (y <= x)`);
DISCH_THEN (MP_TAC o Calc_derivative.rational_ineq_rule);
HASH_UNDISCH_TAC 5880 ;
SUBGOAL_THEN `~(norm (a:real^2) = &0)` ASSUME_TAC;
ASM_REAL_ARITH_TAC;
ASM_REWRITE_TAC [];
REWRITE_TAC [REAL_ARITH `~(&0 < (x - y) * b) <=> (&0 <= (y - x)*b)`];
REWRITE_TAC [REAL_RING `(b * norm (a:real^2) - norm a pow 2 * r) = (b - r * norm a) * norm a`];
HASH_UNDISCH_TAC 7435 ;
REWRITE_TAC [REAL_MUL_POS_LE;REAL_MUL_POS_LT;REAL_ENTIRE;REAL_ARITH `a * b < &0 <=> ~(&0 <= a * b)`];
REAL_ARITH_TAC
]);;
  (* }}} *)


let facet_rep_uniq = 
prove_by_refinement(
  `!(P:real^2 -> bool) a b1 b2. polyhedron P /\ 
    c1 facet_of P  /\ c2 facet_of P /\
    P SUBSET {x | a dot x <= b1} /\
    P SUBSET {x | a dot x <= b2} /\
    c1 = P INTER {x | a dot x = b1} /\
    c2 = P INTER {x | a dot x = b2} ==>
    (b1 = b2) /\ (c1 = c2)`,

  (* {{{ proof *)
[
REPEAT GEN_TAC ;
REWRITE_TAC [facet_of;face_of;SUBSET;GSYM MEMBER_NOT_EMPTY;IN;IN_ELIM_THM;INTER];
STRIP_TAC ;
SUBGOAL_THEN `a dot x = b1 /\ (a:real^2) dot x' = b2` ASSUME_TAC;
HASH_UNDISCH_TAC 4776 ;
HASH_UNDISCH_TAC 6239 ;
ASM_REWRITE_TAC [IN_ELIM_THM];
MESON_TAC [];
ASM_MESON_TAC [REAL_ARITH `b1 <= b2 /\ b2 <= b1 ==> (b1 = b2)`]
]
);;
  (* }}} *)

let facet_rep_spec = 
prove_by_refinement(
  `?a b. !(P:real^2 -> bool) c. polyhedron P /\ c facet_of P
   ==>
     (  (norm (a P c) = &1) /\ 
     (!r. (&0 < r) /\ (!p. norm p < r ==> P p) ==> (r <= (b P c))) /\
     P SUBSET {x | (a P c) dot x <= (b P c)} /\
     c = P INTER {x | (a P c) dot x = (b P c)})`,

  (* {{{ proof *)
  [
REWRITE_TAC [GSYM SKOLEM_THM;RIGHT_EXISTS_IMP_THM];
MESON_TAC [eus1]
  ]);;
  (* }}} *)

let facet_rep_def = new_specification ["facet_rep_a";
"facet_rep_b"] facet_rep_spec;;

let facet_rep_uniq_c = 
prove_by_refinement(
  `!(P:real^2 -> bool) c1 c2. polyhedron P /\ c1 facet_of P /\ c2 facet_of P /\
    (facet_rep_a P c1 = facet_rep_a P c2) ==> (c1 = c2)`,

  (* {{{ proof *)
  [
REPEAT STRIP_TAC ;
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);
ASM_REWRITE_TAC [];
MP_TAC (SPECL[`P:real^2->bool`;`c1:real^2->bool`] facet_rep_def);
MP_TAC (SPECL[`P:real^2->bool`;`c2:real^2->bool`] facet_rep_def);
ASM_REWRITE_TAC [];
REPEAT STRIP_TAC ;
ASM_MESON_TAC []
  ]);;
  (* }}} *)

let norm1_cauchy_eq = 
prove_by_refinement(
  `!(x:real^N) y. norm x = &1 /\ norm y = &1 /\ x dot y = &1 ==> (x = y)`,

  (* {{{ proof *)
  [
REPEAT STRIP_TAC ;
MP_TAC (SPECL [`x:real^N`;`y:real^N`] NORM_CAUCHY_SCHWARZ_EQ);
ASM_REWRITE_TAC [REAL_ARITH `&1 * &1 = &1`;VECTOR_MUL_LID];
MESON_TAC []
  ]);;
  (* }}} *)

let facet_rep_in_facet = 
prove_by_refinement(
  `!(P:real^2->bool) c1 c2 r. polyhedron P /\ c1 facet_of P /\ c2 facet_of P /\ 
  (&0 < r) /\ (!p. norm p < r ==> P p) /\ 
  (facet_rep_b P c1 <= facet_rep_a P c1 dot (r % facet_rep_a P c2)) ==>
   (c1 = c2)`,

  (* {{{ proof *)
  [
REWRITE_TAC [DOT_RMUL];
REPEAT STRIP_TAC ;
MATCH_MP_TAC facet_rep_uniq_c;
EXISTS_TAC `P:real^2->bool`;
ASM_REWRITE_TAC [];
MATCH_MP_TAC (norm1_cauchy_eq);
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);
ASM_MESON_TAC [facet_rep_def;REAL_ARITH `&1 * &1 = &1`;NORM_CAUCHY_SCHWARZ];
REPEAT STRIP_TAC  THEN ASM_REWRITE_TAC[];
SUBGOAL_THEN `r <= facet_rep_b P c1` MP_TAC;
ASM_MESON_TAC [facet_rep_def];
DISCH_TAC ;
HASH_UNDISCH_TAC 4642 ;
REWRITE_TAC [REAL_ARITH `x <= &1 <=> (x = &1) \/ (x < &1)`];
DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[];
ABBREV_TAC `d = facet_rep_a P c1 dot facet_rep_a P c2 `;
SUBGOAL_THEN `&0 < (r * (&1 - d))` ASSUME_TAC;
MATCH_MP_TAC REAL_LT_MUL;
ASM_REAL_ARITH_TAC ;
ASM_REAL_ARITH_TAC 
  ]);;
  (* }}} *)

let facet_rep_refl = 
prove_by_refinement(
  `!(P:real^2->bool) c r. polyhedron P /\ c facet_of P /\ 
  (&0 < r) /\ (!p. norm p < r ==> P p)  ==>
   (facet_rep_a P c dot (r % facet_rep_a P c) <= facet_rep_b P c)`,

  (* {{{ proof *)
  [
REWRITE_TAC [DOT_RMUL;Collect_geom.X_DOT_X_EQ];
REPEAT STRIP_TAC ;
MP_TAC (SPECL[`P:real^2->bool`;`c:real^2->bool`] facet_rep_def);
ASM_REWRITE_TAC [];
REPEAT STRIP_TAC ;
ASM_REWRITE_TAC [Trigonometry2.POW2_1;REAL_ARITH ` r * &1 = r`];
ASM_MESON_TAC []
  ]);;
  (* }}} *)


let DOT_EQ_IMP_INEQ_LEMMA = 
prove_by_refinement(
  `!(a:real^N) b a' b'.
    (!x. a dot x = b <=> a' dot x = b') /\ (&0 <  b) /\ (&0 < b') ==>
   (!x. ~(a dot x = &0) ==> (a dot x <= b <=> a' dot x <= b'))`,

  (* {{{ proof *)
  [
REPEAT STRIP_TAC ;
HASH_RULE_TAC 2720 (SPEC `((b/(a dot x)) % (x:real^N))`);
REWRITE_TAC [DOT_RMUL];
SUBGOAL_THEN `b / (a dot x) * (a dot (x:real^N)) = b` SUBST1_TAC;
HASH_UNDISCH_TAC 5506 ;
BY(CONV_TAC REAL_FIELD);
REWRITE_TAC [REAL_FIELD `b/ (a dot x) * (a' dot x) = b * ((a' dot x) / (a dot (x:real^N)))`];
  DISCH_THEN (fun t-> ASSUME_TAC(GSYM t));
ASM_REWRITE_TAC [];
SUBGOAL_THEN `&0 < (a' dot (x:real^N)) / (a dot x) ` ASSUME_TAC;
HASH_UNDISCH_TAC 9752 ;
ASM_REWRITE_TAC [REAL_MUL_POS_LT];
ASM_REAL_ARITH_TAC;
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;
ASM_SIMP_TAC [REAL_LE_RMUL_EQ];
SUBGOAL_THEN  `(a dot (x:real^N)) * (a' dot x)/ (a dot x) = a' dot x` SUBST1_TAC;
HASH_UNDISCH_TAC 5506 ;
BY (CONV_TAC REAL_FIELD);
BY(REWRITE_TAC[])
  ]);;
  (* }}} *)

let DOT_EQ_IMP_INEQ = 
prove_by_refinement(
  `!(a:real^N) b a' b'.
    (!x. a dot x = b <=> a' dot x = b') /\ (&0 <= b) /\ (&0 < b') ==>
   (!x. (a dot x <= b) <=> a' dot x <= b')`,

  (* {{{ proof *)
  [
REPEAT STRIP_TAC ;
SUBGOAL_THEN `&0 < b` ASSUME_TAC;
HASH_RULE_TAC 2720 (fun t -> (REWRITE_RULE[DOT_RZERO] (SPEC `(vec 0):real^N` t)));
ASM_REAL_ARITH_TAC ;
ASM_CASES_TAC `~(a dot (x:real^N) = &0)`;
ASM_MESON_TAC [DOT_EQ_IMP_INEQ_LEMMA];
ASM_CASES_TAC `~(a' dot (x:real^N) = &0)`;
ASM_MESON_TAC [DOT_EQ_IMP_INEQ_LEMMA];
ASM_REAL_ARITH_TAC 
  ]);;
  (* }}} *)

let affine_facet_hyper = 
prove_by_refinement(
  `!(P:real^N->bool) c a b. c facet_of P /\ polyhedron P /\ (affine hull P = (:real^N)) /\
    ~(a = vec 0) /\
     P INTER { x | a dot x = b } = c ==>
   (affine hull c =  { x | a dot x = b})`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  TYPIFY `{x | a dot x = b} = affine hull {x | a dot x = b}` (C SUBGOAL_THEN SUBST1_TAC);
  BY(MESON_TAC [ AFFINE_HULL_EQ; AFFINE_HYPERPLANE ]);
  MATCH_MP_TAC AFF_DIM_EQ_AFFINE_HULL;
  ASM_SIMP_TAC [ AFF_DIM_HYPERPLANE ];
  CONJ_TAC;
  EXPAND_TAC "c";
  BY(SET_TAC []);
  HASH_UNDISCH_TAC 6578;
  REWRITE_TAC [ facet_of ];
  HASH_UNDISCH_TAC 6209;
  REWRITE_TAC [ GSYM AFF_DIM_EQ_FULL ];
  DISCH_THEN SUBST1_TAC;
  REPEAT WEAK_STRIP_TAC;
  ASM_REWRITE_TAC [];
  ARITH_TAC
  ]);;
  (* }}} *)

let POLYHEDRON_MEMBER = 
prove_by_refinement(
  `!(P:real^2->bool) r (x:real^2).  polyhedron P /\ (&0 < r) /\ (!p. norm p < r ==> P p)
   /\ (!c. (c facet_of P) ==> (facet_rep_a P c dot x <= facet_rep_b P c )) ==> P x`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  HASH_COPY_TAC 8205;
  HASH_UNDISCH_TAC 8205;
  REWRITE_TAC [POLYHEDRON_INTER_AFFINE_MINIMAL];
  REPEAT WEAK_STRIP_TAC;
  SUBGOAL_THEN `affine hull P = (:real^2)` ASSUME_TAC;
  MATCH_MP_TAC Packing3.CONTAINS_BALL_AFFINE_HULL;
  EXISTS_TAC `(vec 0):real^2`;
  EXISTSv_TAC "r";
  BY (ASM_REWRITE_TAC [ball;SUBSET;IN_ELIM_THM;DIST_0;IN]);
  TYPIFY `P = INTERS f` (C SUBGOAL_THEN ASSUME_TAC);
  BY (ASM_MESON_TAC [INTER_UNIV]);
  (fun gl -> (MP_TAC (SPECL ( envl gl [`P`;`f`]) (INST_TYPE [`:2`,`:N`] FACET_OF_POLYHEDRON_EXPLICIT ))) gl);
  HASH_COPY_TAC 2338;
  HASH_UNDISCH_TAC 2338;
  DISCH_THEN (fun loc_t -> ONCE_REWRITE_TAC [ GSYM loc_t ]);
  ASM_REWRITE_TAC [];
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC [INTERS;IN_ELIM_THM;IN];
  X_GENv_TAC "h";
  HASH_UNDISCH_TAC 8531;
  REWRITE_TAC [ GSYM RIGHT_EXISTS_IMP_THM ; SKOLEM_THM ];
  REPEAT WEAK_STRIP_TAC;
  (fun gl -> (HASH_RULE_TAC 7519 ( SPECL ( envl gl [`a`;`b`]) )) gl);
  ASM_REWRITE_TAC [];
  DISCH_TAC;
  INTRO_TAC facet_rep_def [`P`];
  (fun gl -> ( let asm_3 = snd(List.nth (List.rev (goal_asms gl)) 3 ) in REWRITE_TAC [ asm_3 ]) gl);
  DISCH_TAC;
  TYPIFY `h` (HASH_RULE_TAC 1064 o SPEC);
(*  (fun gl -> (HASH_RULE_TAC 1064 (SPEC ( env gl `h`))) gl); *)
  ASM_REWRITE_TAC [IN];
  REPEAT WEAK_STRIP_TAC;
  (fun gl -> ( let asm_13 = snd(List.nth (List.rev (goal_asms gl)) 13 ) in ONCE_REWRITE_TAC [ asm_13 ]) gl);
  REWRITE_TAC [IN_ELIM_THM];
  ABBREV_TAC `(c:real^2->bool) = P INTER { x | a (h:real^2->bool) dot x = b h }`;
  TYPIFY `c facet_of P` (C SUBGOAL_THEN ASSUME_TAC);
  BY(ASM_MESON_TAC [IN]);
  TYPIFY `c` (HASH_RULE_TAC 4778 o SPEC);
(*  (fun gl -> (HASH_RULE_TAC 4778 (SPEC ( env gl `c`))) gl); *)
  DISCH_TAC;
  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);
  BY(ASM_MESON_TAC [ REAL_ARITH `&0 < r /\ r <= k ==> &0 < k`]);
  REPEAT WEAK_STRIP_TAC;
  TYPIFY `affine hull c = { x | a h dot x = b h}` (C SUBGOAL_THEN ASSUME_TAC);
  MATCH_MP_TAC affine_facet_hyper;
  EXISTSv_TAC "P";
  BY(ASM_MESON_TAC []);
  TYPIFY `affine hull c = { x | facet_rep_a P c dot x = facet_rep_b P c }` (C SUBGOAL_THEN ASSUME_TAC);
  MATCH_MP_TAC affine_facet_hyper;
  EXISTSv_TAC "P";
  BY(ASM_MESON_TAC [ NORM_0; REAL_ARITH `~(&1 = &0)`]);
  TYPIFY `a h dot x = b h <=> (facet_rep_a P c dot x = facet_rep_b P c)` (C SUBGOAL_THEN ASSUME_TAC);
  HASH_UNDISCH_TAC 6018;
  HASH_KILL_TAC 2868;
  ASM_REWRITE_TAC [];
  ONCE_REWRITE_TAC [ FUN_EQ_THM ];
  REWRITE_TAC [ IN_ELIM_THM ];
  BY(SIMP_TAC [] );
  TYPIFY `P (vec 0)` (C SUBGOAL_THEN ASSUME_TAC);
  FIRST_X_ASSUM MATCH_MP_TAC;
  BY(ASM_REWRITE_TAC [ NORM_0 ]);
  TYPIFY `&0 <= b h` (C SUBGOAL_THEN ASSUME_TAC);
  HASH_UNDISCH_TAC 7409;
  HASH_UNDISCH_TAC 2868;
  DISCH_THEN SUBST1_TAC;
  REWRITE_TAC [ INTERS;IN_ELIM_THM;IN ];
  (fun gl -> (DISCH_THEN (MP_TAC o (SPEC ( env gl `h`)))) gl);
  (fun gl -> ( let asm_8 = snd(List.nth (List.rev (goal_asms gl)) 8 ) in REWRITE_TAC [ asm_8 ]) gl);
  (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);
  BY(REWRITE_TAC [ IN_ELIM_THM; DOT_RZERO ]);
  (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);
  (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);
  ANTS_TAC;
  HASH_UNDISCH_TAC 6018;
  (fun gl -> ( let asm_19 = snd(List.nth (List.rev (goal_asms gl)) 19 ) in ONCE_REWRITE_TAC [ asm_19 ]) gl);
  ONCE_REWRITE_TAC [ FUN_EQ_THM ];
  REWRITE_TAC [ IN_ELIM_THM ];
  BY(MESON_TAC []);
  DISCH_THEN (fun loc_t -> REWRITE_TAC [ loc_t ]);
  ASM_MESON_TAC []
  ]);;
  (* }}} *)

let facet_rep_in_poly = 
prove_by_refinement(
  `!(P:real^2->bool) c r. polyhedron P /\ (c facet_of P) /\ 
  (&0 < r) /\ (!p. norm p < r ==> P p) ==>
  P (r % facet_rep_a P c)
`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC POLYHEDRON_MEMBER;
  EXISTSv_TAC "r";
  ASM_REWRITE_TAC [];
  REPEAT WEAK_STRIP_TAC;
  (fun gl -> (ASM_CASES_TAC ( env gl `c' = c`)) gl);
  BY(ASM_MESON_TAC [ facet_rep_refl ]);
  BY(ASM_MESON_TAC [ facet_rep_in_facet; REAL_ARITH `~(x <= y) ==> (y <= x)`])
  ]);;
  (* }}} *)

let facet_rep_not_in_facet = 
prove_by_refinement(
  `!(P:real^2->bool) c c' r. polyhedron P /\ (c facet_of P) /\ (c' facet_of P) /\
  (&0 < r) /\ (!p. norm p < r ==> P p) /\ (c' (r % facet_rep_a P c)) ==>
  (c' = c)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC facet_rep_in_facet;
  EXISTSv_TAC "P";
  EXISTSv_TAC "r";
  ASM_REWRITE_TAC [];
  (fun gl -> (MP_TAC (SPECL ( envl gl [`P`;`c'`]) facet_rep_def)) gl);
  ASM_REWRITE_TAC [];
  REPEAT WEAK_STRIP_TAC;
  (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);
  REWRITE_TAC [ IN_ELIM_THM;INTER ];
  REAL_ARITH_TAC
  ]);;
  (* }}} *)

let facet_arg_lt_pi = 
prove_by_refinement(
  `!(P:real^2->bool) c r. polyhedron P /\ bounded P /\ c facet_of P /\
  (&0 < r) /\ (!p. norm p < r ==> P p) ==>
  (?c'. c' facet_of P /\ (&0 < Arg ( facet_rep_a P c' / facet_rep_a P c ) /\
     Arg (facet_rep_a P c' / facet_rep_a P c) < pi)) `,

  (* {{{ proof *)
  [
  REWRITE_TAC [bounded;IN;ARG_LT_PI];
  REPEAT WEAK_STRIP_TAC;
  PROOF_BY_CONTR_TAC;
  ABBREV_TAC `(p:real^2) = Cx (a + &1) * ii * facet_rep_a P c`;
  HASH_RULE_TAC 2054 (REWRITE_RULE [ NOT_EXISTS_THM ]);
  DISCH_TAC;
  TYPIFY `P (vec 0)` (C SUBGOAL_THEN ASSUME_TAC);
  FIRST_X_ASSUM MATCH_MP_TAC;
  BY(ASM_REWRITE_TAC [ NORM_0 ]);
  SUBGOAL_THEN (`&0 <= a`) ASSUME_TAC;
  BY(ASM_MESON_TAC [ NORM_0 ]);
  TYPIFY `P p` (C SUBGOAL_THEN ASSUME_TAC);
  MATCH_MP_TAC POLYHEDRON_MEMBER;
  EXISTSv_TAC "r";
  ASM_REWRITE_TAC [];
  REPEAT WEAK_STRIP_TAC;
  TYPIFY `c'` (HASH_RULE_TAC 7404 o SPEC);
  ASM_REWRITE_TAC [];
  DISCH_TAC;
  MATCH_MP_TAC REAL_LE_TRANS;
  EXISTS_TAC `&0`;
  MATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`);
  CONJ_TAC;
  BY(ASM_MESON_TAC [ facet_rep_def; REAL_ARITH `&0 < r /\ r <= x ==> &0 <= x` ]);
  REWRITE_TAC [ DOT_RE ];
  EXPAND_TAC "p";
  REWRITE_TAC [ CNJ_MUL;CNJ_CX;CNJ_II ];
  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;
  SIMPLE_COMPLEX_ARITH_TAC;
  REWRITE_TAC [ RE_NEG;IM_MUL_CX;RE_MUL_II;REAL_ARITH ` -- -- x = x`;REAL_ARITH `a * u <= &0 <=> &0 <= a * (-- u)` ];
  MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2;
  ASM_SIMP_TAC [ REAL_ARITH `&0 <= a ==> &0 <= a + &1`];
  REWRITE_TAC [ REAL_ARITH `(&0 <= -- x <=> ~(&0 < x))` ];
  BY(ASM_MESON_TAC [ IM_COMPLEX_DIV_GT_0 ]);
  TYPIFY `p` (HASH_RULE_TAC 8984 o SPEC);
  ASM_REWRITE_TAC [];
  EXPAND_TAC "p";
  REWRITE_TAC [ COMPLEX_NORM_MUL ];
  REWRITE_TAC [ COMPLEX_NORM_MUL;COMPLEX_NORM_II; COMPLEX_NORM_CX; ];
  (fun gl -> (MP_TAC (SPECL ( envl gl [`P`;`c`]) facet_rep_def)) gl);
  ASM_REWRITE_TAC [];
  REPEAT WEAK_STRIP_TAC;
  HASH_UNDISCH_TAC 8903;
  ASM_REWRITE_TAC [];
  (CONV_TAC REAL_FIELD)
  ]);;
  (* }}} *)

let eus_cos  = 
prove_by_refinement(
  `!phi psi. &0 <= psi /\ psi <= phi /\ phi <= &2 * pi - psi ==> 
    cos phi <= cos psi`,

  (* {{{ proof *)
[
REPEAT STRIP_TAC ;
DISJ_CASES_TAC (REAL_ARITH `phi <= pi \/ (pi <= phi)`);
MATCH_MP_TAC COS_MONO_LE;
ASM_REWRITE_TAC [];
ABBREV_TAC `phi' = &2 * pi - phi`;
HASH_UNDISCH_TAC 6556 ;
    DISCH_THEN (fun t -> (REPEAT (POP_ASSUM MP_TAC) THEN REWRITE_TAC[REWRITE_RULE[REAL_ARITH `x - y = u <=> (y = x - u)`] t]));
REWRITE_TAC [REAL_ARITH `pi <= &2 * pi - phi' <=> phi' <= pi`;GSYM Trigonometry2.COS_SUM_2PI];
REPEAT STRIP_TAC ;
MATCH_MP_TAC COS_MONO_LE;
ASM_REAL_ARITH_TAC
]);;
  (* }}} *)

let insert_v = 
prove_by_refinement(
  `!P c c' r v psi. polyhedron P /\ c facet_of P /\ c' facet_of P /\
   (&0 < r) /\ (!p. norm p < r ==> P p) /\ 
   Arg(v / facet_rep_a P c) = psi /\
    &0 < psi /\
   psi < pi / &2 /\
   Arg (facet_rep_a P c' / facet_rep_a P c) =    &2 * psi  /\
   (!c''. (c'' facet_of P /\ Arg (facet_rep_a P c'' / facet_rep_a P c) < &2 * psi) ==> (c'' = c)) /\ 
   norm v = r / cos psi ==>
   (P v)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC POLYHEDRON_MEMBER;
  EXISTSv_TAC "r";
  ASM_REWRITE_TAC [];
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC [ DOT_RE ];
  ONCE_REWRITE_TAC [ ARG ];
  ASM_REWRITE_TAC [ RE_MUL_CX ; COMPLEX_NORM_MUL;COMPLEX_NORM_CNJ;RE_CEXP;RE_MUL_II;IM_MUL_II;IM_CX;RE_CX ];
  REWRITE_TAC [ REAL_ARITH `-- &0 = &0`;REAL_EXP_0 ];
  TYPIFY `~(v = Cx (&0))` (C SUBGOAL_THEN ASSUME_TAC);
  REWRITE_TAC [ GSYM COMPLEX_VEC_0 ];
  DISCH_TAC;
  HASH_UNDISCH_TAC 5247;
  ASM_REWRITE_TAC [NORM_0];
  MATCH_MP_TAC (REAL_ARITH `&0 < x ==> ~(&0 = x)`);
  REWRITE_TAC [ Calc_derivative.invert_den_lt ];
  MATCH_MP_TAC REAL_LT_MUL;
  ASM_REWRITE_TAC [];
  BY(ASM_SIMP_TAC [ COS_POS_PI2 ]);
  ASM_SIMP_TAC [ GSYM ARG_CNJ ];
  MATCH_MP_TAC REAL_LE_TRANS;
  EXISTSv_TAC "r";
  MATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`);
  CONJ_TAC;
  BY(ASM_MESON_TAC [ facet_rep_def ]);
  SUBGOAL_THEN `norm (facet_rep_a P c'') = &1` SUBST1_TAC;
  BY (ASM_MESON_TAC [ facet_rep_def ]);
  TYPED_ABBREV_TAC `(phi:real) = Arg (facet_rep_a P c'' / v)`;
  REWRITE_TAC [ real_div; REAL_ARITH `(&1 * r * v) * &1 * u = r * u * v` ];
  REWRITE_TAC [ REAL_ARITH `r * x <= r <=> &0 <= r * (&1 - x)` ];
  MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2;
  CONJ_TAC;
  ASM_REAL_ARITH_TAC;
  REWRITE_TAC [ REAL_ARITH `&0 <= &1 - x * inv y <=> x / y <= &1`];
  MATCH_MP_TAC Trigonometry2.REAL_LE_LDIV;
  SUBGOAL_THEN `&0 < cos psi` ASSUME_TAC;
  ASM_SIMP_TAC [ COS_POS_PI2 ];
  ASM_REWRITE_TAC [];
  MATCH_MP_TAC eus_cos;
  CONJ_TAC;
  ASM_REAL_ARITH_TAC;
  (fun gl -> (ASM_CASES_TAC ( env gl `c'' = c`)) gl);
  EXPAND_TAC "phi";
  HASH_KILL_TAC 2447;
  ASM_REWRITE_TAC [];
  MP_TAC ARG_INV;
  REWRITE_TAC [ GSYM ARG_EQ_0 ];
  ONCE_REWRITE_TAC [ GSYM COMPLEX_INV_DIV ];
  DISCH_TAC;
  TYPIFY `Arg (inv (v/ facet_rep_a P c)) = &2 * pi - Arg (v / facet_rep_a P c)` (C SUBGOAL_THEN SUBST1_TAC);
  FIRST_X_ASSUM MATCH_MP_TAC;
  MATCH_MP_TAC( REAL_ARITH `&0 < psi ==> ~(psi = &0)` );
  BY(ASM_SIMP_TAC[]);
  (fun gl -> ( let asm_5 = snd(List.nth (List.rev (goal_asms gl)) 5 ) in REWRITE_TAC [ asm_5 ]) gl);
  HASH_UNDISCH_TAC 8776;
  HASH_UNDISCH_TAC 4801;
  MP_TAC PI_POS;
  BY(REAL_ARITH_TAC);
  TYPIFY `c''` (HASH_RULE_TAC 6343 o SPEC);
  ASM_REWRITE_TAC [ REAL_ARITH `~(x < y) <=> (y <= x)`];
  SUBGOAL_THEN `!c. c facet_of P ==> ~(facet_rep_a P c = Cx (&0))` ASSUME_TAC;
  REWRITE_TAC [ GSYM COMPLEX_VEC_0 ];
  REPEAT WEAK_STRIP_TAC;
  BY(ASM_MESON_TAC [ NORM_0; facet_rep_def; REAL_ARITH`~(&0 = &1)` ]);
  SUBGOAL_THEN `!x y. x / y = Cx (&0) <=> (x = Cx (&0) \/ y = Cx (&0))` ASSUME_TAC;
  BY(REWRITE_TAC [ COMPLEX_ENTIRE;complex_div;COMPLEX_INV_EQ_0 ]);
  TYPED_ABBREV_TAC `(z:complex) = facet_rep_a P c'' / facet_rep_a P c`;
  TYPED_ABBREV_TAC `w = v / facet_rep_a P c`;
  DISCH_TAC;
  SUBGOAL_THEN ( `Arg z = Arg w + Arg (z/ w)` ) ASSUME_TAC;
  MATCH_MP_TAC ARG_LE_DIV_SUM;
  EXPAND_TAC "w";
  HASH_UNDISCH_TAC 8513;
  EXPAND_TAC "z";
  HASH_KILL_TAC 7462;
  ASM_SIMP_TAC [];
  HASH_UNDISCH_TAC 8776;
  REAL_ARITH_TAC;
  SUBGOAL_THEN `phi = Arg (z / w)` ASSUME_TAC;
  EXPAND_TAC "z";
  EXPAND_TAC "w";
  EXPAND_TAC "phi";
  AP_TERM_TAC;
  REWRITE_TAC [ complex_div ;COMPLEX_INV_MUL;COMPLEX_INV_INV];
  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;
  SIMPLE_COMPLEX_ARITH_TAC;
  BY(ASM_SIMP_TAC [ COMPLEX_MUL_RID;COMPLEX_MUL_LINV ] );
  ASM_REWRITE_TAC [];
  EXPAND_TAC "psi";
  HASH_UNDISCH_TAC 8513;
  HASH_UNDISCH_TAC 6318;
  EXPAND_TAC "psi";
  MP_TAC (SPEC `(z:complex)` ARG);
  REAL_ARITH_TAC
  ]);;
  (* }}} *)

let facet_rep_a_uniq = 
prove_by_refinement(
  `!(P:real^2->bool) c1 c2 r. polyhedron P /\ c1 facet_of P /\ c2 facet_of P /\
    (&0 < r ) /\  (!p. norm p < r ==> P p) /\
    (?s. (&0 < s) /\ facet_rep_a P c1 = s % facet_rep_a P c2) ==> (c1 = c2)
      `,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  SUBGOAL_THEN `norm (facet_rep_a P c1) = s` ASSUME_TAC;
  ASM_REWRITE_TAC [ NORM_MUL ];
  ASM_SIMP_TAC [ REAL_ARITH `&0 < s ==> (abs s = s)` ];
  SUBGOAL_THEN `norm (facet_rep_a P c2) = &1` SUBST1_TAC;
  ASM_MESON_TAC [ facet_rep_def ];
  BY (REAL_ARITH_TAC );
  SUBGOAL_THEN `norm (facet_rep_a P c1) = &1` ASSUME_TAC;
  BY (ASM_MESON_TAC [ facet_rep_def ] );
  HASH_UNDISCH_TAC 1250;
  SUBGOAL_THEN `s = &1` SUBST1_TAC;
  ASM_MESON_TAC [];
  REWRITE_TAC [ VECTOR_MUL_LID ];
  (fun gl -> (MP_TAC (SPECL ( envl gl [`P`;`c1`]) facet_rep_def)) gl);
  (fun gl -> (MP_TAC (SPECL ( envl gl [`P`;`c2`]) facet_rep_def)) gl);
  ASM_REWRITE_TAC [];
  (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);
  ASM_REWRITE_TAC [];
  REPEAT WEAK_STRIP_TAC;
  HASH_RULE_TAC 1397 (MATCH_MP ( TAUT `(a ==> (b /\ c)) ==> (a ==> c)`));
  DISCH_THEN MATCH_MP_TAC;
  ASM_SIMP_TAC [];
  ASM_REWRITE_TAC [];
  MATCH_MP_TAC (TAUT (`a /\ b ==> b /\ a`));
  CONJ_TAC;
  HASH_UNDISCH_TAC 3107;
  BY(DISCH_THEN ACCEPT_TAC);
  HASH_UNDISCH_TAC 119;
  ASM_REWRITE_TAC []
  ]);;
  (* }}} *)

let poly_sort_fn = new_definition `poly_sort_fn P u c1 c2 = 
  ((c1 facet_of P) /\ (c2 facet_of P) /\
 (Arg (facet_rep_a P c1 / u) <= Arg (facet_rep_a P c2 / u)))`;;
let poly_sort_antisym = 
prove_by_refinement(
  `!P u c1 c2 r. (polyhedron P) /\ (&0 < r) /\ (!p. (norm p < r)==> (P p)) 
   /\ poly_sort_fn P u c1 c2 /\  poly_sort_fn P u c2 c1 /\  ~(u = Cx (&0)) 
   ==> (c1 = c2)`,

  (* {{{ proof *)
  [
  REWRITE_TAC [ poly_sort_fn ];
  REPEAT WEAK_STRIP_TAC;
  TYPIFY `Arg (facet_rep_a P c1 / u) = Arg (facet_rep_a P c2 / u)` (C SUBGOAL_THEN ASSUME_TAC);
  ASM_REAL_ARITH_TAC;
  HASH_KILL_TAC 5764;
  HASH_KILL_TAC 6109;
  TYPIFY `!c. c facet_of P ==> ~(facet_rep_a P c = Cx (&0))` (C SUBGOAL_THEN ASSUME_TAC);
  BY(ASM_MESON_TAC [ NORM_0; COMPLEX_VEC_0; facet_rep_def; REAL_ARITH `~(&0 = &1)` ]);
  PROOF_BY_CONTR_TAC;
  HASH_UNDISCH_TAC 8621;
  ASM_SIMP_TAC [ ARG_EQ ; ARG_0_DIV ];
  REWRITE_TAC [ NOT_EXISTS_THM ];
  GEN_TAC;
  MATCH_MP_TAC (TAUT `(a ==> ~b ) ==> ~(a /\ b)`);
  DISCH_TAC;
  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;
  REWRITE_TAC [ complex_div ];
  HASH_UNDISCH_TAC 9092;
  BY(SIMP_TAC [ COMPLEX_MUL_ASSOC;COMPLEX_EQ_MUL_RCANCEL;COMPLEX_INV_EQ_0 ]);
  REWRITE_TAC [ GSYM COMPLEX_CMUL ];
  DISCH_TAC;
  ASM_MESON_TAC [facet_rep_a_uniq]
  ]);;
  (* }}} *)

let poly_sort_trans = 
prove_by_refinement(
  `!P u c1 c2 c3 r. polyhedron P /\ (&0 < r) /\ (!p. norm p < r ==> P p) /\
    ~(u = Cx (&0)) /\
    poly_sort_fn P u c1 c2 /\ poly_sort_fn P u c2 c3 ==>
    poly_sort_fn P u c1 c3`,

  (* {{{ proof *)
  [
  REWRITE_TAC [ poly_sort_fn ];
  REPEAT WEAK_STRIP_TAC;
  ASM_REWRITE_TAC [];
  ASM_REAL_ARITH_TAC
  ]);;
  (* }}} *)

let POLY_SORT_LEMMA = 
prove_by_refinement(
  `!P n s r u.  (s = { c | c facet_of P }) /\ polyhedron P /\ (&0 < r) /\ 
     (!p. norm p < r ==> P p) /\ ~(u = Cx (&0)) /\ (s HAS_SIZE n) ==>
    (?f. s = IMAGE f (1..n) /\  (!j k.
                                   j IN 1..n /\ k IN 1..n /\ j < k
                                   ==> ~(poly_sort_fn P u (f k) (f j))))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MP_TAC (SPEC `poly_sort_fn P u` (INST_TYPE [`:(real^2->bool)`,`:A`] TOPOLOGICAL_SORT));
  ANTS_TAC;
  ASM_MESON_TAC [poly_sort_antisym;poly_sort_trans];
  (fun gl -> (DISCH_THEN (MP_TAC o (SPECL ( envl gl [`n`;`s`])))) gl);
  ASM_MESON_TAC []
  ]);;
  (* }}} *)

let POLY_SORT = 
prove_by_refinement(
  `!P n s r u.  (s = { c | c facet_of P }) /\ polyhedron P /\ (&0 < r) /\ 
     (!p. norm p < r ==> P p) /\ ~(u = Cx (&0)) /\ (s HAS_SIZE n) ==>
    (?f. s = IMAGE f (1..n) /\ 
  (!j k. j IN 1..n /\ k IN 1..n /\ j < k
      ==> (Arg (facet_rep_a P (f j) / u) < Arg (facet_rep_a P (f k) / u))))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  (fun gl -> (MP_TAC (SPECL ( envl gl [`P`;`n`;`s`;`r`;`u`]) POLY_SORT_LEMMA)) gl);
  ASM_REWRITE_TAC [];
  REPEAT WEAK_STRIP_TAC;
  EXISTSv_TAC "f";
  ASM_REWRITE_TAC [];
  REPEAT WEAK_STRIP_TAC;
  (fun gl -> (HASH_RULE_TAC 9718 (SPECL ( envl gl [`j`;`k`]))) gl);
  ASM_REWRITE_TAC [ poly_sort_fn ];
  TYPIFY `!i. (i IN 1..n) ==> (f i facet_of P)` (C SUBGOAL_THEN ASSUME_TAC);
  REPEAT WEAK_STRIP_TAC;
  HASH_UNDISCH_TAC 8348;
  ONCE_REWRITE_TAC [ FUN_EQ_THM ];
  REWRITE_TAC [ IN_ELIM_THM;IMAGE; ];
  BY(ASM_MESON_TAC []);
  ASM_SIMP_TAC [];
  MATCH_MP_TAC (REAL_ARITH `~(a = b) ==> (~(b <= a) ==> (a < b))`);
  DISCH_TAC;
  TYPIFY `f j = f k` (C SUBGOAL_THEN ASSUME_TAC);
  MATCH_MP_TAC poly_sort_antisym;
  EXISTSv_TAC "P";
  EXISTSv_TAC "u";
  EXISTSv_TAC "r";
  ASM_REWRITE_TAC [poly_sort_fn; REAL_ARITH `x <= x`];
  HASH_UNDISCH_TAC 8348;
  ONCE_REWRITE_TAC [ FUN_EQ_THM ];
  REWRITE_TAC [IN;IN_ELIM_THM;IMAGE];
  BY(ASM_MESON_TAC [IN]);
  TYPIFY `INJ f (1..n) s  = SURJ f (1..n) s` (C SUBGOAL_THEN ASSUME_TAC);
  MATCH_MP_TAC INJ_IFF_SURJ;
  BY(ASM_MESON_TAC [ HAS_SIZE_NUMSEG_1; HAS_SIZE ]);
  TYPIFY `SURJ f (1..n) s` (C SUBGOAL_THEN ASSUME_TAC);
  BY(ASM_REWRITE_TAC [Misc_defs_and_lemmas.IMAGE_SURJ]);
  HASH_UNDISCH_TAC 7609;
  ASM_REWRITE_TAC [];
  REWRITE_TAC [INJ;IMAGE;DE_MORGAN_THM];
  DISJ2_TAC;
  ASM_MESON_TAC [ ARITH_RULE `j < k ==> ~((j:num) = k)`]
  ]);;
  (* }}} *)

let POLY_SORT_BIJ = 
prove_by_refinement(
  `!P n s r u.  (s = { c | c facet_of P }) /\ polyhedron P /\ (&0 < r) /\ 
     (!p. norm p < r ==> P p) /\ ~(u = Cx (&0)) /\ (s HAS_SIZE n) ==>
    (?f. s = IMAGE f (1..n) /\ BIJ f (1..n) s /\
  (!j k. j IN 1..n /\ k IN 1..n /\ j < k
      ==> (Arg (facet_rep_a P (f j) / u) < Arg (facet_rep_a P (f k) / u))))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  (fun gl -> (MP_TAC (SPECL ( envl gl [`P`;`n`;`s`;`r`;`u`]) POLY_SORT)) gl);
  ASM_REWRITE_TAC [];
  REPEAT WEAK_STRIP_TAC;
  EXISTSv_TAC "f";
  ASM_REWRITE_TAC [BIJ;Misc_defs_and_lemmas.IMAGE_SURJ;INJ;IN_IMAGE];
  CONJ_TAC;
  BY(MESON_TAC []);
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC [ ARITH_RULE `(x = y) <=> ~(x < (y:num)) /\ ~(y < x)` ];
  ASM_MESON_TAC [ REAL_ARITH `(x = y) ==> ~( x < y)` ]
  ]);;
  (* }}} *)

let facet_rep_nz = 
prove_by_refinement(
  `!P c. polyhedron P /\ c facet_of P ==> ~(facet_rep_a P c = Cx (&0))`,

  (* {{{ proof *)
  [
  MESON_TAC [ COMPLEX_VEC_0; NORM_0 ; REAL_ARITH `~(&0= &1)`; facet_rep_def]
  ]);;
  (* }}} *)

let bisector_point_exists = 
prove_by_refinement(
  ` !P c c' r. ?v. !psi. (polyhedron P /\ c facet_of P /\ c' facet_of P /\ &0 < r /\
    (!p. norm p < r ==> P p) /\ 
    psi = Arg (facet_rep_a P c' / facet_rep_a P c) / &2 /\
    (!c''. c'' facet_of P /\
            Arg (facet_rep_a P c'' / facet_rep_a P c) < &2 * psi
            ==> c'' = c) /\
    psi < pi/ &2 /\ ~(c' = c)) ==>
    (P v /\ norm v = r * inv (cos (psi)) /\ Arg ( v/ facet_rep_a P c) = psi /\
    Arg (facet_rep_a P c' / v) = psi)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  TYPED_ABBREV_TAC `psi = Arg (facet_rep_a P c' / facet_rep_a P c) / &2`;
  TYPED_ABBREV_TAC `(u:real^2) = facet_rep_a P c`;
  TYPED_ABBREV_TAC `(v:real^2) = Cx (r * inv (cos (psi))) * cexp (ii * (Cx psi)) * u`;
  EXISTSv_TAC "v";
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC (TAUT `b /\ (b ==> c) /\ ( b /\ c ==> d) /\ ( b /\ c /\ d ==> a) ==> a /\ b /\ c /\ d `);
  SUBGOAL_THEN `&0 <= psi` ASSUME_TAC;
    HASH_KILL_TAC 8647;
    EXPAND_TAC "psi";
    BY(MESON_TAC [ ARG ; REAL_ARITH `&0 <= x ==> &0 <= x/ &2`]);
  CONJ_TAC;
    EXPAND_TAC "v";
    REWRITE_TAC [COMPLEX_NORM_MUL;COMPLEX_NORM_CX;NORM_CEXP_II;REAL_ABS_MUL];
    EXPAND_TAC "u";
    ASM_SIMP_TAC [facet_rep_def; Trigonometry2.LT_IMP_ABS_REFL ];
    SUBGOAL_THEN `abs(inv(cos psi)) = inv (cos psi)` SUBST1_TAC;
      REWRITE_TAC [ ( Trigonometry2.ABS_REFL);REAL_LE_INV_EQ];
      MATCH_MP_TAC Trigonometry.ZSKECZV;
      MP_TAC PI_POS;
      BY(ASM_REAL_ARITH_TAC);
    BY(REAL_ARITH_TAC);
  SUBGOAL_THEN `&0 < r * inv (cos psi)` ASSUME_TAC;
    MATCH_MP_TAC REAL_LT_MUL;
    ASM_REWRITE_TAC [ REAL_LT_INV_EQ ];
    MATCH_MP_TAC COS_POS_PI;
    MP_TAC PI_POS;
    ASM_REAL_ARITH_TAC;
  CONJ_TAC;
    DISCH_TAC;
    EXPAND_TAC "v";
    REWRITE_TAC [ complex_div;GSYM COMPLEX_MUL_ASSOC ];
    SUBGOAL_THEN ( `u * inv u = Cx (&1)` ) SUBST1_TAC;
      MATCH_MP_TAC COMPLEX_MUL_RINV;
      BY(ASM_MESON_TAC [ facet_rep_def ; NORM_0 ; COMPLEX_VEC_0 ; REAL_ARITH `~(&0 = &1)` ]);
    ASM_SIMP_TAC [ARG_MUL_CX];
    REWRITE_TAC [COMPLEX_MUL_RID];
    MATCH_MP_TAC ARG_UNIQUE;
    EXISTS_TAC `&1`;
    ASM_REWRITE_TAC [COMPLEX_MUL_LID;REAL_ARITH `&0 < &1`];
    MP_TAC PI_POS;
    BY(ASM_REAL_ARITH_TAC);
  CONJ_TAC;
    DISCH_TAC;
    (fun gl -> (MP_TAC (SPECL ( envl gl [`(v:complex) / u`;`facet_rep_a P c' / (u:complex)`]) ARG_LE_DIV_SUM)) gl);
    ANTS_TAC;
      REWRITE_TAC [ ARG_0_DIV ];
      MATCH_MP_TAC (TAUT `(a /\ b) /\ c ==> a /\ b /\ c`);
      CONJ_TAC;
        ASM_MESON_TAC [ NORM_0; REAL_ARITH `~(&0 < &0)`; facet_rep_def; REAL_ARITH `~(&0 = &1)` ; COMPLEX_VEC_0 ];
      BY(ASM_REAL_ARITH_TAC);
    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));
    REWRITE_TAC [ complex_div ; GSYM COMPLEX_MUL_ASSOC ];
    AP_TERM_TAC;
    REWRITE_TAC [ COMPLEX_INV_MUL;COMPLEX_INV_INV];
    SUBGOAL_THEN `(inv u * u = Cx (&1)) ==> (inv (u:complex) * inv v * u = inv v) ` MATCH_MP_TAC;
      SIMPLE_COMPLEX_ARITH_TAC;
    MATCH_MP_TAC COMPLEX_MUL_LINV;
    BY(ASM_MESON_TAC [ facet_rep_def; NORM_0 ; COMPLEX_VEC_0 ; REAL_ARITH `~(&0 = &1)` ]);
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC insert_v;
  EXISTSv_TAC "c";
  EXISTSv_TAC "c'";
  EXISTSv_TAC "r";
  EXISTSv_TAC "psi";
  ASM_REWRITE_TAC [];
  SUBCONJ_TAC;
    ASM_SIMP_TAC [ (REAL_ARITH `&0 <= psi ==> (&0 < psi <=> ~(psi = &0))`)];
    DISCH_TAC;
    HASH_UNDISCH_TAC 1934;
    ASM_REWRITE_TAC [];
    EXPAND_TAC "u";
    REWRITE_TAC [ (REAL_ARITH `x / &2 = &0 <=> x = &0`)];
    REWRITE_TAC [ ARG_EQ_0; REAL_EXISTS;DE_MORGAN_THM;NOT_EXISTS_THM ];
    MATCH_MP_TAC (TAUT `(b ==> a) ==> (a \/ ~b)`);
    REPEAT WEAK_STRIP_TAC;
    HASH_UNDISCH_TAC 2684;
    ASM_REWRITE_TAC [];
    DISCH_TAC;
    SUBGOAL_THEN `!u v. u = v ==> (u * facet_rep_a P c = v * facet_rep_a P c)` MP_TAC;
      REWRITE_TAC [ COMPLEX_EQ_MUL_RCANCEL ];
      BY(MESON_TAC []);
    DISCH_THEN (fun loc_u -> FIRST_X_ASSUM (fun loc_t -> MP_TAC (MATCH_MP loc_u loc_t)));
    REWRITE_TAC [ complex_div ; GSYM COMPLEX_MUL_ASSOC ];
    ASM_SIMP_TAC [ COMPLEX_MUL_LINV ; facet_rep_nz; COMPLEX_MUL_RID ];
    EXPAND_TAC "u";
    REWRITE_TAC [GSYM COMPLEX_CMUL];
    HASH_RULE_TAC 8014 ( REWRITE_RULE[ RE_CX]);
    DISCH_TAC;
    DISCH_TAC;
    SUBGOAL_THEN `&0 < x` ASSUME_TAC;
      ASM_SIMP_TAC [(REAL_ARITH `&0 <= x ==> (&0 < x <=> ~(x = &0))`)];
      DISCH_TAC;
      HASH_UNDISCH_TAC 487;
      ASM_REWRITE_TAC [ VECTOR_MUL_LZERO; COMPLEX_VEC_0 ];
      BY(ASM_MESON_TAC [ facet_rep_nz ]);
    BY(ASM_MESON_TAC [ facet_rep_a_uniq]);
  FULL_EXPAND_TAC "u";
  FULL_EXPAND_TAC "psi";
  ASM_REWRITE_TAC [ real_div ];
  ASM_REAL_ARITH_TAC
  ]);;
  (* }}} *)

let bisector_point = new_specification ["bisector_point"] (REWRITE_RULE[SKOLEM_THM] bisector_point_exists);;
let RCONE_LINEAR_INVARIANT = 
prove_by_refinement(
  `!(f:real^M->real^N) v a.  
   linear f /\ (!y. ?x. f x = y) /\ (!x. norm (f x) = norm x) 
  ==>   rcone_gt (vec 0) (f v) a    = IMAGE f (rcone_gt (vec 0) v a)`,

  (* {{{ proof *)
  [
  REWRITE_TAC [rcone_gt;rconesgn; VECTOR_SUB_RZERO; DIST_0];
  ONCE_REWRITE_TAC [FUN_EQ_THM];
  REWRITE_TAC [IMAGE;IN_ELIM_THM;IN];
  MESON_TAC[ PRESERVES_NORM_PRESERVES_DOT ]
  ]);;
  (* }}} *)

let FCHANGED_LINEAR_INVARIANT = 
prove_by_refinement(
  `!(f:real^M->real^N) c. linear f /\ (!x y. (f x = f y) ==> x = y)
    ==> fchanged (IMAGE f c) = IMAGE f (fchanged c)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC [Polyhedron.fchanged];
  ONCE_REWRITE_TAC [FUN_EQ_THM];
  REWRITE_TAC[ IN_ELIM_THM];
  (fun gl -> (MP_TAC (ISPECL ( envl gl [`f`;`c`]) RELATIVE_INTERIOR_INJECTIVE_LINEAR_IMAGE )) gl);
  ASM_REWRITE_TAC [];
  DISCH_THEN SUBST1_TAC;
  GEN_TAC;
  EQ_TAC;
    REWRITE_TAC [IN_ELIM_THM;IN;IMAGE];
    REPEAT WEAK_STRIP_TAC;
    EXISTS_TAC `(t % x'):real^M`;
    ASM_SIMP_TAC [ LINEAR_CMUL ];
    BY(ASM_MESON_TAC []);
  REWRITE_TAC [ X_IN IN_IMAGE ];
  DISCH_THEN (MP_TAC o (REWRITE_RULE [IN_ELIM_THM]));
  REPEAT WEAK_STRIP_TAC;
  EXISTS_TAC `(f:real^M->real^N) v1`;
  EXISTSv_TAC "t";
  ASM_SIMP_TAC [ LINEAR_CMUL ];
  ASM_MESON_TAC [IN_IMAGE;IN_ELIM_THM;IN]
  ]);;
  (* }}} *)

let BALL_LINEAR_INVARIANT = 
prove_by_refinement(
  `!(f:real^M->real^M)  r. linear f /\ (!x. norm (f x) = norm x ) /\ (!y. ?x. f x = y)
    ==> IMAGE f (ball (vec 0,r)) = (ball (vec 0,r))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  ONCE_REWRITE_TAC [FUN_EQ_THM];
  REWRITE_TAC[ X_IN IN_IMAGE; X_IN IN_BALL_0 ];
  ASM_MESON_TAC []
  ]);;
  (* }}} *)

let cos_acs_pi6 = 
prove_by_refinement(
  `!h. &1 <= h /\ h <= h0 ==>
    cos (acs (h/ &2) - pi/ &6) = h * sqrt3 / #4.0 + sqrt(&1- (h/ &2) pow 2) / &2`,

  (* {{{ proof *)
  [
REWRITE_TAC[COS_SUB;COS_PI6;SIN_PI6;Sphere.h0;Sphere.sqrt3];
REPEAT STRIP_TAC;
  SUBGOAL_THEN `-- &1 <= h/ &2 /\ h/ &2 <= &1` MP_TAC;
ASM_REAL_ARITH_TAC;
REPEAT STRIP_TAC;
ASM_SIMP_TAC[SIN_ACS;COS_ACS];
REAL_ARITH_TAC
  ]);;
  (* }}} *)

let regular_spherical_polygon_area_asnFnhk = 
prove_by_refinement(
  `!h k . (3 <= k /\ &1 <= h /\ h <= h0) ==>
  (regular_spherical_polygon_area (h * sqrt3 / #4.0 + sqrt (&1 - (h/ &2) pow 2) / &2) (&k) = 
     &2 * pi - &2 * asnFnhk h (&k) (&1) (&1) (&1) (&1))`,

  (* {{{ proof *)
  [
REWRITE_TAC[Sphere.regular_spherical_polygon_area;Sphere.asnFnhk;Sphere.h0]
  ]);;
  (* }}} *)

let regular_spherical_polygon_area_797 = 
prove_by_refinement(
  `!h k . (3 <= k) ==>
  (regular_spherical_polygon_area (cos #0.797) (&k) = 
     &2 * pi - &2 * (&k) * asn (cos #0.797 * sin (pi / &k)))`,

  (* {{{ proof *)
  [
REWRITE_TAC[Sphere.regular_spherical_polygon_area;Sphere.asnFnhk;Sphere.h0]
  ]);;
  (* }}} *)

let BIEFJHU_explicit = 
prove_by_refinement(
  `!h k. (pack_ineq_def_a /\ &1 <= h /\ h <= h0 /\ 3 <= k) ==>
   (#0.591 - #0.0331 * (&k) + #0.506 * lfun h) <= 
    max (&0) (regular_spherical_polygon_area
     (h * sqrt3 / #4.0 + sqrt (&1 - (h/ &2) pow 2) / &2) (&k))
   `,

  (* {{{ proof *)
  [
REWRITE_TAC[pack_ineq_def_a;Sphere.ineq;Sphere.lfun_y1;Sphere.h0];
REPEAT STRIP_TAC;
ASM_CASES_TAC `&34 <= &k`;
HASH_UNDISCH_TAC 4600 ;
    DISCH_THEN (MP_TAC o (SPECL [`h:real`;`&1`;`&1`;`&1`;`&1`;`&1`]));
MP_TAC (REAL_MAX_MAX);
BY(ASM_REAL_ARITH_TAC);
HASH_UNDISCH_TAC 3073 ;
    DISCH_THEN (MP_TAC o (SPECL [`h:real`;`(&k)`;`&1`;`&1`;`&1`;`&1`]));
ASM_SIMP_TAC[regular_spherical_polygon_area_asnFnhk;Sphere.h0;REAL_ARITH `&1 <= &1 /\ #3.0 = &3`];
MP_TAC (REAL_MAX_MAX);
HASH_RULE_TAC 415 (ONCE_REWRITE_RULE[GSYM REAL_OF_NUM_LE]);
ASM_REWRITE_TAC [REAL_ARITH `#1.0 = &1`];
ASM_SIMP_TAC [REAL_ARITH `~(&34 <= &k) ==> &k <= #34.0`];
ASM_REAL_ARITH_TAC
  ]);;
  (* }}} *)

let UKBRPFE_explicit = 
prove_by_refinement(
  `!k. (pack_ineq_def_a /\ 3 <= k) ==>
   (#0.591 - #0.0331 * (&k) + #0.506 * lfun (&1) + &1 <=
    max (&0) (regular_spherical_polygon_area (cos #0.797) (&k)))`,

  (* {{{ proof *)
  [
REWRITE_TAC[pack_ineq_def_a;Sphere.ineq;Sphere.lfun_y1;Sphere.h0;Sphere.asn797k];
REPEAT STRIP_TAC;
ASM_SIMP_TAC [regular_spherical_polygon_area_797];
HASH_RULE_TAC 6953 (SPECL[`&k`;`&1`;`&1`;`&1`;`&1`;`&1`]);
HASH_RULE_TAC 415 (ONCE_REWRITE_RULE[GSYM REAL_OF_NUM_LE;REAL_ARITH `&3 = #3.0`]);
HASH_RULE_TAC 1319 (SPEC `&1`);
MP_TAC (REAL_MAX_MAX);
REAL_ARITH_TAC
  ]);;
  (* }}} *)

let DLWCHEM_sum = 
prove_by_refinement(
  `!h k n. pack_ineq_def_a /\
   (12 < n) /\ (!i. (i < n) ==> (3 <= k i) /\ (&1 <= h i) /\ (h i <= h0) ) /\ 
   (sum (0..(n-1)) (\i. &(k i)) <= (&6 * &n - &12)) /\
   (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)) )) 
      <= &4 * pi) /\ 
   (&12 < sum (0..(n-1)) (\i. lfun (h i))) 
 ==> (n < 16)`,

  (* {{{ proof *)
  [
REPEAT STRIP_TAC;
  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;
MATCH_MP_TAC SUM_LE_NUMSEG;
ASM_SIMP_TAC [ARITH_RULE `(12 < n) ==> (0 <= i /\ i <= n-1 <=> i < n)`];
REPEAT STRIP_TAC;
MP_TAC (SPECL [`(h:num->real) i`;`(k:num->num) i`] BIEFJHU_explicit);
ASM_SIMP_TAC [];
  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;
REWRITE_TAC[SUM_ADD_NUMSEG;SUM_SUB_NUMSEG;SUM_CONST_NUMSEG;SUM_LMUL];
ASM_SIMP_TAC [ARITH_RULE `12 < n ==> (n-1 + 1 ) - 0= n `];
ASM_REAL_ARITH_TAC;
SUBGOAL_THEN `#0.591 * &n - #0.0331 * (&6 * &n - &12) + #0.506 * &12 <= &4 * pi` MP_TAC;
ASM_REAL_ARITH_TAC;
SUBGOAL_THEN `pi < #3.1416` MP_TAC;
REWRITE_TAC [Flyspeck_constants.bounds];
ONCE_REWRITE_TAC[GSYM REAL_OF_NUM_LT];
REAL_ARITH_TAC
  ]);;
  (* }}} *)

let XULJEPR_sum = 
prove_by_refinement(
  `!h k n. ( pack_ineq_def_a /\
    (12 < n) /\ (h 0 = &1) /\
   (!i. i < n ==> 3 <= k i /\ &1 <= h i /\ h i <= h0) /\ 
sum (0..n - 1) (\i. &(k i)) <= &6 * &n - &12 /\ 
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)))) <=
         &4 * pi /\
         &12 < sum (0..n - 1) (\i. lfun (h i)) ==> F
  )`,

  (* {{{ proof *)
  [
REPEAT STRIP_TAC;
  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;
ASM_SIMP_TAC [ARITH_RULE `0 <= (n-1)/\ 0 + 1 = 1`;SUM_CLAUSES_LEFT;];
REWRITE_TAC [REAL_ARITH `&1 + u + v = (u+ &1) + v`];
MATCH_MP_TAC (REAL_ARITH `a <= b /\ c <= d ==> (a + c) <= (b + d)`);
CONJ_TAC;
MP_TAC (SPEC `(k:num->num) 0` UKBRPFE_explicit);
ANTS_TAC;
ASM_MESON_TAC[ARITH_RULE `12 < n ==> 0 < n`];
REAL_ARITH_TAC;
MATCH_MP_TAC SUM_LE_NUMSEG;
ASM_SIMP_TAC [ARITH_RULE `(12 < n) ==> (1 <= i /\ i <= n-1 <=> 1 <=i /\ i < n)`];
REPEAT STRIP_TAC;
MP_TAC (SPECL [`(h:num->real) i`;`(k:num->num) i`] BIEFJHU_explicit);
BY(ASM_SIMP_TAC []);
  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;
MATCH_MP_TAC (REAL_ARITH `a <= b ==> &1 + a <= &1 + b`);
REWRITE_TAC[SUM_ADD_NUMSEG;SUM_SUB_NUMSEG;SUM_CONST_NUMSEG;SUM_LMUL];
ASM_SIMP_TAC [ARITH_RULE `12 < n ==> (n-1 + 1 ) - 0= n `];
BY(ASM_REAL_ARITH_TAC);
SUBGOAL_THEN `&1 + #0.591 * &n - #0.0331 * (&6 * &n - &12) + #0.506 * &12 <= &4 * pi` MP_TAC;
BY(ASM_REAL_ARITH_TAC);
SUBGOAL_THEN `pi < #3.1416` MP_TAC;
REWRITE_TAC [Flyspeck_constants.bounds];
SUBGOAL_THEN `&13 <= &n` MP_TAC;
UNDISCH_TAC `12 < n`;
REWRITE_TAC[ REAL_OF_NUM_LE];
ARITH_TAC;
REAL_ARITH_TAC
  ]);;
  (* }}} *)

let REAL_CONVEX_ON_SECOND_SECANT = 
prove_by_refinement(
  `!f f'  f'' s. 
  is_realinterval s /\
         ~(?a. s = {a}) /\
         (!x. x IN s ==> (f has_real_derivative f' x) (atreal x within s)) /\
         (!x. x IN s ==> (f' has_real_derivative f'' x) (atreal x within s)) /\
         (!x. x IN s ==> &0 <= f'' x)
    ==> (!x y. x IN s /\ y IN s ==> f y - f x <= f' y * (y - x))`,

  (* {{{ proof *)
  [
REPEAT STRIP_TAC ;
SUBGOAL_THEN `f real_convex_on s` ASSUME_TAC;
ASM_MESON_TAC [REAL_CONVEX_ON_SECOND_DERIVATIVE];
ASM_MESON_TAC [REAL_CONVEX_ON_SECANT_DERIVATIVE]
  ]);;
  (* }}} *)

let asn_sin_t' = Calc_derivative.differentiate 
  `\x. x - asn(sin x * t)` `x:real` `real_interval [&0,  pi]`;;

let asn_sin_t'' = Calc_derivative.differentiate 
  `\x. &1 - (cos x * t) * inv (sqrt (&1 - (sin x * t) pow 2))` `x:real` `real_interval [&0,  pi]`;;

let asn_sin_t''_alt = 
prove_by_refinement(
  `!x t alpha. abs(sin x * t) < &1 /\ cos alpha = sin x * t ==>
    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])` ,

  (* {{{ proof *)
  [
REPEAT STRIP_TAC ;
MP_TAC asn_sin_t'';
REWRITE_TAC [Calc_derivative.derived_form];
HASH_UNDISCH_TAC 8283 ;
FIRST_X_ASSUM (fun t -> (SUBST1_TAC o GSYM) t THEN ASSUME_TAC (GSYM t));
DISCH_TAC;
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[]);
SUBGOAL_THEN `&0 < &1 - cos alpha  pow 2` ASSUME_TAC;
REWRITE_TAC [REAL_ARITH `&0 < &1 - x pow 2 <=> x pow 2 < &1 pow 2`];
ASM_REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS;REAL_ARITH `abs (&1) = &1`];
ASM_REWRITE_TAC [];
CONJ_TAC;
ASM_SIMP_TAC [ (SQRT_EQ_0); REAL_ARITH `&0 < u ==> &0 <= u`];
BY(ASM_REAL_ARITH_TAC);
SUBGOAL_THEN `sqrt (&1 - cos alpha pow 2) = abs(sin alpha)` SUBST1_TAC;
REWRITE_TAC[REWRITE_RULE [REAL_ARITH `(x + y = &1) <=> ( &1 - y = x)`] (SPEC`alpha:real` SIN_CIRCLE)];
REWRITE_TAC [POW_2_SQRT_ABS];
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)`);
REWRITE_TAC [REAL_ARITH `~(&2= &0) /\ ~(&1 = &0)`;REAL_ABS_ZERO];
CONJ_TAC;
HASH_UNDISCH_TAC 754 ;
REWRITE_TAC [REWRITE_RULE[REAL_ARITH `x + y = &1 <=> &1 - y = x`] (SPEC `alpha:real` SIN_CIRCLE)];
REWRITE_TAC [Trigonometry2.NOT_ZERO_EQ_POW2_LT];
MP_TAC (SPEC `x:real` SIN_CIRCLE);
MP_TAC (SPEC `alpha:real` SIN_CIRCLE);
HASH_UNDISCH_TAC 3350 ;
SUBST1_TAC (SPEC `sin(alpha)` (GSYM REAL_POW2_ABS));
TYPED_ABBREV_TAC `u = abs (sin alpha)`;
CONV_TAC REAL_FIELD
  ]);;
  (* }}} *)

let real_interval_not_sing = 
prove_by_refinement(
  `!a b. (a < b) ==> ~(?c. real_interval [a,b] = {c})`,

  (* {{{ proof *)
  [
REWRITE_TAC [real_interval];
REPEAT STRIP_TAC ;
HASH_UNDISCH_TAC 5180 ;
REWRITE_TAC[FUN_EQ_THM;IN;IN_ELIM_THM;X_IN IN_SING];
STRIP_TAC ;
FIRST_X_ASSUM (fun t -> MP_TAC (SPEC `a:real` t) THEN MP_TAC (SPEC `b:real` t));
ASM_REAL_ARITH_TAC
  ]);;
  (* }}} *)

let g_convex  = 
prove_by_refinement(
  `!t. (&0 < t /\ t < &1) ==> (? s f'  f''. 
   s = real_interval [&0,  pi] /\
  is_realinterval s /\
         ~(?a. s = {a}) /\
         (!x. x IN s ==> ((\x. x - asn(sin x * t)) has_real_derivative f' x) (atreal x within s)) /\
         (!x. x IN s ==> (f' has_real_derivative f'' x) (atreal x within s)) /\
         (!x. x IN s ==> &0 <= f'' x))
  `,

  (* {{{ proof *)
  [
REPEAT STRIP_TAC;
EXISTS_TAC `real_interval [&0, pi]`;
REWRITE_TAC [IS_REALINTERVAL_INTERVAL];
EXISTS_TAC `(\x. &1 - (cos x * t) * inv (sqrt (&1 - (sin x * t) pow 2)))`;
EXISTS_TAC `\x. (t * (&1 - t pow 2) * sin x * inv (abs(sin (acs (sin x * t))) pow 3))`;
CONJ_TAC;
MATCH_MP_TAC real_interval_not_sing;
REWRITE_TAC [PI_POS];
SUBGOAL_THEN `!x. abs(sin x * t) < &1` ASSUME_TAC;
GEN_TAC;
REWRITE_TAC [REAL_ABS_MUL];
ASM_SIMP_TAC [REAL_ARITH `&0 < t ==> abs t = t`];
MATCH_MP_TAC (REAL_ARITH `(t < &1) /\ (&0 <= t - u * t) ==> u * t < &1`);
ASM_REWRITE_TAC [REAL_ARITH `t - u * t = t * (&1 - u)`;];
MATCH_MP_TAC REAL_LE_MUL;
MP_TAC (SPEC `x:real` SIN_BOUND);
BY(ASM_REAL_ARITH_TAC);
SUBGOAL_THEN `!x. cos (acs (sin x * t)) = sin x * t` ASSUME_TAC;
GEN_TAC ;
MATCH_MP_TAC COS_ACS;
FIRST_X_ASSUM (MP_TAC o (SPEC `x:real`));
BY(REAL_ARITH_TAC);
CONJ_TAC;
REPEAT STRIP_TAC ;
MP_TAC asn_sin_t';
ASM_REWRITE_TAC [Calc_derivative.derived_form];
CONJ_TAC;
REPEAT STRIP_TAC ;
REPEAT (FIRST_X_ASSUM (ASSUME_TAC o (SPEC `x:real`)));
MP_TAC (SPECL[`x:real`;`t:real`;`acs (sin x * t)`] asn_sin_t''_alt);
ASM_REWRITE_TAC [Calc_derivative.derived_form];
REPEAT STRIP_TAC ;
BETA_TAC;
REPEAT (MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC);
ASM_REAL_ARITH_TAC ;
REWRITE_TAC[REAL_ARITH `&1 - t pow 2 = (&1 - t) + t * (&1-t)`];
MATCH_MP_TAC (REAL_ARITH `&0 < x /\ &0 < y ==> &0 <= x + y`);
CONJ_TAC THEN (TRY (MATCH_MP_TAC REAL_LT_MUL)) THEN ASM_REAL_ARITH_TAC;
HASH_UNDISCH_TAC 2464 ;
REWRITE_TAC [IN;IN_ELIM_THM;real_interval;SIN_POS_PI_LE];
REWRITE_TAC [REAL_LE_INV_EQ;];
MATCH_MP_TAC REAL_POW_LE;
REWRITE_TAC [REAL_ABS_POS]
  ]);;
  (* }}} *)

let GOTCJAH_convex_sum = 
prove_by_refinement(
  `!n t bet u. 0 < n /\ u <= &n * pi /\ &0 <= u /\
  &0 < t /\ t < &1 /\  sum (0..(n-1)) bet = u /\ 
  (!i. i < n ==> &0 <= bet i /\ bet i <= pi) ==>
  (u - &n * asn (sin (u/ &n) * t)) <= sum (0..(n-1)) (\i. bet i - asn (sin (bet i) * t))`,

  (* {{{ proof *)
  [
REPEAT STRIP_TAC ;
MP_TAC (SPEC `t:real` g_convex);
ASM_REWRITE_TAC [];
REPEAT STRIP_TAC ;
MP_TAC (SPECL [`\x. x - asn(sin x * t)`;`f':real->real`;`f'':real->real`;`s:real->bool`] REAL_CONVEX_ON_SECOND_SECANT);
ASM_REWRITE_TAC [real_interval;IN_ELIM_THM];
REWRITE_TAC [REAL_ARITH `u - v <= c * (y - x) <=> u + c * (x- y) <= v`];
DISCH_TAC ;
TYPED_ABBREV_TAC `m = u / &n`;
SUBGOAL_THEN `&0 <= m /\ m <= pi` ASSUME_TAC;
EXPAND_TAC "m";
HASH_UNDISCH_TAC 5908 ;
HASH_UNDISCH_TAC 3476 ;
REWRITE_TAC[GSYM REAL_OF_NUM_LT];
HASH_UNDISCH_TAC 9033 ;
SIMP_TAC [REAL_LE_DIV;REAL_ARITH `&0 < v ==> &0 <= v`];
SIMP_TAC [REAL_LE_LDIV_EQ];
REAL_ARITH_TAC ;
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;
MATCH_MP_TAC SUM_LE_NUMSEG;
BETA_TAC;
ASM_SIMP_TAC [ARITH_RULE `0 < n ==> (0 <= i /\ i <= n-1 <=> i < n)`];
MATCH_MP_TAC REAL_LE_TRANS;
EXISTS_TAC `sum (0..n - 1) (\i. m - asn (sin m * t) + f' m * (bet i - m))`;
ASM_REWRITE_TAC [];
ASM_REWRITE_TAC[SUM_ADD_NUMSEG;SUM_SUB_NUMSEG;SUM_CONST_NUMSEG;SUM_LMUL];
ASM_SIMP_TAC [ARITH_RULE `0 < n ==> (n - 1 + 1) - 0 = n`];
EXPAND_TAC "m";
SUBGOAL_THEN `&n * u/ &n = u` (fun t -> SUBST1_TAC t THEN REAL_ARITH_TAC);
HASH_UNDISCH_TAC 3476 ;
REWRITE_TAC[GSYM REAL_OF_NUM_LT];
CONV_TAC REAL_FIELD
  ]);;
  (* }}} *)

let dih_dot = 
prove_by_refinement(
  `!(u:real^3) v w. ~(u = vec 0) /\ ((w- u) dot v = &0) /\ ((w - u) dot u = &0) ==>
   dihV (vec 0) u v w = pi / &2`,

  (* {{{ proof *)
  [
REPEAT STRIP_TAC ;
MP_TAC (SPECL [`vec 0:real^3`;`u:real^3`;`v:real^3`;`w:real^3`]  Hvihvec.HVIHVEC);
ASM_REWRITE_TAC [VECTOR_SUB_RZERO;LET_DEF;LET_END_DEF];
DISCH_THEN SUBST1_TAC;
REWRITE_TAC [GSYM ORTHOGONAL_VECTOR_ANGLE;orthogonal];
SUBGOAL_THEN `(u:real^3) cross w = u cross (w - u)` SUBST1_TAC;
REWRITE_TAC [CROSS_RADD;VECTOR_SUB;CROSS_RNEG;CROSS_REFL];
REWRITE_TAC [GSYM VECTOR_SUB;VECTOR_SUB_RZERO];
ONCE_REWRITE_TAC [DOT_SYM];
ONCE_REWRITE_TAC [GSYM CROSS_TRIPLE];
ONCE_REWRITE_TAC [CROSS_SKEW];
REWRITE_TAC [CROSS_LAGRANGE;VECTOR_SUB;DOT_LADD;DOT_LNEG;DOT_LMUL];
MATCH_MP_TAC (REAL_FIELD `a = &0 /\ b = &0 ==> -- ((c * a) + -- (d * b)) = &0`);
ONCE_REWRITE_TAC [DOT_SYM];
ASM_REWRITE_TAC [GSYM VECTOR_SUB]
  ]);;
  (* }}} *)

let abs_1_prod = 
prove_by_refinement(
  `!x y. abs x <= &1 /\ abs y <= &1 ==> abs (x * y) <= &1`,

  (* {{{ proof *)
  [
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)` ];
REPEAT STRIP_TAC ;
MATCH_MP_TAC (REAL_ARITH `&0 <= a /\ &0 <= b /\ &0 <= c ==> &0 <= a + b + c`);
REPEAT ((TRY CONJ_TAC) THEN (TRY (MATCH_MP_TAC REAL_LE_MUL)) THEN (TRY ASM_REAL_ARITH_TAC))
  ]);;
  (* }}} *)

let sloc2_ortho = 
prove_by_refinement(
  `!(va:real^3) vb vc.  ~(coplanar {vec 0, va,vb,vc}) /\ (dihV (vec 0) vc va vb = pi / &2) 
   ==>
    (let bet = dihV (vec 0) vb vc va in
     let alp = dihV (vec 0) va vb vc in
     let t = cos (arcV (vec 0) vb vc) in
       (cos alp = sin bet * t))`,

  (* {{{ proof *)
  [
REPEAT STRIP_TAC ;
MP_TAC (SPECL [`(vec 0):real^3`;`vc:real^3`;`vb:real^3`;`va:real^3`] (INST_TYPE [(`:3`,`:N`)] Trigonometry2.NLVWBBW));
REPEAT    LET_TAC;
SUBGOAL_THEN  `~collinear {((vec 0):real^3), va , vc } /\  ~collinear {vec 0, va, vb} /\  ~collinear {vec 0, vc, vb}` ASSUME_TAC;
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}`  ];
ASM_REWRITE_TAC [];
SUBGOAL_THEN `al = pi/ &2` SUBST1_TAC;
ASM_MESON_TAC [DIHV_SYM];
REWRITE_TAC [SIN_PI2;COS_PI2;REAL_ARITH `&1 * x = x /\ &0 * x = &0 /\ x + &0 = x`];
SUBGOAL_THEN `ga = alp:real` SUBST1_TAC;
ASM_MESON_TAC [DIHV_SYM];
  DISCH_THEN (SUBST1_TAC o GSYM);
SUBGOAL_THEN `be = bet:real` SUBST1_TAC;
ASM_MESON_TAC [DIHV_SYM];
SUBGOAL_THEN `t = cos c` SUBST1_TAC;
ASM_MESON_TAC [Trigonometry2.ARC_SYM];
REAL_ARITH_TAC 
  ]);;
  (* }}} *)

let vol_solid_triangle_ortho = 
prove_by_refinement(
  `!(u:real^3) v w. ~(coplanar {vec 0, u , v, w}) /\
  ((w- u) dot v = &0) /\ ((w - u) dot u = &0) ==>
    (let bet = dihV (vec 0) v u w in
    let t = cos (arcV (vec 0) v u) in
      (&3 * vol_solid_triangle (vec 0) u v w (&1) = bet - asn (sin bet * t)))
  `,

  (* {{{ proof *)
  [
REPEAT STRIP_TAC ;
REWRITE_TAC [vol_solid_triangle];
REPEAT    LET_TAC;
REWRITE_TAC [REAL_ARITH `&3 * x * &1 pow 3 / &3 = x`];
SUBGOAL_THEN `a231 = bet:real` SUBST1_TAC;
EXPAND_TAC "bet";
EXPAND_TAC "a231";
REWRITE_TAC [DIHV_SYM];
SUBGOAL_THEN `abs(sin bet * t) <= &1` ASSUME_TAC;
MATCH_MP_TAC abs_1_prod;
EXPAND_TAC "t";
REWRITE_TAC [COS_BOUND;SIN_BOUND];
SUBGOAL_THEN `~((u:real^3) = vec 0)` ASSUME_TAC;
STRIP_TAC ;
HASH_UNDISCH_TAC 5227 ;
ASM_REWRITE_TAC [INSERT_INSERT;COPLANAR_3];
SUBGOAL_THEN `a123 = pi / &2` SUBST1_TAC;
EXPAND_TAC "a123";
MATCH_MP_TAC dih_dot;
ASM_REWRITE_TAC [];
SUBGOAL_THEN `asn (sin bet * t) = pi / &2 - acs( sin bet * t)` SUBST1_TAC;
MATCH_MP_TAC ASN_ACS;
ASM_REWRITE_TAC [REAL_ARITH `-- &1 <= x /\ x <= &1 <=> abs x <= &1`];
SUBGOAL_THEN `a312 = acs (sin bet * t)` (fun t -> SUBST1_TAC t THEN REAL_ARITH_TAC);
EXPAND_TAC "a312";
MATCH_MP_TAC COS_INJ_PI;
ASM_SIMP_TAC [COS_ACS;ACS_BOUNDS;DIHV_RANGE;REAL_ARITH `abs y <= &1 ==> -- &1 <= y /\ y <= &1`];
EXPAND_TAC "a312";
MP_TAC (SPECL [`u:real^3`;`v:real^3`;`w:real^3`] dih_dot);
ASM_REWRITE_TAC [];
DISCH_TAC ;
MP_TAC (SPECL [`w:real^3`;`v:real^3`;`u:real^3`] sloc2_ortho);
ANTS_TAC;
ASM_MESON_TAC [SET_RULE `{vec 0, (w:real^3), v ,u} = {vec 0,u,v,w}`;DIHV_SYM];
REPEAT  LET_TAC;
ASM_REWRITE_TAC [];
ASM_MESON_TAC [DIHV_SYM]
  ]);;
  (* }}} *)

let inj_int_ball = Pack1.inj_map3;;

let INJ_IMAGE = 
prove_by_refinement(
  `!a b. INJ (f:A->B) a b ==> IMAGE f a SUBSET b`,

  (* {{{ proof *)
  [
REWRITE_TAC [INJ;IMAGE;SUBSET;IN_ELIM_THM;IN];
MESON_TAC []
  ]);;
  (* }}} *)

let INJ_CARD = 
prove_by_refinement(
  `!a b f. FINITE b /\ INJ (f:A->B) a b ==> (FINITE a /\ CARD a <= CARD b)`,

  (* {{{ proof *)
  [
REPEAT GEN_TAC;
STRIP_TAC ;
SUBGOAL_THEN `FINITE (a:A->bool)` ASSUME_TAC;
MATCH_MP_TAC (INST_TYPE [(`:B`,`:B`)]Misc_defs_and_lemmas.FINITE_INJ);
ASM_MESON_TAC [];
ASM_REWRITE_TAC [];
SUBGOAL_THEN `CARD (IMAGE (f:A->B) a) <= CARD (b:B->bool)` ASSUME_TAC;
MATCH_MP_TAC CARD_SUBSET;
ASM_SIMP_TAC [INJ_IMAGE];
SUBGOAL_THEN `CARD a = CARD (IMAGE (f:A->B) a)` (fun t->SUBST1_TAC t THEN ASM_REWRITE_TAC[]);
MATCH_MP_TAC Misc_defs_and_lemmas.BIJ_CARD;
EXISTS_TAC `f:A->B`;
ASM_REWRITE_TAC [BIJ;Misc_defs_and_lemmas.IMAGE_SURJ];
HASH_UNDISCH_TAC 4678 ;
REWRITE_TAC [INJ;IMAGE];
SET_TAC[]
  ]);;
  (* }}} *)

let card_packing_ball = 
prove_by_refinement(
  `!r. (&0 <= r) ==> ?n. !(S:real^3->bool). 
   packing S /\ S SUBSET (ball ((vec 0),r)) ==> (FINITE S /\ (CARD S) <= n)`,

  (* {{{ proof *)
  [
REPEAT STRIP_TAC ;
TYPED_ABBREV_TAC `r_int_ball = (sqrt (&8 * r pow 2 + &6))`;
TYPED_ABBREV_TAC `b = &4 / &3 * pi * (r_int_ball + sqrt (&3)) pow 3`;
MP_TAC (SPEC `b:real` REAL_ARCH_SIMPLE);
STRIP_TAC;
EXISTS_TAC `n:num`;
GEN_TAC ;
STRIP_TAC ;
MATCH_MP_TAC (MESON[REAL_LE_TRANS;REAL_OF_NUM_LE] `a /\ (&c <= b) /\ (b <= &n) ==> a /\ (c <= n)`);
ASM_REWRITE_TAC[];
MP_TAC (SPECL [`(vec 0):real^3`;`r:real`;`S:real^3->bool`] inj_int_ball);
ASM_REWRITE_TAC [];
SUBGOAL_THEN `S INTER ball (vec 0,r) = (S:real^3->bool)` SUBST1_TAC;
HASH_UNDISCH_TAC 3742 ;
BY(SET_TAC[]);
MP_TAC (SPECL [`(vec 0):real^3`;`r_int_ball:real`] Vol1.WQZISRI);
ANTS_TAC;
EXPAND_TAC "r_int_ball";
MATCH_MP_TAC SQRT_POS_LE;
MATCH_MP_TAC (REAL_ARITH `&0 <= a ==> &0 <= &8 * a + &6`);
REWRITE_TAC [REAL_LE_POW_2];
REPEAT DISCH_TAC;
SUBGOAL_THEN `FINITE (S:real^3->bool) /\ CARD S <= CARD (int_ball (vec 0) r_int_ball)` ASSUME_TAC;
MATCH_MP_TAC INJ_CARD;
EXISTS_TAC `map3 (vec 0)`;
ASM_REWRITE_TAC [];
ASM_REWRITE_TAC [];
ASM_MESON_TAC [REAL_LE_TRANS;REAL_OF_NUM_LE]
  ]);;
  (* }}} *)

let card_packing_annulus = 
prove_by_refinement(
  `?n. !(S:real^3->bool). 
   packing S /\ S SUBSET ball_annulus ==> (FINITE S /\ (CARD S) <= n)`,

  (* {{{ proof *)
  [
SUBGOAL_THEN `ball_annulus SUBSET ball((vec 0),(&2 * h0 + &1))` ASSUME_TAC;
REWRITE_TAC [Pack_defs.ball_annulus;cball;ball;SUBSET;DIFF;IN_ELIM_THM];
REAL_ARITH_TAC ;
MP_TAC (SPEC `&2 * h0 + &1` card_packing_ball);
ANTS_TAC;
REWRITE_TAC [Sphere.h0];
REAL_ARITH_TAC ;
REPEAT STRIP_TAC ;
EXISTS_TAC `n:num`;
GEN_TAC ;
STRIP_TAC ;
FIRST_X_ASSUM (MATCH_MP_TAC);
ASM_MESON_TAC [SUBSET_TRANS]
  ]);;
  (* }}} *)

(* Almost identical to
Packing3.REAL_FINITE_MAX_EXISTS 
*)

let FINITE_MAX_EXISTS = 
prove_by_refinement(
  `!(s:num->bool). ~(s = {}) /\ FINITE s ==>
    (?a. (s a) /\ (!b. s b ==> (b <= a)))`,

  (* {{{ proof *)
  [
  REPEAT STRIP_TAC;
  MP_TAC (SPEC `(<):num->num->bool` (INST_TYPE [(`:num`,`:A`)]TOPOLOGICAL_SORT));
  ANTS_TAC;
    BY(ARITH_TAC);
  REWRITE_TAC [HAS_SIZE];
  DISCH_THEN (MP_TAC o (SPECL [`CARD (s:num->bool)`;`(s:num->bool)`]));
  ASM_REWRITE_TAC [];
  REPEAT STRIP_TAC;
  EXISTS_TAC `(f:num->num) (CARD (s:num->bool))`;
  HASH_UNDISCH_TAC 3729;
  TYPED_ABBREV_TAC `c = CARD (s:num->bool)`;
  DISCH_THEN SUBST1_TAC;
  REWRITE_TAC [IMAGE;IN_ELIM_THM];
  CONJ_TAC;
    EXISTS_TAC `c:num`;
    REWRITE_TAC [IN_NUMSEG];
    BY(ASM_MESON_TAC [ARITH_RULE `~(c = 0) ==> (1 <= c) /\ (c <= c)`;CARD_EQ_0]);
  REPEAT STRIP_TAC;
  HASH_RULE_TAC 6034 (REWRITE_RULE[ARITH_RULE `~((a:num) < b) <=> (b <= a)`]);
  ASM_REWRITE_TAC [];
  ASM_CASES_TAC `(x = c:num)`;
    ASM_REWRITE_TAC [];
    BY(ARITH_TAC);
  DISCH_THEN MATCH_MP_TAC;
  HASH_UNDISCH_TAC 3080;
  HASH_UNDISCH_TAC 2978;
  HASH_UNDISCH_TAC 8866;
  REWRITE_TAC [IN_NUMSEG];
  ASM_MESON_TAC [ARITH_RULE `~(c = 0) ==> (1 <= c) /\ (c <= c) /\ (~(x=c) /\ (x <= c) ==> x < c)`;CARD_EQ_0]
  ]);;
  (* }}} *)

let NOT_EMPTY_IMAGE = 
prove
( ` !(S:A -> bool) (f:A->B). ~( S = {}) ==> ~( IMAGE f S = {})`,
 SET_TAC[]);;
let PACKING_INSERT = 
prove_by_refinement(
  `!v S. packing S /\ ~(S v) /\ (!w. S w ==> (&2 <= dist(v,w))) ==> (packing (v INSERT S))`,

  (* {{{ proof *)
  [
REWRITE_TAC [Sphere.packing;INSERT;IN;IN_ELIM_THM];
MESON_TAC [DIST_SYM]
  ]);;
  (* }}} *)

let weak_saturation = 
prove_by_refinement(
  `!W S r. &2 <= r /\ r <= &2 * h0 /\ S SUBSET W /\ packing W /\ W SUBSET ball_annulus 
    /\ (!v w. S v /\ W w /\ dist(v,w) < r ==> (v = w)  ) ==>
    (?V. V SUBSET ball_annulus /\ packing V /\ 
      weakly_saturated V r (&2 * h0) /\ FINITE V /\ (W SUBSET V) /\
       (!v w. S v /\ V w /\ dist(v,w)< r ==> (v = w)))
       `,

  (* {{{ proof *)
  [
REPEAT STRIP_TAC ;
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) ) }`;
SUBGOAL_THEN `(WW (W:real^3->bool)):bool` ASSUME_TAC;
EXPAND_TAC "WW";
REWRITE_TAC [IN_ELIM_THM];
ASM_REWRITE_TAC [SUBSET_REFL];
SUBGOAL_THEN `?n. !V. ((WW (V:real^3->bool)):bool) ==> FINITE V /\  CARD V <= n` (fun t -> MP_TAC t THEN STRIP_TAC);
EXPAND_TAC "WW";
REWRITE_TAC [IN_ELIM_THM];
MP_TAC card_packing_annulus;
STRIP_TAC ;
EXISTS_TAC `n:num`;
GEN_TAC ;
ASM_MESON_TAC [];
SUBGOAL_THEN `FINITE (IMAGE CARD (WW:(real^3->bool)->bool))` (MP_TAC);
MATCH_MP_TAC FINITE_SUBSET;
EXISTS_TAC `{ k | k <= (n:num)}`;
REWRITE_TAC [FINITE_NUMSEG_LE];
REWRITE_TAC [IMAGE;SUBSET;IN_ELIM_THM;IN];
ASM_MESON_TAC [];
DISCH_TAC ;
SUBGOAL_THEN `~(IMAGE CARD (WW:(real^3->bool)->bool) = {})` ASSUME_TAC;
MATCH_MP_TAC NOT_EMPTY_IMAGE;
REWRITE_TAC [GSYM MEMBER_NOT_EMPTY;IN];
ASM_MESON_TAC [];
SUBGOAL_THEN `(?a. ((IMAGE CARD (WW:(real^3->bool)->bool)) a) /\ (!b. (IMAGE CARD WW) b ==> (b <= a)))` MP_TAC;
MATCH_MP_TAC FINITE_MAX_EXISTS;
ASM_REWRITE_TAC [ETA_AX];
REWRITE_TAC [IMAGE;IN_ELIM_THM;IN];
REPEAT STRIP_TAC ;
EXISTS_TAC `x:real^3->bool`;
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);
ASM_SIMP_TAC [];
HASH_UNDISCH_TAC 2672 ;
EXPAND_TAC "WW";
REWRITE_TAC [IN_ELIM_THM;IN];
MESON_TAC [];
ASM_REWRITE_TAC [Tarjjuw.weakly_saturated];
REPEAT STRIP_TAC ;
REWRITE_TAC [IN];
ASM_CASES_TAC `(x (v:real^3)):bool`;
EXISTS_TAC `v:real^3`;
ASM_REWRITE_TAC [];
CONJ_TAC ;
DISCH_TAC ;
HASH_UNDISCH_TAC 7486 ;
ASM_REWRITE_TAC [DIST_REFL];
REAL_ARITH_TAC ;
ASM_REWRITE_TAC [DIST_REFL];
ASM_REAL_ARITH_TAC;
MATCH_MP_TAC (MESON[] `( (!u. x u ==> ~(b u)) ==> F) ==> (?u. x u /\ b u)`);
DISCH_TAC ;
TYPED_ABBREV_TAC `y = (v:real^3) INSERT x`;
SUBGOAL_THEN `!u. x (u:real^3) ==> r <= dist (u,v)` ASSUME_TAC;
REPEAT STRIP_TAC ;
HASH_RULE_TAC 3271 (SPEC `u:real^3`);
ASM_REWRITE_TAC [DE_MORGAN_THM];
DISCH_THEN DISJ_CASES_TAC;
HASH_UNDISCH_TAC 1666 ;
HASH_UNDISCH_TAC 7625 ;
EXPAND_TAC "u";
REWRITE_TAC [SUBSET;Pack_defs.ball_annulus;DIFF;IN;ball;IN_ELIM_THM];
MESON_TAC [DIST_REFL;REAL_ARITH `(&0 < &2)`];
ASM_REAL_ARITH_TAC ;
ASM_CASES_TAC `CARD (y:(real^3->bool)) <= CARD (x:(real^3->bool))`;
HASH_UNDISCH_TAC 3148 ;
HASH_UNDISCH_TAC 7827 ;
EXPAND_TAC "y";
HASH_UNDISCH_TAC 4093 ;
SIMP_TAC [CARD_CLAUSES;IN];
STRIP_TAC ;
STRIP_TAC ;
MESON_TAC [Hypermap.LT_PLUS;ARITH_RULE `~(x <= y) <=> y < (x:num)`];
HASH_UNDISCH_TAC 9017 ;
HASH_UNDISCH_TAC 5378 ;
ASM_REWRITE_TAC [];
DISCH_THEN (MATCH_MP_TAC);
EXISTS_TAC `y:real^3->bool`;
REWRITE_TAC [];
EXPAND_TAC "WW";
REWRITE_TAC [IN_ELIM_THM];
SUBGOAL_THEN `!w. (y w <=> (x w \/ (w = (v:real^3))))` ASSUME_TAC;
GEN_TAC ;
HASH_UNDISCH_TAC 3490 ;
ONCE_REWRITE_TAC [FUN_EQ_THM];
REWRITE_TAC [INSERT;IN_ELIM_THM;IN];
MESON_TAC [];
SUBGOAL_THEN `W SUBSET (y:real^3->bool)` ASSUME_TAC;
HASH_UNDISCH_TAC 7323 ;
HASH_UNDISCH_TAC 646 ;
REWRITE_TAC [SUBSET;IN];
MESON_TAC [];
ASM_REWRITE_TAC [];
SUBGOAL_THEN `packing (y:real^3->bool)` ASSUME_TAC;
EXPAND_TAC "y";
MATCH_MP_TAC PACKING_INSERT;
ASM_REWRITE_TAC [];
REPEAT STRIP_TAC ;
MATCH_MP_TAC REAL_LE_TRANS;
EXISTS_TAC `r:real`;
ASM_SIMP_TAC [];
ONCE_REWRITE_TAC [DIST_SYM];
ASM_SIMP_TAC [];
ASM_REWRITE_TAC [];
CONJ_TAC ;
EXPAND_TAC "y";
ASM_REWRITE_TAC [INSERT_SUBSET];
ASM_REWRITE_TAC [Pack_defs.ball_annulus;IN;DIFF;cball;ball;IN_ELIM_THM];
ASM_REAL_ARITH_TAC ;
REPEAT STRIP_TAC ;
FIRST_X_ASSUM MATCH_MP_TAC;
ASM_REWRITE_TAC [];
HASH_UNDISCH_TAC 8971 ;
ASM_REWRITE_TAC [];
HASH_RULE_TAC 7974 (SPEC `v':real^3`);
REWRITE_TAC [REAL_ARITH `x <= y <=> ~(y < x)`];
HASH_UNDISCH_TAC 7323 ;
HASH_UNDISCH_TAC 5872 ;
HASH_UNDISCH_TAC 5644 ;
REWRITE_TAC [SUBSET;IN;IN_ELIM_THM];
MESON_TAC []
  ]);;
  (* }}} *)

let RADIAL_NORM_LINEAR_INVARIANT = 
prove_by_refinement(
   `!(f:real^M->real^N) s r. linear f /\ (!x. norm (f x) = norm x ) /\ (!y. ?x. f x = y)
     ==> radial r (vec 0) (IMAGE f s) = radial r (vec 0) s`,

   (* {{{ proof *)
  [
  REWRITE_TAC [Sphere.radial; VECTOR_ADD_LID ];
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC (TAUT `(a <=> b) /\( (a <=> b) ==> (c <=>d)) ==> (a /\ c <=> b /\ d)`);
  STRIP_TAC;
    REWRITE_TAC [Trigonometry1.DIST_L_ZERO;ball;SUBSET;IMAGE;IN_ELIM_THM];
    BY(ASM_MESON_TAC[]);
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC[Geomdetail.EQ_EXPAND];
  CONJ_TAC;
    REPEAT WEAK_STRIP_TAC;
    HASH_RULE_TAC 7266 (SPEC `(f:real^M->real^N) u`);
    REWRITE_TAC[IN;IMAGE;IN_ELIM_THM];
    ANTS_TAC;
      BY(ASM_MESON_TAC[IN]);
    STRIP_TAC;
    HASH_RULE_TAC 503 (SPEC `(t:real)`);
    ASM_REWRITE_TAC[];
    REPEAT WEAK_STRIP_TAC;
    SUBGOAL_THEN `x = t % (u:real^M)` MP_TAC;
      BY(ASM_MESON_TAC[linear;PRESERVES_NORM_INJECTIVE;IN]);
    BY(ASM_MESON_TAC[IN]);
  REPEAT WEAK_STRIP_TAC;
  HASH_UNDISCH_TAC 662;
  REWRITE_TAC[IN;IMAGE;IN_ELIM_THM];
  WEAK_STRIP_TAC;
  BY(ASM_MESON_TAC[IN;linear])
  ] );;
  (* }}} *)

let linear_inter_normball = 
prove_by_refinement(
  `!(f:real^M->real^N) s r. linear f /\ (!x. norm (f x) = norm x ) ==>
   ( IMAGE f s INTER normball (vec 0) r = IMAGE f (s INTER normball (vec 0) r))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  ONCE_REWRITE_TAC[FUN_EQ_THM];
  GEN_TAC;
  REWRITE_TAC[IMAGE;INTER;normball;DIST_0;IN;IN_ELIM_THM];
  Tactics_jordan.NAME_CONFLICT_TAC;
  BY(ASM_MESON_TAC[])
  ]);;
  (* }}} *)

let sol0_linear = 
prove_by_refinement(
  `!(f:real^3->real^3) s.  linear f /\ (!x. norm (f x) = norm x) /\  (!y. ?x. f x = y)==>
    ( (?r. r > &0 /\
         measurable (IMAGE f s INTER normball (vec 0) r) /\
         radial r (vec 0) (IMAGE f s INTER normball (vec 0) r)) <=>
   (?r. r > &0 /\
         measurable (s INTER normball (vec 0) r) /\
         radial r (vec 0) (s INTER normball (vec 0) r)))`,

  (* {{{ proof *)
  [
  BY(ASM_MESON_TAC[linear_inter_normball;RADIAL_NORM_LINEAR_INVARIANT;PRESERVES_NORM_INJECTIVE;MEASURABLE_LINEAR_IMAGE_EQ])
  ]);;
  (* }}} *)

let sol0_linear_r = 
prove_by_refinement(
  `!(f:real^3->real^3) s r.  linear f /\ (!x. norm (f x) = norm x) /\  (!y. ?x. f x = y) /\ (r > &0) ==>
    (( 
         measurable (IMAGE f s INTER normball (vec 0) r) /\
         radial r (vec 0) (IMAGE f s INTER normball (vec 0) r)) <=>
   ( 
         measurable (s INTER normball (vec 0) r) /\
         radial r (vec 0) (s INTER normball (vec 0) r)))`,

  (* {{{ proof *)
  [
  BY(ASM_MESON_TAC[linear_inter_normball;RADIAL_NORM_LINEAR_INVARIANT;PRESERVES_NORM_INJECTIVE;MEASURABLE_LINEAR_IMAGE_EQ])
  ]);;
  (* }}} *)

let dropout_pad2d3d = 
prove_by_refinement(
  `!x. dropout 3 (pad2d3d x) = x`,

  (* {{{ proof *)
  [
  ONCE_REWRITE_TAC[CART_EQ];
  REWRITE_TAC[dropout;pad2d3d];
  REPEAT WEAK_STRIP_TAC;
  ASM_SIMP_TAC[LAMBDA_BETA;DIMINDEX_2;DIMINDEX_3];
  ASSUME_TAC (ARITH_RULE `i <= 2==> i<3` );
  SUBGOAL_THEN `i + 1 <= dimindex(:3) /\ i <= dimindex(:3)` ASSUME_TAC;
    BY(ASM_MESON_TAC[DIMINDEX_3;DIMINDEX_2;ARITH_RULE `i<=2 ==> i+1 <= 3 /\ i <= 3`]);
  COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA;DIMINDEX_2;DIMINDEX_3];
  BY(ASM_MESON_TAC[DIMINDEX_3;DIMINDEX_2])
  ]);;
  (* }}} *)

let pad2d3d_dropout = 
prove_by_refinement(
  `!x . (x$3= &0) ==> (pad2d3d (dropout 3 x) = x)`,

  (* {{{ proof *)
  [
  ONCE_REWRITE_TAC[CART_EQ];
  REWRITE_TAC[dropout;pad2d3d];
  REPEAT WEAK_STRIP_TAC;
  ASM_SIMP_TAC[LAMBDA_BETA;DIMINDEX_2;DIMINDEX_3];
  COND_CASES_TAC;
    BY(ASM_SIMP_TAC[LAMBDA_BETA;DIMINDEX_2;DIMINDEX_3;ARITH_RULE `i < 3 ==> i<= 2`]);
  BY(ASM_MESON_TAC[DIMINDEX_3;ARITH_RULE `~(i<3) /\ (i <= 3) ==> (i=3)`])
  ]);;
  (* }}} *)

let pad2d3d_dropout_lemma = 
prove_by_refinement(
  `!(A:A->bool) P h . (!x.  x IN A ==> P x) /\ (!x. P x ==> h x = x) ==> 
    (IMAGE h A = A)`,

  (* {{{ proof *)
  [
    SET_TAC[]
  ]);;
  (* }}} *)

let pad2d3d_dot_v = 
prove_by_refinement(
  `!x y.  (pad2d3d x dot pad2d3d y = x dot y)`,

  (* {{{ proof *)
  [
  BY(ASM_SIMP_TAC[GSYM LINEAR_SUB;LINEAR_PAD2D3D;DOT_NORM_NEG;NORM_PAD2D3D])
  ]);;
  (* }}} *)

let pad_in = 
prove_by_refinement(
  `!x A. (!u. u IN A ==> u$3 = &0) ==> ((pad2d3d x IN A) <=> (x IN (IMAGE (dropout 3) A)))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC[IN;IN_ELIM_THM;IMAGE];
  BY(ASM_MESON_TAC[dropout_pad2d3d;pad2d3d_dropout;IN])
  ]);;
  (* }}} *)

let pad2d3d_facet = 
prove_by_refinement(
  `!P n. polyhedron (P:real^3->bool) /\ 
    (!u. u IN P ==> u$3 = &0) /\ { c | c facet_of P } HAS_SIZE n ==>
    {d | (d:real^2->bool) facet_of (IMAGE (dropout 3) P) } HAS_SIZE n`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC (ISPEC `{c | c facet_of (P:real^3->bool)}` BIJECTIONS_HAS_SIZE);
  ASM_REWRITE_TAC[IN_ELIM_THM];
  EXISTS_TAC `(IMAGE (dropout 3)): (real^3->bool)->real^2->bool`;
  EXISTS_TAC `(IMAGE (pad2d3d)): (real^2->bool)->real^3->bool`;
  REWRITE_TAC[GSYM IMAGE_o];
  SUBGOAL_THEN `!(A:real^3->bool). (A SUBSET P) ==> IMAGE(pad2d3d o dropout 3) A = A` ASSUME_TAC;
    HASH_UNDISCH_TAC 5723;
    REWRITE_TAC[IMAGE;IMAGE_o;SUBSET;IN_ELIM_THM];
    BY(SET_TAC[pad2d3d_dropout]);
  SUBGOAL_THEN `!(B:real^2->bool). IMAGE (dropout 3 o pad2d3d) B = B` ASSUME_TAC;
    REWRITE_TAC[IMAGE;IMAGE_o;SUBSET;IN_ELIM_THM];
    BY(SET_TAC[dropout_pad2d3d]);
  REPEAT STRIP_TAC;
        SUBGOAL_THEN `IMAGE pad2d3d (IMAGE (dropout 3) (x:real^3->bool)) facet_of (IMAGE pad2d3d (IMAGE (dropout 3) (P:real^3->bool)))` MP_TAC;
          REWRITE_TAC[GSYM IMAGE_o];
          BY(ASM_MESON_TAC[FACET_OF_IMP_SUBSET;SUBSET_REFL]);
        BY(ASM_MESON_TAC[FACET_OF_LINEAR_IMAGE;PRESERVES_NORM_INJECTIVE;LINEAR_PAD2D3D;NORM_PAD2D3D]);
      BY(ASM_MESON_TAC[FACET_OF_IMP_SUBSET]);
    BY(ASM_MESON_TAC[SUBSET_REFL;IMAGE_o;FACET_OF_LINEAR_IMAGE;PRESERVES_NORM_INJECTIVE;LINEAR_PAD2D3D;NORM_PAD2D3D]);
  BY(ASM_MESON_TAC[])
   ]);;
  (* }}} *)

let ARG_SCALE = 
prove_by_refinement(
  `!u w r. (&0 < r) ==> (Arg ((Cx r * u)/w) = Arg (u/w)) /\ (Arg (u/ (Cx r * w)) = Arg (u/w)) `,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  ASM_CASES_TAC `w = Cx (&0)`;
    BY(ASM_REWRITE_TAC[complex_div;COMPLEX_MUL_RZERO;COMPLEX_MUL_LZERO;COMPLEX_INV_0]);
  SUBGOAL_THEN `~(Cx r * w = Cx(&0))` ASSUME_TAC;
    BY(ASM_SIMP_TAC[COMPLEX_ENTIRE;CX_INJ;REAL_ARITH `&0 < r ==> ~(r = &0)`]);
  ASM_SIMP_TAC [Ysskqoy.ARG_CNJ;CNJ_CX;CNJ_MUL];
  BY(ASM_MESON_TAC[ARG_MUL_CX;COMPLEX_MUL_AC])
  ]);;
  (* }}} *)

let complex_frac_cancel = 
prove_by_refinement(
  `!a b (c:complex).  ~(b = Cx (&0)) ==> (a/b)/(c/b) = a / c`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  ONCE_REWRITE_TAC[ complex_div];
  REWRITE_TAC[COMPLEX_INV_DIV];
  REWRITE_TAC[complex_div];
  MATCH_MP_TAC (prove(`(b' * b) *(a * (c:complex)) = d ==> (a * b' ) * (b * c) = d`,SIMPLE_COMPLEX_ARITH_TAC));
  BY(ASM_SIMP_TAC[COMPLEX_MUL_LINV;COMPLEX_MUL_LID])
  ]);;
  (* }}} *)


let REAL_CX0 = 
prove_by_refinement(
  `!z. real z /\ Re z = &0 ==> (z = Cx (&0))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  BY(ASM_MESON_TAC[COMPLEX_NORM_ZERO;REAL_NORM;REAL_ARITH `abs (&0) = &0`])
  ]);;
  (* }}} *)


let ARG_INV_ALT = 
prove_by_refinement(
  `!u x y. ~(u = Cx (&0)) /\ ~(x = Cx(&0)) /\ ~(y = Cx(&0)) /\ ~(Arg (x/u) = Arg(y/u)) 
  ==> (Arg(x/y) = &2*pi - Arg(y/x))`,

  (* {{{ proof *)
  [
  REPEAT STRIP_TAC;
  MP_TAC (SPEC `(y/(x:complex))` ARG_INV);
  REWRITE_TAC[COMPLEX_INV_DIV];
  DISCH_THEN MATCH_MP_TAC;
  REPEAT WEAK_STRIP_TAC;
  HASH_UNDISCH_TAC 5488;
  REWRITE_TAC[];
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  ASM_SIMP_TAC[ARG_EQ;Ysskqoy.ARG_0_DIV];
  EXISTS_TAC `Re (y/x)`;
  SUBCONJ_TAC;
    MATCH_MP_TAC (REAL_ARITH `&0 <= x /\ ~(x = &0) ==> &0 < x`);
    REPEAT STRIP_TAC;
      BY(ASM_REWRITE_TAC[]);
    MP_TAC (SPEC `(y:complex/x)` REAL_CX0);
    BY(ASM_SIMP_TAC[Ysskqoy.ARG_0_DIV]);
  HASH_RULE_TAC 3423 (REWRITE_RULE[REAL]);
  DISCH_THEN SUBST1_TAC;
  DISCH_TAC;
  REWRITE_TAC[ complex_div];
  MATCH_MP_TAC (prove(`d=(b' *b)*(a*c) ==> d = (a *b')*b * (c:complex)`,SIMPLE_COMPLEX_ARITH_TAC));
  BY(ASM_SIMP_TAC[COMPLEX_MUL_LINV;COMPLEX_MUL_LID])
  ]);;
  (* }}} *)

let ARG_ORDER = 
prove_by_refinement(
  `!u h n. 
    ~(u = Cx (&0)) /\
    (!i. (i IN 1..n) ==> ~(h i = Cx (&0))) /\
     (!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) ==>
    (!i j. (i IN 1..n) /\ (j IN 1..n) /\ ~(i=j) ==> Arg (h (i+1) / h i) <= Arg (h j/ h i))
     `,

  (* {{{ proof *)
  [
  REWRITE_TAC[ARITH_RULE `~(i = j) <=> (i < j) \/ (j < (i:num))`];
  REPEAT GEN_TAC;
  REPEAT DISCH_TAC;
  SUBGOAL_THEN `!i. i IN 1..n ==> ~(h (i+1) = Cx (&0))` ASSUME_TAC;
    REPEAT WEAK_STRIP_TAC;
    ASM_CASES_TAC `i=(n:num)`;
      BY(ASM_MESON_TAC[IN_NUMSEG;ARITH_RULE `((n=0) ==> ~(1 <= n)) /\ (~(n=0) ==> (1 <= 1 /\ 1 <= n))`]);
    BY(ASM_MESON_TAC[IN_NUMSEG;ARITH_RULE `~(i=n) /\ (i <= n) /\ (1 <= i) ==> (1 <= (i+1) /\ (i+1) <= n)`]);
  REPEAT (FIRST_X_ASSUM MP_TAC);
  REPEAT WEAK_STRIP_TAC;
    FIRST_ASSUM (fun t -> MP_TAC (SPECL [`i+1`;`j:num`] t));
    FIRST_X_ASSUM (fun t -> MP_TAC (SPECL [`i:num`;`(i+1):num`] t));
    ANTS_TAC;
      BY(ASM_MESON_TAC[IN_NUMSEG;ARITH_RULE `i < i + 1`;ARITH_RULE `(i < j /\ j <=n ==> i+1 <=n)/\ (1 <= i+1)`]);
    DISCH_TAC;
    ASM_REWRITE_TAC[];
    DISCH_TAC;
    SUBGOAL_THEN `Arg (h (i+1) / u) <= Arg (h j / u)` ASSUME_TAC;
      ASM_CASES_TAC `i+1 < j`;
        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)`]);
      BY(ASM_MESON_TAC[ARITH_RULE `i < j /\ ~(i+1 < j) ==> (i+1=j)`;REAL_ARITH `a <= a`]);
    SUBGOAL_THEN `Arg (h (i+1)/ u) = Arg (h i/ u) + Arg ((h(i+1)/u)/(h (i:num)/u))` MP_TAC;
      MATCH_MP_TAC ARG_LE_DIV_SUM;
      ASM_SIMP_TAC[Ysskqoy.ARG_0_DIV];
      HASH_UNDISCH_TAC 6821;
      BY(REAL_ARITH_TAC);
    ASM_SIMP_TAC [complex_frac_cancel];
    DISCH_TAC;
    SUBGOAL_THEN `Arg (h (j:num)/u) = Arg (h i/u) + Arg( (h j/u)/(h i/u))` MP_TAC;
      MATCH_MP_TAC ARG_LE_DIV_SUM;
      ASM_SIMP_TAC[Ysskqoy.ARG_0_DIV];
      REPEAT (FIRST_X_ASSUM MP_TAC);
      BY(REAL_ARITH_TAC);
    ASM_SIMP_TAC [complex_frac_cancel];
    REPEAT (FIRST_X_ASSUM MP_TAC);
    BY(REAL_ARITH_TAC);
  COMMENT "1 goal: case j<i";
  ASM_CASES_TAC `i = (n:num)`;
    SUBGOAL_THEN `Arg (h i/ u) = Arg (h 1 / u) + Arg ((h i/u)/(h 1 /u))` MP_TAC;
      MATCH_MP_TAC ARG_LE_DIV_SUM;
      ASM_SIMP_TAC[Ysskqoy.ARG_0_DIV];
      CONJ_TAC;
        BY(ASM_MESON_TAC[]);
      ASM_CASES_TAC `n=1`;
        ASM_REWRITE_TAC[];
        BY(REAL_ARITH_TAC);
      MATCH_MP_TAC (arith `a:real < b ==> a <= b`);
      FIRST_X_ASSUM MATCH_MP_TAC;
      HASH_UNDISCH_TAC 88;
      ASM_REWRITE_TAC[];
      REWRITE_TAC[IN_NUMSEG];
      HASH_UNDISCH_TAC 4;
      BY(ARITH_TAC);
    ASM_SIMP_TAC [complex_frac_cancel];
    SUBGOAL_THEN `Arg (h (i:num)/u) = Arg( h j/u) + (Arg ((h i/u)/(h j/u)))` MP_TAC;
      MATCH_MP_TAC ARG_LE_DIV_SUM;
      ASM_SIMP_TAC[Ysskqoy.ARG_0_DIV];
      BY(ASM_MESON_TAC[arith `(a:real < b) ==> (a <= b)`]);
    ASM_SIMP_TAC [complex_frac_cancel];
    DISCH_TAC;
    SUBGOAL_THEN `Arg (h 1/u) <= Arg (h j /u)` MP_TAC;
      ASM_CASES_TAC `j = 1`;
        ASM_REWRITE_TAC[];
        BY(REAL_ARITH_TAC);
      MATCH_MP_TAC (arith `a:real < b ==> a <= b`);
      FIRST_X_ASSUM MATCH_MP_TAC;
      BY(ASM_MESON_TAC[IN_NUMSEG;arith `1 <=1`;arith `1 <=j /\ ~(j=1)==> (1 < j)`]);
    REPEAT WEAK_STRIP_TAC;
    MP_TAC (SPECL [`u:complex`;`(h 1):complex`;`(h:num->complex) n`] ARG_INV_ALT);
    ANTS_TAC;
      CONJ_TAC;
        BY(ASM_MESON_TAC[]);
      CONJ_TAC;
        BY(ASM_MESON_TAC[]);
      CONJ_TAC;
        BY(ASM_MESON_TAC[]);
      MATCH_MP_TAC (arith `(a:real < b) ==> ~(a = b)`);
      FIRST_X_ASSUM MATCH_MP_TAC;
      REPEAT (FIRST_X_ASSUM MP_TAC);
      REWRITE_TAC[IN_NUMSEG];
      BY(ARITH_TAC);
    DISCH_TAC;
    MP_TAC (SPECL [`u:complex`;`(h (j:num)):complex`;`(h:num->complex) i`] ARG_INV_ALT);
    ANTS_TAC;
      CONJ_TAC;
        BY(ASM_MESON_TAC[]);
      CONJ_TAC;
        BY(ASM_MESON_TAC[]);
      CONJ_TAC;
        BY(ASM_MESON_TAC[]);
      MATCH_MP_TAC (arith `(a:real < b) ==> ~(a = b)`);
      BY(ASM_SIMP_TAC[]);
    REPEAT (FIRST_X_ASSUM MP_TAC);
    REPLICATE_TAC 8 (DISCH_TAC);
    DISCH_THEN SUBST1_TAC;
    BY(REAL_ARITH_TAC);
  COMMENT "last case";
  SUBGOAL_THEN `i+1 <=n /\ i+1 IN 1..n` MP_TAC;
    REPEAT (FIRST_X_ASSUM MP_TAC);
    REWRITE_TAC[IN_NUMSEG];
    BY(ARITH_TAC);
  REPEAT WEAK_STRIP_TAC;
  MP_TAC (SPECL [`u:complex`;`(h (i:num)):complex`;`(h:num->complex) j`] ARG_INV_ALT);
  ANTS_TAC;
    CONJ_TAC;
      BY(ASM_MESON_TAC[]);
    CONJ_TAC;
      BY(ASM_MESON_TAC[]);
    CONJ_TAC;
      BY(ASM_MESON_TAC[]);
    MATCH_MP_TAC (arith `(b:real < a) ==> ~(a = b)`);
    BY(ASM_SIMP_TAC[]);
  SUBGOAL_THEN `Arg (h (i+1)/u) = Arg (h i /u) + Arg ((h (i+1)/u)/(h i /u))` MP_TAC;
    MATCH_MP_TAC ARG_LE_DIV_SUM;
    ASM_SIMP_TAC[Ysskqoy.ARG_0_DIV];
    MATCH_MP_TAC (arith `a:real < b ==> a <= b`);
    FIRST_X_ASSUM MATCH_MP_TAC;
    ASM_REWRITE_TAC[];
    BY(ARITH_TAC);
  ASM_SIMP_TAC [complex_frac_cancel];
  SUBGOAL_THEN `Arg (h i/u) = Arg (h (j:num) /u) + Arg ((h i/u)/(h j /u))` MP_TAC;
    MATCH_MP_TAC ARG_LE_DIV_SUM;
    ASM_SIMP_TAC[Ysskqoy.ARG_0_DIV];
    MATCH_MP_TAC (arith `a:real < b ==> a <= b`);
    FIRST_X_ASSUM MATCH_MP_TAC;
    BY(ASM_REWRITE_TAC[]);
  ASM_SIMP_TAC [complex_frac_cancel];
  MP_TAC (ISPEC `(h:num->complex) j/ u` ARG);
  MP_TAC (ISPEC `(h:num->complex) (i+1)/ u` ARG);
  BY(REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let POLYSORT_BIJ2 = 
prove_by_refinement(
  `!P n s r u.
          s = {c | c facet_of P} /\
          bounded P /\
          polyhedron P /\
          &0 < r /\
          (!p. norm p < r ==> P p) /\
          ~(u = Cx (&0)) /\
          s HAS_SIZE n
          ==> (?f. s = IMAGE f (1..n) /\
                   BIJ f (1..n) s /\
                   (!i k. (i IN 1..n) /\ (k IN 1..n) /\ ~(i=k) ==> 
			 (Arg (facet_rep_a P (f (i+1))/facet_rep_a P (f i))) <=
	        (Arg (facet_rep_a P (f k)/ facet_rep_a P (f i)))) /\
		   (!i. i IN 1..n ==> Arg (facet_rep_a P (f (i+1)) / facet_rep_a P (f i)) < pi) /\
		   (f (n+1) = f 1) /\ 
                   (!j k.
                        j IN 1..n /\ k IN 1..n /\ j < k
                        ==> Arg (facet_rep_a P (f j) / u) <
                            Arg (facet_rep_a P (f k) / u)))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MP_TAC (SPECL[`P:real^2->bool`;`n:num`;`s:(real^2->bool)->bool`;`r:real`;`u:real^2`] POLY_SORT_BIJ);
  ASM_REWRITE_TAC[];
  REPEAT WEAK_STRIP_TAC;
  EXISTS_TAC `\i. if (i IN 1..n) then (f i) else ((f:num->(real^2->bool)) 1)`;
  BETA_TAC;
  SUBCONJ_TAC;
    HASH_UNDISCH_TAC 8348;
    REWRITE_TAC[IMAGE];
    DISCH_THEN SUBST1_TAC;
    ONCE_REWRITE_TAC[FUN_EQ_THM];
    REWRITE_TAC[IN_ELIM_THM];
    BY(MESON_TAC[]);
  DISCH_TAC;
  SUBCONJ_TAC;
    HASH_UNDISCH_TAC 8330;
    REWRITE_TAC[BIJ;INJ;SURJ;IN;IN_ELIM_THM];
    BY(MESON_TAC[]);
  DISCH_TAC;
  MATCH_MP_TAC (TAUT `c /\ d /\ a /\ b ==> a /\ b /\ c /\ d`);
  SUBGOAL_THEN `~(n+1 IN 1..n)` ASSUME_TAC;
    BY(REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC);
  SUBCONJ_TAC;
    BY(ASM_MESON_TAC[]);
  DISCH_TAC;
  SUBCONJ_TAC;
    BY(ASM_MESON_TAC[]);
  DISCH_TAC;
  SUBCONJ_TAC;
    REPEAT WEAK_STRIP_TAC;
    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);
    ANTS_TAC;
      ASM_SIMP_TAC[];
      REPEAT WEAK_STRIP_TAC;
      FIRST_X_ASSUM MP_TAC;
      REWRITE_TAC[];
      MATCH_MP_TAC facet_rep_nz;
      ASM_REWRITE_TAC[];
      HASH_UNDISCH_TAC 8330;
      REWRITE_TAC[BIJ;INJ;SURJ;IN_ELIM_THM];
      HASH_UNDISCH_TAC 6240;
      BY(MESON_TAC[]);
    BETA_TAC;
    DISCH_THEN MATCH_MP_TAC;
    BY(ASM_REWRITE_TAC[]);
  DISCH_TAC;
  COMMENT "down to last subgoal";
  REPEAT WEAK_STRIP_TAC;
  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);
  ASM_REWRITE_TAC[];
  ANTS_TAC;
    HASH_UNDISCH_TAC 8348;
    ONCE_REWRITE_TAC[FUN_EQ_THM];
    REWRITE_TAC[IMAGE;IN_ELIM_THM];
    BY(ASM_MESON_TAC[]);
  REPEAT WEAK_STRIP_TAC;
  SUBGOAL_THEN `?j. j IN 1..n /\ c' = (f j):real^2->bool` MP_TAC;
    HASH_RULE_TAC 8348 (REWRITE_RULE[FUN_EQ_THM]);
    REWRITE_TAC[IMAGE;IN_ELIM_THM];
    BY(ASM_MESON_TAC[]);
  REPEAT WEAK_STRIP_TAC;
  FIRST_X_ASSUM (fun t -> MP_TAC (SPECL [`i:num`;`j:num`] t));
  ASM_REWRITE_TAC[];
  ASM_CASES_TAC `i=j:num`;
    ASM_REWRITE_TAC[];
    HASH_UNDISCH_TAC 9883;
    ASM_REWRITE_TAC[];
    MATCH_MP_TAC (arith `(b = &0) ==> (&0 < b ==> a)`);
    REWRITE_TAC[GSYM (SPEC `1` ARG_NUM)];
    AP_TERM_TAC;
    MATCH_MP_TAC COMPLEX_DIV_REFL;
    MATCH_MP_TAC facet_rep_nz;
    ASM_REWRITE_TAC[];
    HASH_UNDISCH_TAC 8330;
    REWRITE_TAC[BIJ;INJ;SURJ;IN_ELIM_THM];
    HASH_UNDISCH_TAC 7957;
    BY(MESON_TAC[]);
  ASM_REWRITE_TAC[];
  HASH_UNDISCH_TAC 3495;
  ASM_REWRITE_TAC[];
  BY(REAL_ARITH_TAC)
  ]);;
  (* }}} *)

(* ========================================================================== *)
(* EUSOTYP Lemmas *)

(* 
   The lemma is phrased in terms of Arg rather than polar cycle, because of
   a lack of good supporting libraries for polar cycle.

   The orthogonality conclusion (4) has been put into separate lemmas:
   COS_ARG_VECTOR_ANGLE relating Arg to vector_angle,
   SEC_DOT the orthogonality statement in terms of vector_angle.
*)
(* ========================================================================== *)

let EUSOTYP_concl_old =  `!(P:real^2 -> bool) s n r c0 u. polyhedron P /\ bounded P /\
    s = { c | c facet_of P } /\
    c0 facet_of P /\
    u = facet_rep_a P c0 /\ 
    s HAS_SIZE n /\
    (&0 < r ) /\
  (!p. norm p < r ==> P p) ==>
    (?(g:num->real^2). 
       (!i. i IN 1..(2 * n) ==> (P (g i)) /\ ~(g i = vec 0)) /\
       (!j k. j IN 1..(2 * n) /\ k IN 1..(2*n) /\ (j < k) ==> 
	  Arg ( g j/ u) < Arg (g k /  u)) /\
       (!l i j k psi. (l IN 1..n /\ i = 2 * l -1 /\ j = 2 *l /\ k = (2 * l +1) MOD (2*n)
	   /\ psi = Arg( (g k)/(g i) ) / &2)
	   ==> (norm (g i) = r) /\ 
            norm (g j) = r * inv (cos (psi)) /\
	   Arg (g j/ g i) = psi /\
	   Arg (g k/ g j) = psi /\
	       psi < pi/ &2 ))
	`;;

let EMPTY_NOT_EXISTS_IN = 
prove_by_refinement(
  `(a:A->bool) = {} <=> ~(?x. x IN a)`,

  (* {{{ proof *)
  [
  SET_TAC[]
  ]);;
  (* }}} *)

let EUSOTYP_simple = 
prove_by_refinement(
  `!(P:real^2->bool) s r n u2.
     (polyhedron P) /\ (bounded P) /\ (s = {c | c facet_of P}) /\ s HAS_SIZE n /\ 
    (&0 < r) /\ ~(u2 = vec 0) /\ (!p2. norm p2 < r ==> p2 IN P) ==> 
   (?g h.  (!i. i IN 1..n ==> g i IN P /\ norm (g i) = r) /\
          g (n + 1) = g 1 /\
     (!j k.           j IN 1..n /\ k IN 1..n /\ j < k
          ==> Arg ( (g j) / u2) < Arg ( (g k) / u2)) /\
    (!i. i IN 1..n ==> h i IN P /\
              norm (h i) = r * inv (cos (Arg ( (g (i + 1)) /  (g i)) / &2))) /\
     (!i. i IN 1..n
          ==> Arg ( (h i) /  (g i)) = Arg ( (g (i + 1)) /  (g i)) / &2 /\
              Arg ( (g (i + 1)) /  (h i)) = Arg ( (g (i + 1)) /  (g i)) / &2) /\
     (!i. i IN 1..n
          ==> g i dot (h i - g i) = &0 /\ g (i + 1) dot (h i - g (i + 1)) = &0) /\
      (1 < n) /\
     (!i. i IN 1..n ==> ~(g i = Cx(&0)))  /\
     (!i. i IN 1..n ==> ~(h i = Cx(&0))) /\
      (!i. (i IN 1..n ==> Arg ( g(i+1)/ g(i)) < pi)) )`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MP_TAC (SPECL [`P:real^2->bool`;`n:num`;`{ c | (c:real^2->bool) facet_of P}`;`r:real`;`u2:real^2`] POLYSORT_BIJ2);
  ASM_REWRITE_TAC[GSYM COMPLEX_VEC_0];
  ANTS_TAC;
    BY(BY(ASM_MESON_TAC[IN]));
  REPEAT WEAK_STRIP_TAC;
  EXISTS_TAC `\(i:num).  r % facet_rep_a P (f i)`;
  BETA_TAC;
  EXISTS_TAC `\(i:num).  bisector_point P (f i) (f (i+1)) r`;
  SUBGOAL_THEN `!i. i IN 1..n ==> (f i) facet_of (P:real^2->bool)` ASSUME_TAC;
    HASH_UNDISCH_TAC 8348;
    BY(BY(SET_TAC[]));
  SUBCONJ_TAC;
    ASM_SIMP_TAC[Trigonometry2.LT_IMP_ABS_REFL;NORM_MUL];
    REPEAT STRIP_TAC;
      REWRITE_TAC[IN];
      MATCH_MP_TAC facet_rep_in_poly;
      BY(BY(ASM_MESON_TAC[IN]));
    BY(BY(ASM_MESON_TAC[facet_rep_def;REAL_ARITH `r * &1 = r`]));
  DISCH_TAC;
  CONJ_TAC;
    BY(BY(ASM_REWRITE_TAC[]));
  BETA_TAC;
  SUBGOAL_THEN `!i. (i IN 1..n ==> ~(facet_rep_a P (f i) = Cx (&0)))` ASSUME_TAC;
    GEN_TAC;
    DISCH_TAC;
    MATCH_MP_TAC facet_rep_nz;
    ASM_REWRITE_TAC[];
    FIRST_X_ASSUM MATCH_MP_TAC;
    BY(BY(ASM_REWRITE_TAC[]));
  REWRITE_TAC[COMPLEX_CMUL];
  SUBGOAL_THEN `!v u. Arg(((Cx r)*v)/u) = Arg (v/u)` ASSUME_TAC;
    REPEAT GEN_TAC;
    BY(BY(ASM_SIMP_TAC[complex_div;ARG_MUL_CX;arith `((a:complex)*b) * c = a * b * c`]));
  ASM_SIMP_TAC[];
  SUBGOAL_THEN `!v u. Arg(v/(Cx r * u)) = Arg (v/u)` ASSUME_TAC;
    REPEAT GEN_TAC;
    ASM_SIMP_TAC[complex_div;COMPLEX_INV_MUL];
    BY(BY(ASM_SIMP_TAC[arith `(a:complex)*(inv (Cx t) * c) = (a * c)/(Cx t)`;ARG_DIV_CX]));
  ASM_SIMP_TAC[];
  COMMENT "three conjuncts left + 3 new ones";
  SUBGOAL_THEN `?x''. x'' facet_of (P:real^2->bool)` MP_TAC;
    COMMENT "new insert";
    SUBGOAL_THEN `?c. ~(c = {}) /\ ~(c = (P:real^2->bool)) /\ (c face_of P)` ASSUME_TAC;
      MP_TAC (ISPEC `P:real^2->bool` (REWRITE_RULE [GSYM FACE_OF_SING ] EXTREME_POINT_EXISTS_CONVEX ));
      ANTS_TAC;
        REWRITE_TAC[EMPTY_NOT_EXISTS_IN];
        BY(ASM_MESON_TAC[NORM_0; POLYTOPE_IMP_CONVEX ; POLYTOPE_IMP_COMPACT; POLYTOPE_EQ_BOUNDED_POLYHEDRON ]);
      REPEAT WEAK_STRIP_TAC;
      (fun gl -> (EXISTS_TAC ( env gl`{x}`)) gl);
      ASM_REWRITE_TAC[];
      CONJ_TAC;
        BY(SET_TAC[]);
      HASH_COPY_TAC 1412;
      FIRST_X_ASSUM (MP_TAC o (SPEC `Cx (r/ &2)`));
      FIRST_X_ASSUM (MP_TAC o (SPEC `Cx (&0)`));
      ASM_SIMP_TAC [ COMPLEX_NORM_CX; arith `&0 < r ==> abs(r/ &2) < r`;arith `&0 < r ==> abs(&0)<r`];
      HASH_UNDISCH_TAC 6412;
      BY(SET_TAC[ CX_INJ; arith `&0 < r ==> ~(&0 = r/ &2)`]);
    FIRST_X_ASSUM (MP_TAC);
    BY(ASM_MESON_TAC[FACE_OF_POLYHEDRON_SUBSET_FACET]);
  WEAK_STRIP_TAC;
  COMMENT "1 < n";
  SUBGOAL_THEN `1<n` ASSUME_TAC;
    PROOF_BY_CONTR_TAC;
    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;
      BY(BY(ASM_MESON_TAC[arith `~(1 < n) ==> (n=0) \/ (n = 1)`]));
    REWRITE_TAC[HAS_SIZE_1_EXISTS;HAS_SIZE_0];
    REWRITE_TAC[EXISTS_UNIQUE;IN_ELIM_THM;EMPTY_NOT_EXISTS_IN];
    REWRITE_TAC[DE_MORGAN_THM];
    ROT_TAC;
    CONJ_TAC;
      BY(ASM_MESON_TAC[]);
    MP_TAC (SPECL [`P:real^2->bool`;`(x'':real^2->bool)`;`r:real`] facet_arg_lt_pi);
    ANTS_TAC;
      ASM_REWRITE_TAC[];
      BY(BY(ASM_MESON_TAC[IN]));
    REPEAT WEAK_STRIP_TAC;
    (fun gl -> (SUBGOAL_THEN ( env gl`c' =x''`) MP_TAC) gl);
      BY(BY(ASM_MESON_TAC[]));
    DISCH_TAC;
    HASH_UNDISCH_TAC 9078;
    ASM_REWRITE_TAC[];
    SUBGOAL_THEN `~(facet_rep_a P x'' = Cx (&0))` MP_TAC;
      DISCH_TAC;
      BY(ASM_MESON_TAC[ facet_rep_def; COMPLEX_NORM_CX; arith `~(abs(&0) = &1)`]);
    SIMP_TAC[COMPLEX_DIV_REFL];
    REWRITE_TAC[ARG_NUM];
    BY(BY(REAL_ARITH_TAC));
  COMMENT "end 1 < n";
  ASM_REWRITE_TAC[];
  COMMENT "end 1 < n";
  COMMENT "end insert";
  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;
    GEN_TAC;
    DISCH_TAC;
    MATCH_MP_TAC bisector_point;
    ASM_REWRITE_TAC[];
    SUBCONJ_TAC;
      BY(BY(ASM_SIMP_TAC[]));
    DISCH_TAC;
    SUBCONJ_TAC;
      ASM_CASES_TAC `i+1 IN 1..n`;
        BY(BY(ASM_SIMP_TAC[]));
      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));
      ASM_REWRITE_TAC[];
      REPEAT WEAK_STRIP_TAC;
      ASM_REWRITE_TAC[];
      BY(BY(ASM_SIMP_TAC[]));
    DISCH_TAC;
    CONJ_TAC;
      BY(BY(ASM_MESON_TAC[IN]));
    REWRITE_TAC[arith `&2 * x / &2 = x`;arith `x / &2 < y / &2 <=> x < y`];
    ASM_SIMP_TAC[];
    SUBCONJ_TAC;
      REPEAT WEAK_STRIP_TAC;
      SUBGOAL_THEN `(?k. k IN 1..n /\ (c'' = (f:num->real^2->bool) k))` MP_TAC;
        HASH_UNDISCH_TAC 3856;
        HASH_UNDISCH_TAC 8330;
        REWRITE_TAC[BIJ;INJ;SURJ];
        BY(BY(SET_TAC[]));
      REPEAT WEAK_STRIP_TAC;
      BY(BY(ASM_MESON_TAC[arith `(a:real < b) ==> ~(b <= a)`]));
    DISCH_TAC;
    ASM_CASES_TAC `(i+1) IN 1..n`;
      BY(BY(ASM_MESON_TAC[arith `i < i+1`;arith `(a:real < b) ==> ~(a = b)`]));
    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));
    ASM_REWRITE_TAC[];
    REPEAT WEAK_STRIP_TAC;
    COMMENT "1 < n";
    BY(BY(ASM_MESON_TAC[arith `i < i+1`;arith `(a:real < b) ==> ~(a = b)`]));
  COMMENT "1 goal, 5 conjuncts, bisector point now read in ";
  ASM_SIMP_TAC[];
  CONJ_TAC;
    BY(BY(ASM_MESON_TAC[IN]));
  COMMENT "nonzero bisector";
  SUBGOAL_THEN `!i. (i IN 1..n) ==> ~(norm (bisector_point P (f i) (f (i+1)) r)  = &0)` MP_TAC;
    ASM_SIMP_TAC[REAL_ENTIRE;arith `&0 < r ==> ~(r = &0)`];
    REWRITE_TAC[REAL_INV_EQ_0];
    GEN_TAC;
    DISCH_TAC;
    MATCH_MP_TAC Taylor_atn.cos_nz;
    MATCH_MP_TAC (arith `&0 <= x /\ x < pi /\ (&0 < pi) ==>abs(x/ &2) < pi/ &2`);
    REWRITE_TAC[ARG;PI_POS];
    BY(BY(ASM_SIMP_TAC[]));
  REWRITE_TAC[COMPLEX_NORM_ZERO];
  DISCH_TAC;
  COMMENT "nonzero bisector";
  CONJ_TAC;
    GEN_TAC;
    DISCH_TAC;
    COMMENT "nonzero bisector was here";
    CONJ_TAC THEN MATCH_MP_TAC Ysskqoy.SEC_DOT THEN EXISTS_TAC `r:real`;
      EXISTS_TAC ` (Arg (facet_rep_a P (f (i + 1)) / facet_rep_a P (f i)) / &2)`;
      ASM_SIMP_TAC[];
      REWRITE_TAC[ARG;arith `&0 <= x/ &2 <=> &0 <= x`;COMPLEX_NORM_MUL;COMPLEX_NORM_CX;arith `x/ &2 < y/ &2 <=> x < y`];
      ASM_SIMP_TAC[Trigonometry2.LT_IMP_ABS_REFL;facet_rep_def;arith `r * &1 = r`];
      ONCE_REWRITE_TAC[VECTOR_ANGLE_SYM];
      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);
        MATCH_MP_TAC Ysskqoy.COS_ARG_VECTOR_ANGLE;
        BY(BY(ASM_SIMP_TAC[COMPLEX_ENTIRE;CX_INJ;arith `&0 < r ==> ~(r = &0)`]));
      AP_TERM_TAC;
      BY(BY(ASM_MESON_TAC[]));
    EXISTS_TAC ` (Arg (facet_rep_a P (f (i + 1)) / facet_rep_a P (f i)) / &2)`;
    ASM_SIMP_TAC[];
    REWRITE_TAC[ARG;arith `&0 <= x/ &2 <=> &0 <= x`;COMPLEX_NORM_MUL;COMPLEX_NORM_CX;arith `x/ &2 < y/ &2 <=> x < y`];
    SUBGOAL_THEN `(f (i+1)) facet_of (P:real^2->bool)` ASSUME_TAC;
      ASM_CASES_TAC `i+1 IN 1..n`;
        BY(BY(ASM_MESON_TAC[]));
      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));
      ASM_REWRITE_TAC[];
      BY(BY(ASM_MESON_TAC[]));
    ASM_SIMP_TAC[Trigonometry2.LT_IMP_ABS_REFL;facet_rep_def;arith `r * &1 = r`];
    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);
      MATCH_MP_TAC Ysskqoy.COS_ARG_VECTOR_ANGLE;
      ASM_SIMP_TAC[COMPLEX_ENTIRE;CX_INJ;arith `&0 < r ==> ~(r = &0)`];
      ASM_CASES_TAC `i+1 IN 1..n`;
        BY(BY(ASM_SIMP_TAC[]));
      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));
      BY(BY(ASM_MESON_TAC[]));
    AP_TERM_TAC;
    BY(BY(ASM_MESON_TAC[]));
  ROT_TAC;
  CONJ_TAC;
    BY(ASM_REWRITE_TAC[ COMPLEX_VEC_0 ]);
  GEN_TAC;
  DISCH_TAC;
  BY(ASM_SIMP_TAC[ COMPLEX_VEC_0 ; COMPLEX_ENTIRE ; CX_INJ ;arith `&0 < r ==> ~(r = &0)`])
  ]);;
  (* }}} *)

let pad2d3d_SUB = 
prove_by_refinement(
  `!x y. pad2d3d x - pad2d3d y = pad2d3d (x - y)`,

  (* {{{ proof *)
  [
 REPEAT GEN_TAC;
  REWRITE_TAC[VECTOR_ARITH `(u:real^A) - (v:real^A) = (u + (-- &1) % v)`];
  BY(MESON_TAC[LINEAR_PAD2D3D;linear])
  ]);;
  (* }}} *)


let EUSOTYP_general = 
prove_by_refinement(
  `!P A n s r u0 u1 u2. 
    polyhedron P /\ bounded P /\ P SUBSET A /\ 
    s = { c | c facet_of P } /\
    s HAS_SIZE n /\
    (&0 < r ) /\
    ~(u2= u0) /\ 
    ~(u1 = u0) /\
    (u0 IN P) /\  (u2 IN A) /\
    (!v. v IN A  <=> (v - u0) dot (u1 - u0) = &0) /\
    (!p. dist (p, u0) < r /\ p IN A ==> p IN P) ==>
    (?g h.
       (!i. i IN 1..n ==> ((g i ) IN P) /\ dist(g i , u0) = r) /\
       (g (n+1) = g 1) /\
       (!i. i IN 1..n ==> ((h i) IN P) /\ 
	  norm(h i - u0) = r* inv(cos ((azim u0 u1 (g i) (g (i+1)))/ &2))) /\     
       (!j k. j IN 1..n /\ k IN 1..n /\ (j < k) ==>  
	  azim u0 u1 u2 (g j) < azim u0 u1 u2 (g k)) /\ 
       (!i. i IN 1..n  ==>
	   azim u0 u1 (g i) (h i) = (azim u0 u1 (g i) (g (i+1)))/ &2  /\
	    azim u0 u1 (h i) (g (i+1)) = (azim u0 u1 (g i) (g (i+1)))/ &2) /\
      (!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))) /\
            (1 < n) /\
     (!i. i IN 1..n ==> ~(g i = u0))  /\
     (!i. i IN 1..n ==> ~(h i = u0)) /\
      (!i. (i IN 1..n ==> azim u0 u1 (g i) (g (i+1)) < pi)) 
      )`,

  (* {{{ proof *)
  [
  REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `u0:real^3`;
  REPEAT GEN_TAC THEN GEOM_BASIS_MULTIPLE_TAC 3 `u1:real^3`;
  X_GEN_TAC `u1:real`;
  GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`];
  STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO];
  ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; VECTOR_SUB_RZERO; DIST_0];
  ASM_SIMP_TAC[VECTOR_MUL_EQ_0; DOT_BASIS; DOT_RMUL; REAL_ENTIRE;BASIS_NONZERO; REAL_LT_IMP_NZ; DIMINDEX_3; ARITH];
  POP_ASSUM(K ALL_TAC);
  REWRITE_TAC[AZIM_ARG];
  REPEAT GEN_TAC;
  REPEAT DISCH_TAC;
  SUBGOAL_THEN `(u2:real^3)$3 = &0` (fun t-> (REPEAT (POP_ASSUM MP_TAC)) THEN MP_TAC t);
    BY(BY(ASM_MESON_TAC[]));
  SPEC_TAC (`u2:real^3`,`u2:real^3`);
  PAD2D3D_TAC;
  GEN_TAC;
  REPEAT WEAK_STRIP_TAC;
  SUBGOAL_THEN `!v. (v:real^3) IN P ==> v$3 = &0` ASSUME_TAC;
    HASH_UNDISCH_TAC 6277;
    HASH_UNDISCH_TAC 4709;
    BY(BY(SET_TAC[]));
  TYPED_ABBREV_TAC `(A':real^2->bool) = IMAGE(dropout 3) (A:real^3->bool)`;
  TYPED_ABBREV_TAC `(P':real^2->bool) = IMAGE(dropout 3) (P:real^3->bool)`;
  SUBGOAL_THEN `linear ((dropout 3):real^3->real^2)` ASSUME_TAC;
    MATCH_MP_TAC LINEAR_DROPOUT;
    REWRITE_TAC[DIMINDEX_2;DIMINDEX_3];
    BY(BY(ARITH_TAC));
  SUBGOAL_THEN `polyhedron P' /\ bounded P' /\ (!p2. norm (p2:real^2) < r ==> p2 IN P')` MP_TAC;
    EXPAND_TAC "P'";
    CONJ_TAC;
      MATCH_MP_TAC POLYHEDRON_LINEAR_IMAGE;
      BY(BY(ASM_REWRITE_TAC[]));
    CONJ_TAC;
      MATCH_MP_TAC BOUNDED_LINEAR_IMAGE;
      BY(BY(ASM_REWRITE_TAC[]));
    REPEAT WEAK_STRIP_TAC;
    ASM_SIMP_TAC [GSYM pad_in];
    FIRST_X_ASSUM MATCH_MP_TAC;
    ASM_REWRITE_TAC[NORM_PAD2D3D];
    SPEC_TAC (`p2:real^2`,`p2:real^2`);
    BY(BY(REWRITE_TAC[GSYM QUANTIFY_PAD2D3D_THM]));
  COMMENT "1 goal";
  REPEAT WEAK_STRIP_TAC;
  SUBGOAL_THEN `{d | (d:real^2->bool) facet_of P'} HAS_SIZE n` ASSUME_TAC;
    EXPAND_TAC "P'";
    MATCH_MP_TAC pad2d3d_facet;
    BY(BY(ASM_MESON_TAC[]));
  COMMENT "A";
  MP_TAC (SPECL [`P':real^2->bool`;`{d | d facet_of (P':real^2->bool)}`;`r:real`;`n:num`;`u2:real^2`] EUSOTYP_simple);
  ASM_SIMP_TAC[];
  REPEAT WEAK_STRIP_TAC;
  EXISTS_TAC `\(i:num). pad2d3d (g i)`;
  EXISTS_TAC `\(i:num). pad2d3d (h i)`;
  BETA_TAC;
  ASM_SIMP_TAC[dropout_pad2d3d;NORM_PAD2D3D;pad2d3d_dot_v;pad2d3d_SUB];
  SUBGOAL_THEN `!w. pad2d3d w IN P <=> w IN P'` ASSUME_TAC;
    GEN_TAC;
    BY(BY(ASM_MESON_TAC[pad_in]));
  BY(BY(ASM_MESON_TAC[pad_in; INJECTIVE_PAD2D3D ; COMPLEX_VEC_0 ]))
  ]);;
  (* }}} *)

let AZIM_SUM_LE = 
prove_by_refinement(
  `!x y z w1 w2 w3.
    ~(collinear {x,y,z}) /\ ~(collinear {x,y,w1}) /\ ~(collinear {x,y,w2}) /\
   ~(collinear {x,y,w3}) /\
    azim x y z w1 <= azim x y z w2 /\
    azim x y z w2 <= azim x y z w3 ==>
   (azim x y w1 w3 = azim x y w1 w2 + azim x y w2 w3)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  SUBGOAL_THEN `azim x y z w3 = azim x y z w1 + azim x y w1 w3` ASSUME_TAC;
    MATCH_MP_TAC Fan.sum4_azim_fan;
    ASM_REWRITE_TAC[];
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  SUBGOAL_THEN `azim x y z w2 = azim x y z w1 + azim x y w1 w2` ASSUME_TAC;
    MATCH_MP_TAC Fan.sum4_azim_fan;
    BY(ASM_REWRITE_TAC[]);
  SUBGOAL_THEN `azim x y z w3 = azim x y z w2 + azim x y w2 w3` ASSUME_TAC;
    MATCH_MP_TAC Fan.sum4_azim_fan;
    BY(ASM_REWRITE_TAC[]);
  BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let AZIM_NN = 
prove_by_refinement(
  `!x y z u. &0 <= azim x y z u`,

  (* {{{ proof *)
  [
  MESON_TAC[azim]
  ]);;
  (* }}} *)


let AZIM_BASE_SHIFT_LT = 
prove_by_refinement(
  `!x y z z' w1 w2 w3.
    ~(collinear {x,y,z}) /\ ~(collinear {x,y,z'}) /\ ~(collinear {x,y,w1}) /\
    ~(collinear {x,y,w2}) /\ ~(collinear {x,y,w3}) /\
    azim x y z w1 < azim x y z w2 /\
    azim x y z w2 < azim x y z w3 /\
    azim x y z' w1 < azim x y z' w3 ==>
   (azim x y z' w1 < azim x y z' w2 /\ azim x y z' w2 < azim x y z' w3)
`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  SUBGOAL_THEN `azim x y w1 w3 = azim x y w1 w2 + azim x y w2 w3` ASSUME_TAC;
    MATCH_MP_TAC AZIM_SUM_LE;
    EXISTS_TAC `z:real^3`;
    ASM_REWRITE_TAC[];
    BY((REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
  REWRITE_TAC[arith `a < b <=> ~(b <= a)`];
  CONJ_TAC THEN WEAK_STRIP_TAC;
    SUBGOAL_THEN `azim x y w2 w3 = azim x y w2 w1 + azim x y w1 w3` ASSUME_TAC;
      MATCH_MP_TAC AZIM_SUM_LE;
      EXISTS_TAC `z':real^3`;
      ASM_REWRITE_TAC[];
      BY((REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
    SUBGOAL_THEN `azim x y w1 w2 = &0 /\ azim x y w2 w1 = &0` (MP_TAC);
      BY(ASM_MESON_TAC[AZIM_NN;arith `a = b + c /\ c = e + a /\ &0 <= b /\ &0 <= e ==> (b = &0 /\ e = &0)`]);
    STRIP_TAC;
    SUBGOAL_THEN `azim x y z w2 = azim x y z w1 + azim x y w1 w2` ASSUME_TAC;
      MATCH_MP_TAC Fan.sum4_azim_fan;
      ASM_REWRITE_TAC[];
      BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  COMMENT "1 left";
  SUBGOAL_THEN `azim x y w1 w2 = azim x y w1 w3 + azim x y w3 w2` ASSUME_TAC;
    MATCH_MP_TAC AZIM_SUM_LE;
    EXISTS_TAC `z':real^3`;
    ASM_REWRITE_TAC[];
    BY((REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
  SUBGOAL_THEN `azim x y w2 w3 = &0 /\ azim x y w3 w2 = &0` (MP_TAC);
    BY(ASM_MESON_TAC[AZIM_NN;arith `a = b + c /\ b = a + c' /\ &0 <= c /\ &0 <= c' ==> (c = &0 /\ c' = &0)`]);
  STRIP_TAC;
  SUBGOAL_THEN `azim x y z w3 = azim x y z w2 + azim x y w2 w3` ASSUME_TAC;
    MATCH_MP_TAC Fan.sum4_azim_fan;
    ASM_REWRITE_TAC[];
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
  ]);;
  (* }}} *)


let AZIM_COMP_LT = 
prove_by_refinement(
  `!x y z u v. &0 < azim x y z u /\  azim x y z u < azim x y z v ==>
     azim x y v z < azim x y u z `,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  ONCE_REWRITE_TAC[Rogers.AZIM_COMPL_EXT];
  BY(REPEAT COND_CASES_TAC THEN (REPEAT (FIRST_X_ASSUM MP_TAC)) THEN REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let AZIM_COMP_LE = 
prove_by_refinement(
  `!x y z u v. &0 < azim x y z u /\  azim x y z u <= azim x y z v ==>
     azim x y v z <= azim x y u z `,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  ONCE_REWRITE_TAC[Rogers.AZIM_COMPL_EXT];
  BY(REPEAT COND_CASES_TAC THEN (REPEAT (FIRST_X_ASSUM MP_TAC)) THEN REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let AZIM_COMP2_LE = 
prove_by_refinement(
  `!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 ==>
     azim x y z v <= azim x y z u `,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  ONCE_REWRITE_TAC[Rogers.AZIM_COMPL_EXT];
  BY(REPEAT COND_CASES_TAC THEN (REPEAT (FIRST_X_ASSUM MP_TAC)) THEN REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let AZIM_COMP2_LT = 
prove_by_refinement(
  `!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 ==>
     azim x y z v < azim x y z u `,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  ONCE_REWRITE_TAC[Rogers.AZIM_COMPL_EXT];
  BY(REPEAT COND_CASES_TAC THEN (REPEAT (FIRST_X_ASSUM MP_TAC)) THEN REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let WEDGE_ORDER_DISJOINT = 
prove_by_refinement(
  `!x y z n g.
     ~(collinear {x,y,z}) /\
    (!i. i IN 1..n ==> ~(collinear {x,y, g i})) /\
     (g (n+1) = g 1) /\
        (!j k. j IN 1..n /\ k IN 1..n /\ (j < k) ==>  
	  azim x y z (g j) < azim x y z (g k))
    ==>
    (!j k. j IN 1..n /\ k IN 1..n /\ ~(j = k) ==>
       wedge x y (g j) (g (j+1)) INTER wedge x y (g k) (g (k+1)) = {})
	 `,

  (* {{{ proof *)
  [
  REPEAT GEN_TAC;
  DISCH_TAC;
  MATCH_MP_TAC WLOG_LT;
  REWRITE_TAC[];
  CONJ_TAC;
    BY(SET_TAC[]);
  GEN_TAC;
  X_GEN_TAC `k:num`;
  FIRST_X_ASSUM MP_TAC;
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC[FUN_EQ_THM];
  X_GEN_TAC `p:real^3`;
  REWRITE_TAC[INTER;IN_ELIM_THM;wedge;X_IN NOT_IN_EMPTY];
  REPEAT WEAK_STRIP_TAC;
  SUBGOAL_THEN `j + 1 IN 1..n` ASSUME_TAC;
    REPEAT (FIRST_X_ASSUM MP_TAC) THEN REWRITE_TAC[IN_NUMSEG];
    BY(ARITH_TAC);
  SUBGOAL_THEN `(azim x y z (g (j:num)) < azim x y z p)` ASSUME_TAC;
    REWRITE_TAC [arith `a <  b <=> ~(b <= a)`];
    WEAK_STRIP_TAC;
    (fun gl -> (MP_TAC (SPECL ( envl gl[`x`;`y`;`g j`;`z`;`g j`;`p`;`g (j+1)` ]) AZIM_BASE_SHIFT_LT)) gl);
    ASM_SIMP_TAC[AZIM_REFL;arith `j < j+1`];
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  COMMENT "A";
  SUBGOAL_THEN `azim x y z p < azim x y z (g (j+1))` ASSUME_TAC;
    REWRITE_TAC[arith `a < b <=> ~(b <= a)`];
    WEAK_STRIP_TAC;
    (fun gl -> (MP_TAC (SPECL ( envl gl[`x`;`y`;`g j`;`z`;`g j`;`p`;`g (j+1)` ]) AZIM_BASE_SHIFT_LT)) gl);
    ASM_SIMP_TAC[AZIM_REFL;arith `j < j+1`];
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  COMMENT "B";
  SUBGOAL_THEN `k = (n:num) /\ 1 IN 1..n` ASSUME_TAC;
    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 ));
    ASM_SIMP_TAC[];
    WEAK_STRIP_TAC;
    FIRST_ASSUM (MP_TAC o (SPECL[`k:num`;`k+1`]));
    FIRST_X_ASSUM (MP_TAC o (SPECL[`j+1`;`k:num`]));
    ASM_SIMP_TAC[arith `k < k+1`];
    REPEAT WEAK_STRIP_TAC;
    (fun gl -> (MP_TAC (SPECL ( envl gl[`x`;`y`;`g k`;`z`;`g k`;`p`;`g (k+1)`]) AZIM_BASE_SHIFT_LT)) gl);
    ASM_SIMP_TAC[AZIM_REFL];
    SUBGOAL_THEN `azim x y z (g (j+1)) <= azim x y z (g (k:num))` ASSUME_TAC;
      BY(ASM_MESON_TAC[arith `a <= b <=> (a<b \/ a = b)`;arith `j<k ==> (j+1=k)\/ (j+1<k)`]);
    REPEAT (FIRST_X_ASSUM MP_TAC);
    BY(REAL_ARITH_TAC);
  COMMENT "C";
  SUBGOAL_THEN `azim x y (g 1) (g n) < azim x y p (g (n:num))` ASSUME_TAC;
    MATCH_MP_TAC AZIM_COMP_LT;
    BY(ASM_MESON_TAC[]);
  SUBGOAL_THEN `1 < n` ASSUME_TAC;
    BY(ASM_MESON_TAC[IN_NUMSEG;arith `1 <= j /\ j < k /\ k <= n ==> 1 < n`]);
  SUBGOAL_THEN `azim x y z (g n) = azim x y z (g 1) + azim x y (g 1) (g n)` ASSUME_TAC;
    MATCH_MP_TAC Fan.sum4_azim_fan;
    BY(ASM_MESON_TAC[arith `a<b ==> a <= b`]);
  SUBGOAL_THEN `azim x y z p = azim x y z (g 1) + azim x y (g 1) p` ASSUME_TAC;
    MATCH_MP_TAC Fan.sum4_azim_fan;
    ASM_SIMP_TAC[];
    MATCH_MP_TAC (arith `a<b ==> a <= b`);
    ASM_CASES_TAC `(1=j)`;
      BY(ASM_SIMP_TAC[]);
    MATCH_MP_TAC (arith `a < azim x y z (g (j:num)) /\ azim x y z (g j) < c ==> a < c`);
    ASM_SIMP_TAC[];
    FIRST_X_ASSUM MATCH_MP_TAC;
    ASM_SIMP_TAC[];
    BY(ASM_MESON_TAC[IN_NUMSEG; arith `1 <= j ==> ((1=j) \/ (1 < j))`]);
  FIRST_X_ASSUM MP_TAC;
  SUBGOAL_THEN `azim x y z (g n) = azim x y z p + azim x y p (g (n:num))` ASSUME_TAC;
    MATCH_MP_TAC Fan.sum4_azim_fan;
    ASM_SIMP_TAC[];
    MATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`);
    CONJ_TAC;
      BY(ASM_MESON_TAC[]);
    MATCH_MP_TAC (arith `a<b ==> a <= b`);
    ASM_CASES_TAC `(j+1=n)`;
      BY(ASM_MESON_TAC[]);
    MATCH_MP_TAC (arith `a < azim x y z (g (j+1)) /\ azim x y z (g (j+1)) < c ==> a < c`);
    ASM_SIMP_TAC[];
    BY(ASM_MESON_TAC[IN_NUMSEG; arith `~(j+1=n) /\ ~(j=n) /\ (j<=n) ==> (j+1 < n)`]);
  DISCH_TAC;
  SUBGOAL_THEN `azim x y (g 1) p < &0` ASSUME_TAC;
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  BY(ASM_MESON_TAC[azim;arith `x < &0 ==> ~(&0 <= x)`])
  ]);;
  (* }}} *)

let ORDER_AZIM_SUM2Pi = 
prove_by_refinement(
   `!x y z n g.
     ~(collinear {x,y,z}) /\
    (!i. i IN 1..n ==> ~(collinear {x,y, g i})) /\
     (g (n+1) = g 1) /\ (1 < n) /\
        (!j k. j IN 1..n /\ k IN 1..n /\ (j < k) ==>  
	  azim x y z (g j) < azim x y z (g k))
    ==>
     sum (1..n) (\i. azim x y (g i) (g (i+1))) = &2 * pi`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  SUBGOAL_THEN `!i. i IN 1..(n-1) /\ 1 < n ==> (i < i+1 /\ i IN 1..n /\ (i+1) IN 1..n)` MP_TAC;
    REWRITE_TAC[IN_NUMSEG];
    BY(ARITH_TAC);
  REPEAT WEAK_STRIP_TAC;
  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;
    REPEAT WEAK_STRIP_TAC;
    REWRITE_TAC[arith `a = b - c <=> b = c + a`];
    MATCH_MP_TAC Fan.sum4_azim_fan;
    ASM_SIMP_TAC[];
    MATCH_MP_TAC (arith `a < b ==> a <= b`);
    BY(ASM_MESON_TAC[arith `i < i+1`]);
  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;
    BY(ASM_MESON_TAC[arith `1 <= (n-1)+1 /\ ((1<n) ==>(n-1)+1 = n)`;SUM_ADD_SPLIT]);
  REWRITE_TAC[SUM_SING_NUMSEG];
  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;
    BY(ASM_MESON_TAC[SUM_EQ]);
  SIMP_TAC[SUM_DIFFS_ALT];
  ASM_SIMP_TAC[arith `1< n ==> 1 <= n-1`;arith `1 < n==> (n-1)+1 = n`];
  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`);
  SUBGOAL_THEN `1 IN 1..n /\ n IN 1..n` MP_TAC;
    REWRITE_TAC[IN_NUMSEG];
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN ARITH_TAC);
  REPEAT WEAK_STRIP_TAC;
  SUBCONJ_TAC;
    MATCH_MP_TAC Fan.sum4_azim_fan;
    BY(ASM_SIMP_TAC[arith `a< b ==> a<=b`]);
  DISCH_TAC;
  (fun gl -> (REWRITE_TAC[SPECL ( envl gl[`x`;`y`;`g (1)`;`g(n:num)`]) Rogers.AZIM_COMPL_EXT]) gl);
  COND_CASES_TAC;
    BY(ASM_MESON_TAC[arith `x = y + &0 ==> ~(y<x)`]);
  BY(REWRITE_TAC[])
  ]);;
  (* }}} *)


let AFFINE_VEC0 = 
prove_by_refinement(  
  `!(u:real^A) t.  ~(t= &1) ==> vec 0 IN affine hull {u, t % u}`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC[ AFFINE_HULL_2_ALT ; IN_ELIM_THM ];
  ASM_CASES_TAC (`(u:real^A) = vec 0`);
    ASM_REWRITE_TAC[];
    REWRITE_TAC[VECTOR_ADD_RID;VECTOR_SUB_RZERO;VECTOR_ADD_LID;VECTOR_SUB_LZERO];
    REWRITE_TAC[VECTOR_MUL_RZERO];
    BY(REWRITE_TAC[IN_UNIV]);
  REWRITE_TAC[IN_UNIV];
  EXISTS_TAC `&1 / (&1 - t)`;
  REWRITE_TAC[ VECTOR_ARITH `(u + s % (t % u - (u:real^A))) = (&1 + s * t - s) % u`];
  MATCH_MP_TAC (VECTOR_ARITH (`(a:real^A) = b ==> b = a`));
  ASM_REWRITE_TAC [ VECTOR_MUL_EQ_0 ];
  MATCH_MP_TAC (Calc_derivative.rational_identity `&1 + &1 / (&1 - t) * t - &1 / (&1 - t) = &0`);
  BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
  ]);;
  (* }}} *)


let RELATIVE_INTERIOR_AFFINE_FACE = 
prove_by_refinement(
  `!C (p:real^N) f. convex C /\ f face_of C /\ p IN affine hull f /\ (p IN relative_interior C) ==> (f = C) `,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  (fun gl -> (ENOUGH_TO_SHOW_TAC ( env gl `~(f INTER relative_interior C = {})`)) gl);
    BY(ASM_MESON_TAC[ FACE_OF_DISJOINT_RELATIVE_INTERIOR ]);
  REWRITE_TAC[Local_lemmas.EXISTS_IN];
  (fun gl -> (EXISTS_TAC ( env gl `p`)) gl);
  ASM_REWRITE_TAC[ IN_INTER ];
  TYPIFY `f = affine hull f INTER C` (C SUBGOAL_THEN SUBST1_TAC);
    BY(ASM_MESON_TAC [ FACE_OF_STILLCONVEX ]);
  ASM_REWRITE_TAC[ IN_INTER ];
  FIRST_X_ASSUM (MP_TAC);
  BY(ASM_MESON_TAC[ RELATIVE_INTERIOR_SUBSET ;SUBSET; IN ])
  ]);;
  (* }}} *)

let SUBSET_P_HULL = 
prove(` (S:A -> bool) SUBSET P hull S`,

REWRITE_TAC[HULL_SUBSET]);;

let FCHANGED_AFFINE = 
prove_by_refinement(
  `!p (f:real^3->bool).
    polyhedron p /\ bounded p /\ vec 0 IN interior p /\ f facet_of p ==>
    (fchanged f INTER affine hull f = relative_interior f)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC SUBSET_ANTISYM;
  ROT_TAC;
  CONJ_TAC;
    REWRITE_TAC[SUBSET_INTER];
    CONJ_TAC;
      BY(BY(ASM_MESON_TAC[ Polyhedron.RELATIVE_SUBSET_FCHANGE ]));
    BY(BY(ASM_MESON_TAC[ Qzksykg.SET_SUBSET_AFFINE_HULL ; RELATIVE_INTERIOR_SUBSET ; SUBSET]));
  REWRITE_TAC[ SUBSET ; IN_INTER ; Polyhedron.fchanged ; IN_ELIM_THM ];
  (REPEAT WEAK_STRIP_TAC);
  (fun gl -> (ASM_CASES_TAC ( env gl`x = v1` )) gl);
    BY(ASM_MESON_TAC[]);
  TYPIFY `vec 0 IN affine hull f` (C SUBGOAL_THEN ASSUME_TAC);
    (fun gl -> (ENOUGH_TO_SHOW_TAC ( env gl `vec 0 IN affine hull {v1, t % v1 } /\ {v1 , t % v1 } SUBSET affine hull f`)) gl);
      BY(ASM_MESON_TAC[ SUBSET; IN; Marchal_cells_2_new.AFFINE_SUBSET_KY_LEMMA ; HULL_MONO; HULL_HULL ]);
    CONJ_TAC;
      MATCH_MP_TAC AFFINE_VEC0;
      BY(ASM_MESON_TAC [ VECTOR_MUL_LID ]);
    REWRITE_TAC[ SUBSET ];
    GEN_TAC;
    REWRITE_TAC[Collect_geom.IN_SET2];
    REPEAT WEAK_STRIP_TAC THEN ASM_REWRITE_TAC[];
      BY(ASM_MESON_TAC [ RELATIVE_INTERIOR_SUBSET; SUBSET_P_HULL ; SUBSET; IN]);
    BY(ASM_MESON_TAC[]);
  (fun gl -> (SUBGOAL_THEN ( env gl`f = p`) ASSUME_TAC) gl);
    MATCH_MP_TAC (INST_TYPE [(`:3`,`:N`)] RELATIVE_INTERIOR_AFFINE_FACE);
    EXISTS_TAC `(vec 0):real^3`;
    ASM_REWRITE_TAC[];
    BY(ASM_MESON_TAC[ POLYHEDRON_IMP_CONVEX ; facet_of; INTERIOR_SUBSET_RELATIVE_INTERIOR ; SUBSET; IN]);
  HASH_UNDISCH_TAC 8736;
  ASM_REWRITE_TAC[ facet_of ];
  BY(MESON_TAC[ ( arith `T ==> ~((x:int) = x - &1)`)])
  ]);;
  (* }}} *)

let RCONE_PREP = 
prove_by_refinement(
  `!p (v:real^3) u0 b.
    &0 < b /\ ~(v = vec 0) /\ (&0 < v dot v)  /\
    u0= (b / (v dot v)) % v /\ 
    (&0 < t ) /\ (t < &1) /\
    p dot v = b ==>
   ( (u0 dot u0 = (b * b) / (v dot v)) /\
       (p dot u0 = (b * b )/ (v dot v)) /\ 
     (dist (p,u0) pow 2 = p dot p -  (b * b)/(v dot v)   ))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  SUBCONJ_TAC;
    ASM_REWRITE_TAC[];
    REWRITE_TAC[DOT_LMUL];
    REWRITE_TAC[DOT_RMUL];
    CALC_ID_TAC;
    BY((REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
  DISCH_TAC;
  SUBCONJ_TAC;
    ASM_REWRITE_TAC[];
    REWRITE_TAC[DOT_RMUL];
    ASM_REWRITE_TAC[];
    CALC_ID_TAC;
    BY((REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
  DISCH_TAC;
  REWRITE_TAC[ Collect_geom.DIST_POW2_DOT ];
  TYPIFY `(p - u0) dot (p - u0) = (p dot p) - (b * b)/(v dot v)` (C SUBGOAL_THEN SUBST1_TAC);
  REWRITE_TAC [ VECTOR_ARITH `(p - (u0:real^3)) dot (p - u0) = p dot p - &2 * (p dot u0) + u0 dot u0`];
    HASH_KILL_TAC 9721;
    ASM_REWRITE_TAC[];
    BY(BY(REAL_ARITH_TAC));
  BY(REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let RCONE_DISK = 
prove_by_refinement(
  `!p (v:real^3) u0 b r t.
    &0 < b /\ ~(v = vec 0) /\ (&0 < v dot v) /\ dist(p,u0) < r /\
    u0= (b / (v dot v)) % v /\ 
    (&0 < t ) /\ (t < &1) /\
    p dot v = b /\ (r = b * sqrt(&1 - t pow 2)/(t * norm v)) ==>
    (p IN rcone_gt (vec 0) v t)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC[rcone_gt;rconesgn;IN_ELIM_THM];
  REWRITE_TAC[VECTOR_ADD_RID;VECTOR_SUB_RZERO;VECTOR_ADD_LID;VECTOR_SUB_LZERO];
  REWRITE_TAC[DIST_0];
  GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`p`;`v`;`u0`;`b`]) RCONE_PREP)));
  ANTS_TAC;
    BY(ASM_MESON_TAC[]);
  REPEAT WEAK_STRIP_TAC;
  HASH_KILL_TAC 9721;
  REWRITE_TAC[arith `a > b <=> b < a`];
  MATCH_MP_TAC Tactics_jordan.REAL_POW_2_LT;
  REWRITE_TAC[ Trigonometry2.MUL_POW2 ];
  REWRITE_TAC[ NORM_POW_2 ];
  CONJ_TAC;
    REPEAT (MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2) THEN REWRITE_TAC[ NORM_POS_LE ];
    REPEAT (MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2) THEN REWRITE_TAC[ NORM_POS_LE ];
    BY(BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
  CONJ_TAC;
    BY(BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
  TYPIFY `p dot p < (b * b)/ ((t pow 2) * (v dot v))` (C SUBGOAL_THEN ASSUME_TAC);
    FIRST_X_ASSUM (fun t -> MP_TAC (MATCH_MP Tarjjuw.CHANGE_TARJJUW_4 t));
    ASM_REWRITE_TAC[];
    MATCH_MP_TAC (arith `(c + u = v) ==> (a - c < u ==> a< v)`);
    CALC_ID_TAC;
    REWRITE_TAC[ NORM_EQ_0 ];
    ASM_SIMP_TAC[arith `&0 < k ==> ~(k = &0)`];
    REWRITE_TAC[ Trigonometry2.MUL_POW2 ; NORM_POW_2 ];
    SUBGOAL_THEN `&0 <= &1 - t pow 2` ASSUME_TAC;
      MATCH_MP_TAC Trigonometry2.UNIT_BOUNDED_IN_TOW_FORMS;
      BY(BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
    ASM_SIMP_TAC [ SQRT_POW_2 ];
    BY(BY(REAL_ARITH_TAC));
  COMMENT "1";
  FIRST_X_ASSUM (fun t -> ASSUME_TAC (MATCH_MP ( REWRITE_RULE[ TAUT `(a /\ b ==> c) <=> (a ==> (b ==> c))`] REAL_LT_RMUL) t));
  FIRST_X_ASSUM (C INTRO_TAC [`(v dot v) * t pow 2`]);
(*  TYPIFY `(v dot v) * t pow 2` (C FIRST_X_ASSUM (fun t -> MP_TAC (ISPEC t))); *)
  ANTS_TAC;
    MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[];
    REWRITE_TAC[ GSYM Trigonometry2.NOT_ZERO_EQ_POW2_LT ];
    BY(BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
  MATCH_MP_TAC (arith `(b = c) ==> (a < b ==> (a < c))`);
  ASM_REWRITE_TAC[];
  CALC_ID_TAC;
  BY(BY(REPEAT CONJ_TAC THEN REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC))
 ]);;
  (* }}} *)

let RDISK_R = 
prove_by_refinement(
    `! (v:real^3) u0 b  t.
    &0 < b /\ ~(v = vec 0) /\ (&0 < v dot v) /\     (&0 < t ) /\ (t < &1) /\ 
    u0= (b / (v dot v)) % v ==>
    (?r. (&0 < r) /\ (!p.  dist(p,u0) < r /\  p dot v = b ==>  (p IN rcone_gt (vec 0) v t)) /\
       (!w. dist(w,u0) = r /\ w dot v = b ==> cos (arcV(vec 0) u0 w) = t))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  TYPED_ABBREV_TAC `r = b * sqrt(&1 - t pow 2)/(t * norm v)`;
  SUBGOAL_THEN `&0 < &1 - t pow 2` ASSUME_TAC;
    REWRITE_TAC[ arith `&0 < &1 - x <=> x < &1` ];
    REWRITE_TAC[ ABS_SQUARE_LT_1 ];
    BY(BY(BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)));
  EXISTS_TAC `r:real`;
  SUBCONJ_TAC;
    EXPAND_TAC "r";
    MATCH_MP_TAC REAL_LT_MUL;
    CONJ_TAC THEN ASM_REWRITE_TAC[ Calc_derivative.invert_den_lt ];
    MATCH_MP_TAC REAL_LT_MUL;
    ASM_SIMP_TAC [ SQRT_POS_LT ];
    MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[];
    BY(ASM_REWRITE_TAC[ NORM_POS_LT ]);
  DISCH_TAC;
  CONJ_TAC;
    REPEAT WEAK_STRIP_TAC;
    BY(ASM_MESON_TAC[ RCONE_DISK]);
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun REWRITE_TAC -> (MP_TAC (ISPECL ( envl REWRITE_TAC [`w`;`v`;`u0`;`b`]) RCONE_PREP)));
  ANTS_TAC;
    BY(BY(ASM_MESON_TAC[]));
  REPEAT WEAK_STRIP_TAC;
  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`)));
    REWRITE_TAC[ REAL_EQ_MUL_LCANCEL ; NORM_EQ_0 ];
    MATCH_MP_TAC (TAUT `~a /\ ~b ==> (a \/ b \/ c ==> c)`);
    CONJ_TAC;
      ASM_REWRITE_TAC[];
      REWRITE_TAC [ VECTOR_MUL_EQ_0 ];
      ASM_REWRITE_TAC[];
      REWRITE_TAC [ Calc_derivative.invert_den_eq ];
      REWRITE_TAC[ REAL_ENTIRE];
      BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
    DISCH_TAC;
    HASH_UNDISCH_TAC 287;
    ASM_REWRITE_TAC[];
    REWRITE_TAC[ DOT_LZERO ];
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  REWRITE_TAC[ GSYM Trigonometry1.DOT_COS ];
  FIRST_X_ASSUM (MP_TAC);
  HASH_KILL_TAC 9721;
  ASM_REWRITE_TAC[];
  HASH_KILL_TAC 1350;
  EXPAND_TAC "r";
  REWRITE_TAC[ Trigonometry2.MUL_POW2 ; Trigonometry2.DIV_POW2 ];
  REWRITE_TAC[ arith `a = b - c <=> b = a + c`];
  ASM_SIMP_TAC [ SQRT_POW_2 ; arith `&0 < u ==> &0 <= u`];
  DISCH_TAC;
  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)`)));
    BY(ASM_MESON_TAC[ Collect_geom.EQ_POW2_COND ]);
  ONCE_REWRITE_TAC[ DOT_SYM ];
  ASM_REWRITE_TAC[];
  REWRITE_TAC[ Trigonometry2.MUL_POW2 ; Trigonometry2.DIV_POW2 ];
  REWRITE_TAC[ NORM_POW_2 ];
  ASM_REWRITE_TAC[];
  CONJ_TAC;
    REWRITE_TAC[ Calc_derivative.invert_den_le ];
    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));
  CONJ_TAC;
    REPEAT (MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2 THEN REWRITE_TAC[ NORM_POS_LE ] THEN TRY CONJ_TAC);
    BY((REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
  CALC_ID_TAC;
  ASM_REWRITE_TAC[ DOT_EQ_0 ; NORM_EQ_0 ];
  CONJ_TAC;
    BY((REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC));
  REWRITE_TAC[ NORM_POW_2 ];
  BY(REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let FCHANGED_MEASURABLE = 
prove_by_refinement(
  `!(p:real^3->bool) f r.
    bounded p /\ polyhedron p /\ vec 0 IN interior p /\ f facet_of p ==>
    measurable ( fchanged f  INTER normball (vec 0) r)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC Conforming.MEASURABLE_TOPOLOGICAL_COMPONENT_YFAN_INTER_BALL;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `vertices p`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `edges p`)));
  SUBCONJ_TAC;
    MATCH_MP_TAC Polyhedron.POLYHEDRON_FAN;
    BY(ASM_REWRITE_TAC[]);
  DISCH_TAC;
  SUBCONJ_TAC;
    MATCH_MP_TAC Conforming.PIIJBJK;
    ASM_REWRITE_TAC[];
    ROT_TAC;
    SUBCONJ_TAC;
      MATCH_MP_TAC Polyhedron.POLYTOPE_FAN80;
      BY(ASM_REWRITE_TAC[]);
    DISCH_TAC;
    BY(ASM_MESON_TAC [ Polyhedron.CARD_SET_OF_EDGE_INEQ_1_POLYHEDRON ]);
  DISCH_TAC;
  BY(ASM_MESON_TAC [ Polyhedron.FCHANGED_IN_COMPONENT ])
  ]);;
  (* }}} *)

let RADIAL_NORMBALL = 
prove_by_refinement(
  `!(p:real^3) r. (radial r p (normball p r))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC[ Sphere.radial ];
  REWRITE_TAC[ NORMBALL_BALL ];
  REWRITE_TAC[ IN_BALL ];
  CONJ_TAC;
    BY(SET_TAC[]);
  REWRITE_TAC[ dist ];
  REWRITE_TAC[VECTOR_ARITH `(p - (p + u)) = (-- (u:real^3))`];
  REWRITE_TAC[ NORM_NEG ];
  REWRITE_TAC [ NORM_MUL ];
  BY(REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let FCHANGED_RADIAL = 
prove_by_refinement(
  `!(p:real^3->bool) f r.
    bounded p /\ polyhedron p /\ vec 0 IN interior p /\ f facet_of p ==>
    radial r (vec 0) ( fchanged f INTER normball (vec 0) r)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[ Sphere.radial ];
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC[ NORMBALL_BALL ];
  REWRITE_TAC[VECTOR_ADD_RID;VECTOR_SUB_RZERO;VECTOR_ADD_LID;VECTOR_SUB_LZERO];
  CONJ_TAC;
    BY(SET_TAC[]);
  REPEAT WEAK_STRIP_TAC;
  FIRST_X_ASSUM_ST `fchanged` MP_TAC;
  REWRITE_TAC[IN_INTER];
  REWRITE_TAC[ Polyhedron.fchanged ];
  REWRITE_TAC[ IN_ELIM_THM ];
  REPEAT WEAK_STRIP_TAC;
  CONJ_TAC;
    TYPIFY `v1` EXISTS_TAC;
    ASM_REWRITE_TAC[];
    TYPIFY `t * t'` EXISTS_TAC;
    REWRITE_TAC [ VECTOR_MUL_ASSOC ];
    REPEAT (FIRST_X_ASSUM_ST `a > b` MP_TAC);
    REWRITE_TAC [arith `a > b <=> b < a`];
    BY(MESON_TAC[ REAL_LT_MUL ]);
  INTRO_TAC RADIAL_NORMBALL [`(vec 0):real^3`;`r`];
  REWRITE_TAC[ NORMBALL_BALL ];
  REWRITE_TAC[ Sphere.radial ];
  REWRITE_TAC[VECTOR_ADD_RID;VECTOR_SUB_RZERO;VECTOR_ADD_LID;VECTOR_SUB_LZERO];
  FIRST_X_ASSUM MP_TAC;
  REWRITE_TAC[ IN_BALL ];
  REWRITE_TAC[ dist ];
  REWRITE_TAC[VECTOR_ADD_RID;VECTOR_SUB_RZERO;VECTOR_ADD_LID;VECTOR_SUB_LZERO];
  REWRITE_TAC[ NORM_NEG ];
  BY(ASM_MESON_TAC[SUBSET])
]
);;
let WEDGE_SPLIT = 
prove_by_refinement(
  `!u0 u1 u2 u3 w.
    ~(collinear {u0,u1,u2}) /\
    ~(collinear {u0,u1,u3}) /\
    w IN wedge u0 u1 u2 u3 ==>
   (     ~(collinear {u0,u1,w}) /\
   (wedge u0 u1 u2 w INTER wedge u0 u1 w u3 = {}) /\
    wedge u0 u1 u2 w SUBSET wedge u0 u1 u2 u3 /\
    wedge u0 u1 w u3 SUBSET wedge u0 u1 u2 u3)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[ wedge ; EMPTY_NOT_EXISTS_IN ];
  REWRITE_TAC[ IN_ELIM_THM ; SUBSET ; IN_INTER];
  REPEAT WEAK_STRIP_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
    REPEAT WEAK_STRIP_TAC;
    GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`u0`;`u1`;`u2`;`w`;`x`;`w`;`u3`]) AZIM_BASE_SHIFT_LT)));
    ASM_REWRITE_TAC[];
    REWRITE_TAC[ AZIM_REFL ];
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  CONJ_TAC;
    REPEAT WEAK_STRIP_TAC;
    ASM_REWRITE_TAC[];
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  REPEAT WEAK_STRIP_TAC;
  ASM_REWRITE_TAC[];
  GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`u0`;`u1`;`w`;`u2`;`w`;`x`;`u3`]) AZIM_BASE_SHIFT_LT)));
  ASM_REWRITE_TAC[ AZIM_REFL ];
  BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let cone0_subset_lune = 
prove_by_refinement(
  `!u0 u1 u2 u3.  cone0 u0 {u1,u2,u3} SUBSET aff_gt { u0 , u1} { u2, u3}`,

  (* {{{ proof *)
  [
  REWRITE_TAC[ Sphere.aff_gt_def ;SUBSET ];
  REWRITE_TAC[ Sphere.cone0 ];
  REWRITE_TAC[ IN; affsign ];
  REPEAT GEN_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{u0 } UNION {u1,u2,u3} = {u0,u1,u2,u3}`) SUBST1_TAC));
    BY(SET_TAC[]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{u0,u1 } UNION {u2,u3} = {u0,u1,u2,u3}`) SUBST1_TAC));
    BY(SET_TAC[]);
  REWRITE_TAC [ X_IN IN_INSERT ];
  BY(MESON_TAC[])
  ]);;
  (* }}} *)

let COLLINEAR_UNEQUAL = 
prove_by_refinement(
  `!u0 u1 (u2:real^N). ~collinear {u0,u1,u2} ==>
    ~(u2 IN {u0,u1}) /\ ~(u1 IN {u0})`,

  (* {{{ proof *)
  [
  REPEAT GEN_TAC;
  DISCH_TAC;
  REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY ];
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{u0,u1,u2} = {u1,u2,u0}`) ASSUME_TAC));
    BY(SET_TAC[]);
  BY(ASM_MESON_TAC[ Collect_geom.NOT_COLLINEAR_IMP_2_UNEQUAL ])
  ]);;
  (* }}} *)

let HAS_SIZE_GE_2 = 
prove_by_refinement(
  `!(s:A->bool). FINITE s /\ CARD s > 1 ==> (!x. x IN s ==> (?y. y IN s /\ ~(y = x)))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(s HAS_SIZE 0) /\ ~(s HAS_SIZE 1)`) MP_TAC));
    REWRITE_TAC[HAS_SIZE];
    ASM_REWRITE_TAC[];
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN ARITH_TAC);
  REWRITE_TAC[ HAS_SIZE_0 ];
  REWRITE_TAC[ HAS_SIZE_1_EXISTS ];
  FIRST_X_ASSUM MP_TAC;
  BY(SET_TAC[])
  ]);;
  (* }}} *)


let TWO_IMP_HAS_SIZE_GE_2 = 
prove_by_refinement(
  `!(s:A->bool) x y. x IN s /\ y IN s /\ ~(x = y) /\ FINITE s ==> CARD s > 1`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun REWRITE_TAC -> (SUBGOAL_THEN ( env REWRITE_TAC `~(s HAS_SIZE 0) /\ ~(s HAS_SIZE 1)`) MP_TAC));
    REWRITE_TAC[ HAS_SIZE_0 ];
    REWRITE_TAC[ HAS_SIZE_1_EXISTS ];
    REPEAT( FIRST_X_ASSUM MP_TAC);
    BY(BY(SET_TAC[]));
  BY(ASM_MESON_TAC[HAS_SIZE; arith `~(n=0) /\ ~(n=1) ==> (n >1)`])
  ]);;
  (* }}} *)

let AFF_GT_RELATIVE_INTERIOR = 
prove_by_refinement(
  `!(s:real^N->bool). FINITE s /\ CARD s > 1 
     ==> aff_gt {} s SUBSET relative_interior (convex hull s)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  FIRST_ASSUM (fun t -> (MP_TAC (MATCH_MP EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL t)));
  DISCH_TAC;
  MATCH_MP_TAC SUBSET_TRANS;
  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}` )));
  ASM_REWRITE_TAC[];
  REWRITE_TAC[Sphere.aff_gt_def;AFFSIGN];
  REWRITE_TAC[ IN_ELIM_THM; SUBSET ;IN_INSERT ; UNION_EMPTY ];
  REWRITE_TAC[ sgn_gt ];
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `f`)));
  ASM_REWRITE_TAC[];
  REPEAT WEAK_STRIP_TAC;
  ASM_SIMP_TAC[];
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?y. y IN s /\ ~(y = x')`) MP_TAC));
    BY(ASM_MESON_TAC [ HAS_SIZE_GE_2 ]);
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(sum {y,x'} f <= sum s f )`) ASSUME_TAC));
    MATCH_MP_TAC SUM_SUBSET_SIMPLE;
    ASM_REWRITE_TAC[];
    CONJ_TAC;
      REPEAT (FIRST_X_ASSUM_ST `IN` MP_TAC);
(*       ALL_SEARCH [`IN`];  Feb 3, 2013 *)
      BY(SET_TAC[]);
    REWRITE_TAC[IN_DIFF];
    BY(ASM_MESON_TAC[ arith `&0 < a ==> &0 <= a`]);
  FIRST_X_ASSUM MP_TAC;
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[ Upfzbzm_support_lemmas.SUM_SET_OF_2_ELEMENTS ];
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `&0 < f y`) MP_TAC));
    BY(ASM_SIMP_TAC[]);
  BY(REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let NOT_COLLINEAR_AFF_DIM_2 = 
prove_by_refinement(
  `!u0 u1 (u2:real^N). ~collinear{u0,u1,u2} ==> aff_dim {u0,u1,u2}= &2`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  ONCE_REWRITE_TAC[ AFF_DIM_INSERT ];
  REWRITE_TAC[ AFF_DIM_2 ];
  BY(ASM_MESON_TAC[ Collect_geom.IN_AFFINE_HULL_IMP_COLLINEAR ; arith `(&1 + &1 = (&2):int)`; COLLINEAR_UNEQUAL; IN_INSERT])
  ]);;
  (* }}} *)

let FACET_AFF_DIM_2 = 
prove_by_refinement(
  `!(p:real^3->bool) f .
     polyhedron p /\  (vec 0 IN interior p) /\
    f facet_of p 
    ==> aff_dim f = &2 `,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP (Polyhedron.AFF_DIM_INTERIOR_EQ_3) t));
  BY(BY(ASM_MESON_TAC[ facet_of ; arith `&3 - &1 = (&2):int` ;arith `(x:int <= x)`]))
]
);;
  (* }}} *)

let CONE0_RELATIVE_INTERIOR_FACET = 
prove_by_refinement(
  `!p f (u0:real^3) u1 u2.
     polyhedron p /\ bounded p /\ (vec 0 IN interior p) /\
    f facet_of p /\ ~(collinear {u0,u1,u2}) /\
    {u0,u1,u2} SUBSET f  ==>
    aff_gt {}  {u0,u1,u2} SUBSET relative_interior f
`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC SUBSET_TRANS;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `relative_interior (convex hull {u0,u1,u2})`)));
  CONJ_TAC;
    MATCH_MP_TAC AFF_GT_RELATIVE_INTERIOR;
    SUBCONJ_TAC;
      BY(REWRITE_TAC[ FINITE_INSERT; FINITE_EMPTY ]);
    DISCH_TAC;
    MATCH_MP_TAC TWO_IMP_HAS_SIZE_GE_2;
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `u0`)));
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `u1`)));
    ASM_REWRITE_TAC[ IN_INSERT ];
    BY(BY(ASM_MESON_TAC[ Collect_geom.NOT_COLLINEAR_IMP_2_UNEQUAL ]));
  MATCH_MP_TAC SUBSET_RELATIVE_INTERIOR;
  CONJ_TAC;
    BY(ASM_MESON_TAC[ FACE_OF_IMP_CONVEX; Marchal_cells.CONVEX_HULL_SUBSET; CONVEX_HULL_EQ ; facet_of ]);
  MATCH_MP_TAC AFF_DIM_EQ_AFFINE_HULL;
  SUBCONJ_TAC;
    BY(ASM_MESON_TAC[ FACE_OF_IMP_CONVEX; Marchal_cells.CONVEX_HULL_SUBSET; CONVEX_HULL_EQ ; facet_of ]);
  DISCH_TAC;
  MATCH_MP_TAC (arith ` (a <= &2 /\ &2 <= c ==> (a:int) <= c)`);
  CONJ_TAC;
    FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP (Polyhedron.AFF_DIM_INTERIOR_EQ_3) t));
    BY(ASM_MESON_TAC[ facet_of ; arith `&3 - &1 = (&2):int` ;arith `(x:int <= x)`]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{u0,u1,u2} SUBSET convex hull {u0,u1,u2}`) ASSUME_TAC));
    BY(REWRITE_TAC[ Ldurdpn.SUBSET_P_HULL ]);
  FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP (AFF_DIM_SUBSET) t));
  MATCH_MP_TAC (arith `!b. (a:int) <= b /\ b <= c ==> (a <=c)`);
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `aff_dim {u0,u1,u2}`)));
  ASM_REWRITE_TAC[];
  BY(ASM_MESON_TAC [ NOT_COLLINEAR_AFF_DIM_2 ; arith `(x:int <= x)`])
  ]);;
  (* }}} *)


let CONE0_FCHANGED_AFF_GT = 
prove_by_refinement(
  `!(s:real^N->bool). FINITE s /\ CARD s > 1 /\ ~(vec 0 IN s)
    ==>
   cone0 (vec 0) s SUBSET fchanged (convex hull s)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC[ Sphere.cone0 ];
  REWRITE_TAC[ Polyhedron.fchanged ];
  REWRITE_TAC[ SUBSET; IN_ELIM_THM ];
  REWRITE_TAC[AFFSIGN];
  REWRITE_TAC[ IN_ELIM_THM ; sgn_gt];
  REPEAT WEAK_STRIP_TAC;
  TYPED_ABBREV_TAC  `(a:real) = f (vec 0)`;
  TYPED_ABBREV_TAC `(v1:real^N) = vsum s (\v. (f v / (&1 - a)) % v)`;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `v1`)));
  EXISTS_TAC (`&1 - a`);
  SUBGOAL_THEN `&1 - a > &0` ASSUME_TAC;
    REWRITE_TAC[ arith `&1 - a > &0 <=> ~(&1 <= a)`];
    DISCH_TAC;
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`~(s HAS_SIZE 0)`) MP_TAC));
      BY(ASM_MESON_TAC[ HAS_SIZE; arith `x > 1 ==> ~(x = 0)`]);
    REWRITE_TAC[ HAS_SIZE_0 ];
    REWRITE_TAC[ EMPTY_NOT_EXISTS_IN ];
    REPEAT WEAK_STRIP_TAC;
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `sum {x',vec 0} f <= sum ({vec 0 } UNION s) f`) MP_TAC));
      MATCH_MP_TAC SUM_SUBSET_SIMPLE;
      SUBCONJ_TAC;
        BY(ASM_REWRITE_TAC[ FINITE_UNION ;FINITE_INSERT; FINITE_EMPTY]);
      DISCH_TAC;
      SUBCONJ_TAC;
        REPEAT (FIRST_X_ASSUM_ST `IN` MP_TAC);
(*        ALL_SEARCH [`IN`]; Feb 3, 2013 *)
        BY(SET_TAC[]);
      DISCH_TAC;
      REPEAT WEAK_STRIP_TAC;
      MATCH_MP_TAC (arith `&0 < x ==> &0 <= x`);
      FIRST_X_ASSUM MATCH_MP_TAC;
      FIRST_X_ASSUM MP_TAC;
      BY(SET_TAC[]);
    ASM_REWRITE_TAC[];
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`~(x' = vec 0)`) ASSUME_TAC));
      BY(ASM_MESON_TAC[]);
    ASM_SIMP_TAC[ Upfzbzm_support_lemmas.SUM_SET_OF_2_ELEMENTS ];
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `&0 < f x'`) MP_TAC));
      BY(ASM_MESON_TAC[]);
    REPEAT (FIRST_X_ASSUM_ST `<=` MP_TAC);
(*    ALL_SEARCH [`<=`]; Feb 3, 2013 *)
    BY(REAL_ARITH_TAC);
  ASM_REWRITE_TAC[];
  SUBCONJ_TAC;
    EXPAND_TAC "v1";
    REWRITE_TAC[ GSYM VSUM_LMUL ];
    REWRITE_TAC[ VECTOR_MUL_ASSOC ];
    SUBGOAL_THEN `!u. (&1 - a) * u/(&1- a) = u` (fun t-> REWRITE_TAC[t]);
      GEN_TAC;
      CALC_ID_TAC;
      FIRST_X_ASSUM MP_TAC;
      BY(REAL_ARITH_TAC);
    REWRITE_TAC[ Packing3.SING_UNION_EQ_INSERT ];
    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));
      BY(ASM_MESON_TAC[ Marchal_cells_2_new.VSUM_CLAUSES_alt ]);
    REWRITE_TAC[ VECTOR_MUL_RZERO ];
    BY(REWRITE_TAC[VECTOR_ADD_RID;VECTOR_SUB_RZERO;VECTOR_ADD_LID;VECTOR_SUB_LZERO]);
  DISCH_TAC;
  GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `v1 IN aff_gt {} s`)));
    GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `aff_gt {} s SUBSET relative_interior (convex hull s)`)));
      BY(SET_TAC[]);
    MATCH_MP_TAC AFF_GT_RELATIVE_INTERIOR;
    BY(ASM_REWRITE_TAC[]);
  REWRITE_TAC[ aff_gt_def ; AFFSIGN ];
  REWRITE_TAC[ UNION_EMPTY ; sgn_gt ];
  REWRITE_TAC[ IN_ELIM_THM ];
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `\v. f v / (&1 - a)`)));
  BETA_TAC;
  ASM_REWRITE_TAC[];
  SUBCONJ_TAC;
    REPEAT WEAK_STRIP_TAC;
    REWRITE_TAC[ Calc_derivative.invert_den_lt ];
    MATCH_MP_TAC REAL_LT_MUL;
    CONJ_TAC;
      BY(ASM_MESON_TAC[]);
    REPEAT (FIRST_X_ASSUM_ST `>` MP_TAC);
(*    ALL_SEARCH [`>`]; *)
    BY(REAL_ARITH_TAC);
  DISCH_TAC;
  REPEAT (FIRST_X_ASSUM_ST `sum` MP_TAC);
(*  ALL_SEARCH [`sum`]; *)
  REWRITE_TAC[ Packing3.SING_UNION_EQ_INSERT ];
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `sum (vec 0 INSERT s) f = f (vec 0) + sum s f`) SUBST1_TAC));
    BY(ASM_MESON_TAC[ SUM_CLAUSES ]);
  REWRITE_TAC[ real_div ];
  REWRITE_TAC[ SUM_RMUL ];
  ASM_REWRITE_TAC[];
  REWRITE_TAC [arith `a + b = c <=> b = c - a`];
  DISCH_THEN SUBST1_TAC;
  CALC_ID_TAC;
  REPEAT (FIRST_X_ASSUM_ST `>` MP_TAC);
(*  ALL_SEARCH [`>`]; *)
  BY(REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let CONE0_FCHANGED = 
prove_by_refinement(
  `!p f (u0:real^3) u1 u2. 
    polyhedron p /\ bounded p /\ (vec 0 IN interior p) /\
    f facet_of p /\ ~(collinear {u0,u1,u2}) /\
    {u0,u1,u2} SUBSET f  ==>
    cone0 (vec 0) {u0,u1,u2} SUBSET fchanged f`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC SUBSET_TRANS;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `fchanged (convex hull {u0,u1,u2})`)));
  SUBCONJ_TAC;
    MATCH_MP_TAC CONE0_FCHANGED_AFF_GT;
    SUBCONJ_TAC;
      BY(REWRITE_TAC[ FINITE_INSERT; FINITE_EMPTY ]);
    DISCH_TAC;
    SUBCONJ_TAC;
      BY(ASM_MESON_TAC[ COLLINEAR_UNEQUAL; TWO_IMP_HAS_SIZE_GE_2; IN_INSERT ]);
    DISCH_TAC;
    GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `~(vec 0 IN f)`)));
      REPEAT (FIRST_X_ASSUM_ST `SUBSET` MP_TAC);
(*      ALL_SEARCH [`SUBSET`]; *)
      BY(SET_TAC[]);
    BY(ASM_MESON_TAC [ FACE_OF_DISJOINT_INTERIOR ; Hypermap.lemma_in_disjoint ; facet_of ; arith `~(x = x - (&1):int)`]);
  DISCH_TAC;
  REWRITE_TAC[ Polyhedron.fchanged ];
  REWRITE_TAC[ SUBSET ; IN_ELIM_THM ];
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w`relative_interior (convex hull {u0,u1,u2}) SUBSET relative_interior f`)));
    REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC);
    BY(SET_TAC[]);
  MATCH_MP_TAC SUBSET_RELATIVE_INTERIOR;
  SUBCONJ_TAC;
    BY(BY(ASM_MESON_TAC[ FACE_OF_IMP_CONVEX; Marchal_cells.CONVEX_HULL_SUBSET; CONVEX_HULL_EQ ; facet_of ]));
  DISCH_TAC;
  MATCH_MP_TAC AFF_DIM_EQ_AFFINE_HULL;
  ASM_REWRITE_TAC[];
  MATCH_MP_TAC (arith `a = &2 /\ b = &2 ==> (a:int) <= b`);
  CONJ_TAC;
    BY(ASM_MESON_TAC[ FACET_AFF_DIM_2]);
  BY(ASM_MESON_TAC[ AFF_DIM_CONVEX_HULL; NOT_COLLINEAR_AFF_DIM_2 ])
  ]);;
  (* }}} *)

let COLLINEAR_ORTHO_PLANE = 
prove_by_refinement(
  `!p v u0 b (u1:real^N).
    ~(v = vec 0) /\
    ~(u0 = u1) /\
    u0 dot v = b /\
    p dot v = b /\
    (u1 = u0 + v) /\
    collinear {u0,u1,p } ==>
    (p = u0)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  REPEAT (FIRST_X_ASSUM_ST `collinear` MP_TAC);
(*  ALL_SEARCH [`collinear`]; *)
  ASM_SIMP_TAC [ COLLINEAR_3_AFFINE_HULL ];
  REWRITE_TAC [ AFFINE_HULL_2_ALT ];
  REWRITE_TAC[ IN_ELIM_THM ; IN_UNIV];
  SUBST1_TAC ( VECTOR_ARITH ( `(u0 + (v:real^N) ) - u0 = v`));
  REPEAT WEAK_STRIP_TAC;
  REPEAT (FIRST_X_ASSUM_ST `dot` MP_TAC);
(*  ALL_SEARCH [`dot`]; *)
  ASM_REWRITE_TAC[];
  GOAL_TERM (fun t -> (REWRITE_TAC[ VECTOR_ARITH ( env t`(u0 + u % (v)) dot v = u0 dot v + u * (v dot v)`)]));
  DISCH_THEN SUBST1_TAC;
  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 ]));
  BY(REWRITE_TAC[ DOT_EQ_0 ])
  ]);;
  (* }}} *)

let collinear_translate_axis = 
prove_by_refinement(
  `!t u1 u2. collinear {t % u1,u1,u2} <=> collinear {vec 0 ,u1- t % u1, (u2:real^3)}`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  ONCE_REWRITE_TAC[Trigonometry2.COLLINEAR_TRANSABLE];
  REWRITE_TAC[arith `(v:real^3) - vec 0 = v`;arith `(u1:real^3) - t % u1 = (&1- t) % u1`];
  ONCE_REWRITE_TAC[Local_lemmas.COLL_IFF_COLL_CROSS];
  SUBGOAL_THEN `(&1 - t) % u1 cross (u2 - t % u1) = (&1 - t) % u1 cross u2` SUBST1_TAC;
    REWRITE_TAC[arith `x - (y:real^3) = x + (-- &1) % y`;CROSS_RADD;CROSS_LMUL;CROSS_RMUL;CROSS_REFL;VECTOR_MUL_RZERO];
    BY(VECTOR_ARITH_TAC);
  BY(REWRITE_TAC[])
  ]);;
  (* }}} *)

let azim_axis = 
prove_by_refinement(
  `!t u1 u w.    
    ~(collinear {t % u1,u1,u}) /\
    ~(collinear {t % u1,u1,w}) ==>
    azim (t % u1) u1 u w = azim (vec 0) (u1-t % u1) u w`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  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)`);
  DISCH_THEN (fun t -> ONCE_REWRITE_TAC[t]);
  REWRITE_TAC[AZIM_TRANSLATION];
  ONCE_REWRITE_TAC[arith ` ((t % u1 + u1 - t % u1) - (t % (u1:real^3) + vec 0)) = (u1 - t % u1)`];
  SUBGOAL_THEN `~(t = &1)` ASSUME_TAC;
    DISCH_TAC;
    FIRST_X_ASSUM_ST `collinear` MP_TAC;
    ASM_REWRITE_TAC[];
    ONCE_REWRITE_TAC[arith `&1 % (v:real^3) = v`];
    SUBGOAL_THEN `{u1,u1,w} = {u1,(w:real^3)}` SUBST1_TAC;
      BY(SET_TAC[]);
    BY(REWRITE_TAC[COLLINEAR_2]);
  SUBGOAL_THEN `!y. y - t % (u1:real^3) = (t/(&1 - t)) % (vec 0) + (t/ (t - &1)) % (u1 - t % u1) + (&1 % y)` ASSUME_TAC;
    GEN_TAC;
    ONCE_REWRITE_TAC[arith ` ((u:real^3) = v) <=> (u - v = vec 0)`];
    REWRITE_TAC [arith `t % vec 0 = (vec 0):real^3`];
    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)`];
    REWRITE_TAC[VECTOR_MUL_EQ_0];
    DISJ1_TAC;
    Calc_derivative.CALC_ID_TAC;
    BY(FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC);
  REWRITE_TAC[arith `x + y - x = (y:real^3)`];
  SUBGOAL_THEN `t/ (&1 - t) + t/(t - &1) + &1 = &1` ASSUME_TAC;
    Calc_derivative.CALC_ID_TAC;
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  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;
    FIRST_X_ASSUM (fun t -> ASSUME_TAC(ISPEC `w:real^3` t));
    FIRST_X_ASSUM (SUBST1_TAC);
    MATCH_MP_TAC (GSYM Topology.th1);
    ASM_REWRITE_TAC[];
    CONJ_TAC;
      BY(REAL_ARITH_TAC);
    SUBGOAL_THEN `~collinear {vec 0, u1 - t % (u1:real^3), w}` ASSUME_TAC;
      BY(ASM_MESON_TAC[collinear_translate_axis]);
    CONJ_TAC;
      MATCH_MP_TAC Fan.th3a;
      BY(ASM_REWRITE_TAC[]);
    CONJ_TAC;
      BY(ASM_MESON_TAC[Trigonometry2.COLLINEAR_TRANSABLE]);
    BY(ASM_REWRITE_TAC[]);
  ONCE_REWRITE_TAC[Rogers.AZIM_EQ_SYM];
  FIRST_X_ASSUM (fun t -> ASSUME_TAC(ISPEC `u:real^3` t));
  FIRST_X_ASSUM (SUBST1_TAC);
  MATCH_MP_TAC (GSYM Topology.th1);
  ASM_REWRITE_TAC[];
  CONJ_TAC;
    BY(REAL_ARITH_TAC);
  SUBGOAL_THEN `~collinear {vec 0, u1 - t % (u1:real^3), u}` ASSUME_TAC;
    BY(ASM_MESON_TAC[collinear_translate_axis]);
  CONJ_TAC;
    MATCH_MP_TAC Fan.th3a;
    BY(ASM_REWRITE_TAC[]);
  BY(ASM_MESON_TAC[collinear_translate_axis])
  ]);;
  (* }}} *)

let EUSOTYP2_general = 
prove_by_refinement(
  `!P c3 A n s t u v b. 
    polyhedron P /\ bounded P /\ (vec 0) IN interior P /\
    c3 facet_of P /\
    c3 SUBSET A /\ 
    ( P INTER A = c3 ) /\
    A = {p | p dot v = b} /\
    s = { c | c facet_of c3 } /\
    s HAS_SIZE n /\
    &0 < b /\
    (&0 < t ) /\ (t < &1) /\ 
    ~(collinear {vec 0,v,u}) /\
    (rcone_gt (vec 0) v t SUBSET fchanged c3) /\
   (rcone_gt (vec 0) v t INTER A SUBSET c3) ==> 
    (?g h.
       (!i. i IN 1..n ==> ((g i ) IN c3) /\ cos (arcV (vec 0) v (g i)) = t) /\ 
       (g (n+1) = g 1) /\
       (!i. i IN 1..n ==> ((h i) IN c3)) /\ 
       (!j k. j IN 1..n /\ k IN 1..n /\ (j < k) ==>  
	  azim (vec 0) v u (g j) < azim (vec 0) v u (g k)) /\ 
       (!i. i IN 1..n  ==>
	   azim (vec 0) v (g i) (h i) = (azim (vec 0) v (g i) (g (i+1)))/ &2  /\
	    azim (vec 0) v (h i) (g (i+1)) = (azim (vec 0) v (g i) (g (i+1)))/ &2) /\
      (!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)) /\ 
      (1 < n) /\
     (!i. i IN 1..n ==> ~(collinear{vec 0, v, g i}))  /\
     (!i. i IN 1..n ==> ~(collinear{vec 0,v, h i})) /\
      (!i. (i IN 1..n ==> azim (vec 0) v (g i) (g (i+1)) < pi)) 
      )`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  TYPED_ABBREV_TAC `u0 = (b / (v dot v)) % (v:real^3)`;
  TYPED_ABBREV_TAC `u1 = u0 + (v:real^3)`;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(v = vec 0)`) ASSUME_TAC));
    DISCH_TAC;
    FIRST_X_ASSUM_ST `collinear` MP_TAC;
    ASM_REWRITE_TAC[];
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`{vec 0 ,vec 0 ,u} = {vec 0,u}`) SUBST1_TAC));
      BY(SET_TAC[]);
    BY(REWRITE_TAC[COLLINEAR_2]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `&0 < v dot v`) ASSUME_TAC));
    BY(ASM_REWRITE_TAC[DOT_POS_LT]);
  GOAL_TERM (fun w -> (MP_TAC (ISPECL (  envl w[`v`;`u0`;`b`;`t`]) RDISK_R)));
  ANTS_TAC;
    BY(ASM_MESON_TAC[]);
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?a. u + a % v IN A`) MP_TAC));
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `(b - u dot v)/(v dot v)`)));
    ASM_REWRITE_TAC[IN_ELIM_THM];
    REWRITE_TAC[DOT_LADD;DOT_LMUL];
    Calc_derivative.CALC_ID_TAC;
    BY(FIRST_X_ASSUM_ST `&0 < v dot (v:real^3)` MP_TAC THEN REAL_ARITH_TAC);
  REPEAT WEAK_STRIP_TAC;
  TYPED_ABBREV_TAC ( `u2 = (u:real^3) + a % v`);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(u0 = u2)`) ASSUME_TAC));
    EXPAND_TAC "u2";
    DISCH_TAC;
    FIRST_X_ASSUM_ST `collinear` MP_TAC;
    REWRITE_TAC[];
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`?b'. u = b' % v`) MP_TAC));
      GOAL_TERM (fun w -> (EXISTS_TAC ( env w`(b / (v dot v) - a)`)));
      FIRST_X_ASSUM MP_TAC;
      EXPAND_TAC "u0";
      BY(VECTOR_ARITH_TAC);
    REPEAT WEAK_STRIP_TAC;
    ASM_REWRITE_TAC[];
    REWRITE_TAC[ (COLLINEAR_LEMMA_ALT) ];
    BY(MESON_TAC[]);
  GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w[`c3`;`A`;`n`;`{c | c facet_of c3}`;`r`;`u0`;`u1`;`u2`]) EUSOTYP_general)));
  ASM_REWRITE_TAC[];
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `polyhedron c3`) ASSUME_TAC));
    BY(ASM_MESON_TAC[ FACET_OF_IMP_FACE_OF ; FACE_OF_POLYHEDRON_POLYHEDRON ]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `bounded c3`) ASSUME_TAC));
    BY(ASM_MESON_TAC[ FACE_OF_IMP_SUBSET ; BOUNDED_SUBSET ; FACET_OF_IMP_FACE_OF ]);
  ASM_REWRITE_TAC[];
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(u1 = u0)`) ASSUME_TAC));
    EXPAND_TAC "u1";
    FIRST_X_ASSUM_ST `(v = vec 0)` MP_TAC;
    GOAL_TERM (fun w -> (ONCE_REWRITE_TAC [varith ( env w `u0 + v = u0 <=> v = vec 0`)]));
    BY(REWRITE_TAC[]);
  ASM_REWRITE_TAC[];
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{c | c facet_of c3} HAS_SIZE n`) (fun t -> REWRITE_TAC[t])));
    BY(ASM_MESON_TAC[]);
  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])));
    GEN_TAC;
    REWRITE_TAC[IN_ELIM_THM];
    REPEAT WEAK_STRIP_TAC;
    GOAL_TERM (fun w -> (FIRST_X_ASSUM_ST `rcone_gt` (MP_TAC o (ISPEC ( env w`p`)))));
    ASM_REWRITE_TAC[];
    FIRST_X_ASSUM_ST `rcone_gt` (MP_TAC);
    ASM_REWRITE_TAC[INTER;SUBSET;IN_ELIM_THM];
    BY(ASM_MESON_TAC[]);
  SUBGOAL_THEN `(u0:real^3) IN rcone_gt (vec 0) v t` ASSUME_TAC;
    REWRITE_TAC[rcone_gt ; rconesgn ; IN_ELIM_THM ; VECTOR_SUB_RZERO ; DIST_0 ];
    EXPAND_TAC "u0";
    REWRITE_TAC[ DOT_LMUL ];
    REWRITE_TAC[ NORM_MUL ];
    REWRITE_TAC[ GSYM NORM_POW_2 ];
    REWRITE_TAC[ arith `x pow 2 = x * x`];
    REWRITE_TAC[ arith `x > y <=> y < x`];
    (fun gl -> (SUBGOAL_THEN ( env gl`abs (b / (norm v * norm v)) = b / (norm v * norm v)`) SUBST1_TAC) gl);
      MATCH_MP_TAC Trigonometry2.LT_IMP_ABS_REFL;
      MATCH_MP_TAC REAL_LT_DIV;
      BY((ASM_MESON_TAC [ NORM_POW_2 ; arith `x pow 2 = x * x` ]));
    REWRITE_TAC[ arith `(a * b) * c = a * (b * c)`];
    REWRITE_TAC[ arith `x * x = x pow 2`; NORM_POW_2 ; arith `a * b * c * d = a * (b * c) * d`];
    MATCH_MP_TAC REAL_LT_LMUL;
    CONJ_TAC;
      BY((ASM_MESON_TAC [ REAL_LT_DIV ]));
    REWRITE_TAC[ arith `a * t < a <=> &0 < a * (&1 - t)`];
    BY((ASM_MESON_TAC [ REAL_LT_MUL ; arith `t < &1 <=> &0 < &1 - t`]));
  COMMENT "u0";
  SUBGOAL_THEN `(u0:real^3) IN c3` ASSUME_TAC;
    ENOUGH_TO_SHOW_TAC `(u0:real^3) IN fchanged c3 /\ (u0 IN affine hull c3)`;
      REWRITE_TAC[ GSYM IN_INTER];
      BY((ASM_MESON_TAC[FCHANGED_AFFINE; SUBSET; IN; RELATIVE_INTERIOR_SUBSET ]));
    CONJ_TAC;
      BY((ASM_MESON_TAC[SUBSET; IN]));
    GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w[`P`;`c3`;`v`;`b`]) affine_facet_hyper )));
    ANTS_TAC;
      ASM_REWRITE_TAC[];
      CONJ_TAC;
        MATCH_MP_TAC Polyhedron.INTERIOR_AFFINIE_HUL_EQ_UNIV;
        BY((ASM_MESON_TAC[]));
      EXPAND_TAC "c3";
      AP_TERM_TAC;
      ASM_REWRITE_TAC[];
      MATCH_MP_TAC EQ_EXT;
      REWRITE_TAC[ IN_ELIM_THM ];
      BY((MESON_TAC[ DOT_SYM ]));
    DISCH_THEN SUBST1_TAC;
    REWRITE_TAC[ IN_ELIM_THM ];
    EXPAND_TAC "u0";
    REWRITE_TAC [ DOT_RMUL ];
    CALC_ID_TAC;
    BY((REPEAT (FIRST_X_ASSUM MP_TAC ) THEN REAL_ARITH_TAC));
  ASM_REWRITE_TAC[];
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!v'. v' IN A <=> (v' - u0) dot v = &0`) ASSUME_TAC));
    ASM_REWRITE_TAC[IN;IN_ELIM_THM];
    EXPAND_TAC "u0";
    REWRITE_TAC[varith `v' - c % (v:real^3) = v' + (-- c) % v`;DOT_LMUL; DOT_LADD ];
    GEN_TAC;
    SUBGOAL_THEN ` -- (b / (v dot (v:real^3))) * (v dot v) = -- b` SUBST1_TAC;
      Calc_derivative.CALC_ID_TAC;
      BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
    BY(REAL_ARITH_TAC);
  ANTS_TAC;
    EXPAND_TAC "u1";
    GEN_TAC;
    REWRITE_TAC[ varith ( `(u0 + (v:real^3)) - u0 = v`)];
    BY(ASM_MESON_TAC[]);
  COMMENT "all anticedents established, ready to choose g, h";
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `g`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `h`)));
  ASM_REWRITE_TAC[];
  SUBGOAL_THEN `!(w:real^3). w IN A ==> (w dot v = b)` ASSUME_TAC;
    GEN_TAC;
    FIRST_X_ASSUM_ST `A = {p | p dot v = b}` SUBST1_TAC;
    BY(REWRITE_TAC[IN;IN_ELIM_THM]);
  SUBGOAL_THEN `!(w:real^3). w IN c3 ==> w IN A` ASSUME_TAC;
    EXPAND_TAC "c3";
    REWRITE_TAC[IN;INTER;IN_ELIM_THM];
    BY(MESON_TAC[]);
  SUBCONJ_TAC;
    GEN_TAC;
    DISCH_TAC;
    SUBCONJ_TAC;
      BY(ASM_MESON_TAC[]);
    DISCH_TAC;
    FIRST_X_ASSUM_ST `arcV` MP_TAC;
    ONCE_REWRITE_TAC[ Trigonometry2.ARC_SYM ];
    GOAL_TERM (fun w -> (DISCH_THEN (MP_TAC o (ISPEC ( env w `g i`)))));
    ANTS_TAC;
      BY(ASM_MESON_TAC[]);
    EXPAND_TAC "u0";
    GMATCH_SIMP_TAC Trigonometry2.WHEN_K_POS_ARCV_STABLE;
    EXISTS_TAC ( `(v dot (v:real^3)) / (b:real)`);
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `&0 < (v dot v) /(b:real)`) (fun t -> REWRITE_TAC [ t ])));
      REWRITE_TAC[ Calc_derivative.invert_den_lt ];
      MATCH_MP_TAC Real_ext.REAL_PROP_POS_MUL2;
      BY(ASM_REWRITE_TAC[]);
    MATCH_MP_TAC (TAUT `(a = b) ==> (a ==> b)`);
    REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
    REWRITE_TAC[ VECTOR_MUL_ASSOC ];
    SUBGOAL_THEN `(v dot v) / b *  (b:real) / ((v:real^3) dot v) = &1` SUBST1_TAC;
      Calc_derivative.CALC_ID_TAC;
      BY(ASM_SIMP_TAC[arith `&0 < x ==> ~(x = &0)`]);
    BY(VECTOR_ARITH_TAC);
  DISCH_TAC;
  SUBCONJ_TAC;
    BY(ASM_MESON_TAC[]);
  DISCH_TAC;
  SUBGOAL_THEN `!w. w IN A /\ ~(w = u0) ==> ~collinear {u0,(u1:real^3),w}` ASSUME_TAC;
    GEN_TAC;
    DISCH_TAC;
    ONCE_REWRITE_TAC[ Trigonometry2.COLLINEAR_TRANSABLE ];
    EXPAND_TAC "u1";
    SUBST1_TAC ( varith ( `(u0 + v) - (u0:real^3) = v`));
    REWRITE_TAC[ COLLINEAR_LEMMA_ALT ];
    REWRITE_TAC[ DE_MORGAN_THM ; NOT_EXISTS_THM ];
    ASM_REWRITE_TAC[];
    REPEAT WEAK_STRIP_TAC;
    SUBGOAL_THEN `(w - u0) dot v = c * ((v:real^3) dot v)` MP_TAC;
      ASM_REWRITE_TAC[];
      BY(REWRITE_TAC[ DOT_LMUL ]);
    SUBGOAL_THEN `(w - u0) dot (v:real^3) = &0` SUBST1_TAC;
      BY(ASM_MESON_TAC[]);
    MATCH_MP_TAC (arith `~(c = &0) /\ (&0 < x) ==> (&0 = c * x ==> F)` );
    ASM_REWRITE_TAC[];
    DISCH_TAC;
    FIRST_X_ASSUM_ST `(%)` MP_TAC;
    ASM_REWRITE_TAC[ VECTOR_MUL_LZERO ];
    BY(ASM_REWRITE_TAC[ varith `(w - u0 = vec 0) <=> (w = (u0:real^3))`]);
  SUBGOAL_THEN `!(w:real^3). (w IN A) /\ ~(w = u0) ==> ~collinear {(vec 0),v,w}` ASSUME_TAC;
    REPEAT WEAK_STRIP_TAC;
    FIRST_X_ASSUM MP_TAC;
    REWRITE_TAC[ COLLINEAR_LEMMA_ALT ];
    ASM_REWRITE_TAC[ DE_MORGAN_THM ; NOT_EXISTS_THM ];
    REPEAT WEAK_STRIP_TAC;
    SUBGOAL_THEN `(w - u0) dot v = (c - b/ (v dot v)) * ((v:real^3) dot v)` MP_TAC;
      ASM_REWRITE_TAC[];
      EXPAND_TAC "u0";
      BY(REWRITE_TAC[ varith `c % (v:real^3) - x % v = (c - x) % v`; DOT_LMUL ]);
    SUBGOAL_THEN `(w - u0) dot (v:real^3) = &0` SUBST1_TAC;
      BY(ASM_MESON_TAC[]);
    MATCH_MP_TAC (arith `~(c = &0) /\ (&0 < x) ==> (&0 = c * x ==> F)` );
    ASM_REWRITE_TAC[];
    ONCE_REWRITE_TAC[arith `~(x -y = &0) <=> ~(x = y)`];
    DISCH_TAC;
    FIRST_X_ASSUM_ST `(%)` MP_TAC;
    BY(ASM_REWRITE_TAC[ ]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(!i. i IN 1..n ==> ~collinear {vec 0, v, g i})`) ASSUME_TAC));
    BY(ASM_MESON_TAC[]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w` (!i. i IN 1..n ==> ~collinear {vec 0, v, h i})`) ASSUME_TAC));
    BY(ASM_MESON_TAC[]);
  ASM_REWRITE_TAC[];
  SUBGOAL_THEN (`!w w'. w IN A /\ w' IN A ==> (w - w') dot (v:real^3) = &0`) ASSUME_TAC;
    ASM_REWRITE_TAC[];
    REPEAT WEAK_STRIP_TAC;
    ONCE_REWRITE_TAC [varith `(w - w') = (w - u0) + (-- &1) % (w' - (u0:real^3))`];
    REWRITE_TAC[ DOT_LADD ; DOT_LMUL ];
    BY(FIRST_X_ASSUM MP_TAC THEN FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC);
  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;
    REPEAT WEAK_STRIP_TAC;
    ONCE_REWRITE_TAC[ DOT_SYM ];
    FIRST_X_ASSUM MP_TAC;
    MATCH_MP_TAC (arith `(-- &1) * x +  y = &0 ==> (x = &0 ==> y = &0)`);
    REWRITE_TAC[ GSYM DOT_LADD ; GSYM DOT_LMUL ];
    REWRITE_TAC[varith `( -- &1 % ((w:real^3) - u0) + w) = u0 `];
    EXPAND_TAC "u0";
    REWRITE_TAC[ DOT_LMUL ;REAL_ENTIRE];
    BY(ASM_MESON_TAC[ DOT_SYM ]);
  SUBGOAL_THEN `1 IN 1..n` ASSUME_TAC;
    BY(ASM_SIMP_TAC[ IN_NUMSEG ; arith `1 <= 1 /\ (1 < n ==> 1 <= n)` ]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!i. i IN 1..n ==> g (i + 1) IN c3`) ASSUME_TAC));
    GEN_TAC;
    SUBGOAL_THEN `i IN 1..n ==> (i+1) IN 1..n \/ (i=n)` ASSUME_TAC;
      REWRITE_TAC[ IN_NUMSEG ];
      BY(ARITH_TAC);
    BY(ASM_MESON_TAC[]);
  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])));
    BY(ASM_MESON_TAC[]);
  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;
    REPEAT WEAK_STRIP_TAC;
    SUBGOAL_THEN `~collinear {u0, u1,w} /\ ~collinear {u0,u1,(w':real^3)}` MP_TAC;
      BY(ASM_MESON_TAC[]);
    SUBGOAL_THEN `?t. (u0:real^3) = t % u1 /\ v = u1 - t % u1` MP_TAC;
      EXISTS_TAC `(b:real)/ (v dot v) / (&1 + b / (v dot (v:real^3)))`;
      MATCH_MP_TAC (varith ` (a = b) /\ ( c = (d:real^3) - a) ==> (a = b /\ c = d - b)`);
      EXPAND_TAC "u1";
      REWRITE_TAC[varith ` (u0 + v) - u0 = (v:real^3) `];
      EXPAND_TAC "u0";
      TYPED_ABBREV_TAC `b' = b / (v dot (v:real^3))`;
      ONCE_REWRITE_TAC[VECTOR_ARITH `b' % (v:real^3) + v = (b' + &1) % v`];
      REWRITE_TAC[ VECTOR_MUL_ASSOC ];
      REWRITE_TAC[ VECTOR_MUL_RCANCEL ];
      DISJ1_TAC;
      Calc_derivative.CALC_ID_TAC;
      EXPAND_TAC "b'";
      MATCH_MP_TAC (arith `&0 < x ==> ~(&1 + x = &0)`);
      REWRITE_TAC[ Calc_derivative.invert_den_lt ; Real_ext.REAL_PROP_POS_MUL2 ];
      MATCH_MP_TAC Real_ext.REAL_PROP_POS_MUL2;
      BY(ASM_REWRITE_TAC[]);
    WEAK_STRIP_TAC;
    ASM_REWRITE_TAC[];
    BY(ASM_MESON_TAC[azim_axis]);
  CONJ_TAC;
    REPEAT WEAK_STRIP_TAC;
    SUBGOAL_THEN `(!l. l IN 1..n ==> azim u0 u1 u2 (g l) = azim (vec 0) v u (g l))` ASSUME_TAC;
      REPEAT WEAK_STRIP_TAC;
      SUBGOAL_THEN `azim (vec 0) v u (g l) = azim (vec 0) v u2 (g (l:num))` SUBST1_TAC;
        EXPAND_TAC "u2";
        MATCH_MP_TAC EQ_SYM;
        ONCE_REWRITE_TAC [ Rogers.AZIM_EQ_SYM ];
        SUBGOAL_THEN `(u:real^3) + a % v = (-- a) % (vec 0) + a % v + (&1) % u` SUBST1_TAC;
          BY(VECTOR_ARITH_TAC);
        MATCH_MP_TAC (GSYM Topology.th1);
        CONJ_TAC;
          BY(REAL_ARITH_TAC);
        CONJ_TAC;
          BY(REAL_ARITH_TAC);
        BY(ASM_MESON_TAC[ Fan.th3a ]);
      FIRST_X_ASSUM MATCH_MP_TAC;
      BY(ASM_MESON_TAC[]);
    BY(ASM_MESON_TAC[]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!i. i IN 1..n ==> ~(g (i+1) = u0)`) ASSUME_TAC));
    REPEAT WEAK_STRIP_TAC;
    SUBGOAL_THEN `i IN 1..n ==> (i + 1 IN 1..n) \/ (i = n)` ASSUME_TAC;
      REWRITE_TAC[ IN_NUMSEG ];
      BY(ARITH_TAC);
    BY(ASM_MESON_TAC[]);
  REPEAT (FIRST_X_ASSUM_ST `dot` (fun t -> ALL_TAC));
  REPEAT (FIRST_X_ASSUM_ST `collinear` (fun t -> ALL_TAC));
  REPEAT (FIRST_X_ASSUM_ST `rcone_gt` (fun t -> ALL_TAC));
  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;
    BY(ASM_MESON_TAC[]);
  SUBGOAL_THEN `!i. i IN 1..n ==> ~(g i = u0) /\ ~(g (i+1) = u0) /\ ~( h i = (u0:real^3))` ASSUME_TAC;
    BY(ASM_MESON_TAC[]);
  REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC);
  FIRST_X_ASSUM_ST `azim` MP_TAC;
  FIRST_X_ASSUM_ST `pi` MP_TAC;
  FIRST_X_ASSUM_ST `&2` MP_TAC;
  REPEAT (FIRST_X_ASSUM (fun t -> ALL_TAC));
  REPEAT WEAK_STRIP_TAC;
  CONJ_TAC;
    REPEAT WEAK_STRIP_TAC;
    SUBGOAL_THEN (`azim (vec 0) v (g (i:num)) (h i) = azim u0 u1 (g i) (h i)`) SUBST1_TAC;
      BY(ASM_MESON_TAC[]);
    SUBGOAL_THEN (`azim (vec 0) v (g (i:num)) (g (i+1)) = azim u0 u1 (g i) (g (i+1))`) SUBST1_TAC;
      BY(ASM_MESON_TAC[]);
    SUBGOAL_THEN (`azim (vec 0) v (h (i:num)) (g (i+1)) = azim u0 u1 (h i) (g (i+1))`) SUBST1_TAC;
      BY(ASM_MESON_TAC[]);
    BY(ASM_SIMP_TAC[]);
  BY(ASM_MESON_TAC[])
  ]);;
  (* }}} *)

let CONE0_SUBSET_WEDGE = 
prove_by_refinement(
  `!v u w.
    ~collinear { vec 0, v, u} /\
    ~collinear { vec 0, v, w} /\
    &0 < azim (vec 0) v u w /\
    azim (vec 0) v u w < pi
    ==>
    cone0 (vec 0) {v,u,w} SUBSET wedge (vec 0) v u w`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  ENOUGH_TO_SHOW_TAC `wedge (vec 0) v u w = aff_gt {(vec 0),v} {u,w}`;
    BY((MESON_TAC[cone0_subset_lune]));
  MATCH_MP_TAC WEDGE_LUNE_GT;
  BY((ASM_REWRITE_TAC[]))
  ]);;
  (* }}} *)

let FACET_INTER_DISJOINT = 
prove_by_refinement(
  `!(p:real^A->bool) f.
    polyhedron p /\
    vec 0 IN interior p /\
    f facet_of p ==> ~((vec 0) IN f)`,

  (* {{{ proof *)
  [
  REPEAT GEN_TAC;
  REWRITE_TAC[ facet_of ];
  GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w[`f`;`p`]) FACE_OF_DISJOINT_INTERIOR)));
  REWRITE_TAC[ Local_lemmas.EMPTY_NOT_EXISTS_IN ];
  REWRITE_TAC[ INTER; IN;];
  REWRITE_TAC[ INTER; IN; IN_ELIM_THM];
  BY(ASM_MESON_TAC[ arith `~(x = (x:int) - &1)`])
  ]);;
  (* }}} *)

let CONE0_AFF_GT = 
prove_by_refinement(
  `!x U. cone0 (x:real^A) U = aff_gt {x } U`,

  (* {{{ proof *)
  [
  BY(REWRITE_TAC[cone0;Sphere.aff_gt_def])
  ]);;
  (* }}} *)

let DISJOINT0_SCALE = 
prove_by_refinement(
  `!t (u0:real^A) u1 u2.
    DISJOINT { (vec 0) } { u0,u1,u2 } /\
    ~(t = &0)  ==>
        DISJOINT { (vec 0) } { t % u0,u1,u2 } 
    `,

  (* {{{ proof *)
  [
  REWRITE_TAC[DISJOINT; Collect_geom2.INTER_DISJONT_EX ];
  REWRITE_TAC[ IN_SING; IN_INSERT];
  BY(MESON_TAC[ VECTOR_MUL_EQ_0 ; ])
  ]);;
  (* }}} *)

let CONE0_SCALE = 
prove_by_refinement(
  `!t (u0:real^A) u1 u2.
    DISJOINT { (vec 0) } { u0,u1,u2 } /\
    &0 < t ==>
   cone0 (vec 0) {u0, u1,u2 } = cone0 (vec 0) {t % u0,u1,u2 }`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC[ CONE0_AFF_GT];
  ASM_SIMP_TAC [ Vol1.AFF_GT_1_3 ;DISJOINT0_SCALE; arith `&0 < t ==> ~(t = &0)`];
  ONCE_REWRITE_TAC[FUN_EQ_THM];
  REWRITE_TAC[IN_ELIM_THM];
  REWRITE_TAC[arith `t % (vec 0) = vec 0 /\ (vec 0) + u = u`];
  GEN_TAC;
  ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e <=> d /\ (a /\ b /\ c /\ e)`];
  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)))`];
  SUBGOAL_THEN `!t2 t3 t4. ?t1. t1 + t2 + t3 + t4 = &1` (fun t -> REWRITE_TAC [ t]);
    REPEAT WEAK_STRIP_TAC;
    EXISTS_TAC `&1 - t2 - t3 - t4`;
    BY(REAL_ARITH_TAC);
  ONCE_REWRITE_TAC[ Geomdetail.EQ_EXPAND ];
  REPEAT WEAK_STRIP_TAC;
  CONJ_TAC;
    REPEAT WEAK_STRIP_TAC;
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `t2 / t`)));
    EXISTS_TAC `t3:real`;
    EXISTS_TAC `t4:real`;
    REWRITE_TAC[ VECTOR_MUL_ASSOC ];
    SUBGOAL_THEN `t2 / t * t = t2` SUBST1_TAC;
      Calc_derivative.CALC_ID_TAC;
      BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
    ASM_REWRITE_TAC[];
    MATCH_MP_TAC REAL_LT_DIV;
    BY(ASM_REWRITE_TAC[]);
  REWRITE_TAC[ VECTOR_MUL_ASSOC ];
  REPEAT WEAK_STRIP_TAC;
  EXISTS_TAC (`t2 * t`);
  EXISTS_TAC `t3:real`;
  EXISTS_TAC `t4:real`;
  ASM_REWRITE_TAC[];
  MATCH_MP_TAC REAL_LT_MUL;
  BY(ASM_REWRITE_TAC[])
  ]);;
  (* }}} *)

let CONE0_FCHANGED_SCALE = 
prove_by_refinement(
  ` !p f (u0:real^3) u1 u2 t.
         polyhedron p /\
         bounded p /\
         vec 0 IN interior p /\
         f facet_of p /\
         ~coplanar { (vec 0), u0,u1, u2 } /\ 
         {t % u0,  u1,  u2} SUBSET f /\
      &0 < t 
         ==> cone0 (vec 0) {u0, u1, u2} SUBSET fchanged f`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(u1 = vec 0) /\ ~(u2 = vec 0) /\ ~collinear {u0,u1,u2}`) MP_TAC));
    CONJ_TAC;
      BY(ASM_MESON_TAC[ Planarity.notcoplanar_disjoint ]);
    CONJ_TAC;
      BY(ASM_MESON_TAC[ Planarity.notcoplanar_disjoint ]);
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`{ vec 0 , u0 , u1, u2} = {u0,u1 , u2, vec 0}`) ASSUME_TAC));
      BY(SET_TAC[]);
    BY(ASM_MESON_TAC[ NOT_COPLANAR_NOT_COLLINEAR ]);
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `cone0 (vec 0) {u0,u1,u2} = cone0 (vec 0) {t % u0,u1,u2}`) SUBST1_TAC));
    GOAL_TERM (fun w -> (ASM_CASES_TAC ( env w `u0 = vec 0`)));
      BY(ASM_REWRITE_TAC[ VECTOR_MUL_RZERO ]);
    MATCH_MP_TAC CONE0_SCALE;
    ASM_REWRITE_TAC[];
    REWRITE_TAC[ DISJOINT ];
    REWRITE_TAC[ Local_lemmas.EMPTY_NOT_EXISTS_IN ];
    REWRITE_TAC[ IN_SING ; IN_INTER ; IN_INSERT ];
    BY(ASM_MESON_TAC[]);
  MATCH_MP_TAC CONE0_FCHANGED;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `p`)));
  ASM_REWRITE_TAC[];
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~coplanar { vec 0, t % u0, u1, u2}`) ASSUME_TAC));
    BY(ASM_MESON_TAC[ COPLANAR_SPECIAL_SCALE ; arith `&0 < t ==> ~(t = &0)`]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`{ vec 0 , t % u0 , u1, u2} = {t % u0,u1 , u2, vec 0}`) ASSUME_TAC));
    BY(SET_TAC[]);
  BY(ASM_MESON_TAC[ NOT_COPLANAR_NOT_COLLINEAR ])
  ]);;
  (* }}} *)

let gotcjah_sol_half = 
prove_by_refinement(
  `!c3 v b P W t rho bet (w0:real^3) w1 s.
    polyhedron P /\ bounded P /\ (&0 < b) /\
    (vec 0 IN interior P) /\
    (c3 facet_of P) /\
    (fchanged c3 = W) /\
    (&0 < t /\ t < &1 ) /\
    (&0 < rho) /\
    (&0 < s) /\ 
    (P INTER { p | p dot v = b } = c3) /\ 
    rcone_gt (vec 0) v t SUBSET W /\
    ~(v = vec 0) /\
    &0 < v dot v /\
    cos (arcV(vec 0) v w0) = t /\
    s % v IN c3 /\
    w0 IN c3 /\
    w1 IN c3 /\
    ~coplanar {(vec 0), v, w0, w1 } /\
    // ~collinear {(vec 0), v, w0} /\
    // ~collinear {(vec 0), v, w1} /\
    // &0 < dihV (vec 0) v w0 w1 /\
    // dihV (vec 0) v w0 w1  < pi /\
    dihV (vec 0) v w0 w1 = bet /\
    (w1 - w0) dot v = &0 /\
    (w1 - w0) dot w0 = &0 
  ==>
    (?X.  
       X = cone0 (vec 0) {v,w0,w1} /\
      X SUBSET (aff_gt { (vec 0), v } { w0, w1} INTER W) /\
       measurable (X INTER normball (vec 0) rho) /\
       radial_norm rho (vec 0) (X INTER normball (vec 0) rho) /\
        (bet - asn (sin bet * t)) = sol (vec 0) X)
`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  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));
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{(vec 0), v,w0,w1} = {(vec 0),v,w1,w0}`) ASSUME_TAC));
      BY(SET_TAC []);
    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)`]);
  REPEAT WEAK_STRIP_TAC;
  EXISTS_TAC `cone0 (vec 0) {v,w0,(w1:real^3)}`;
  REWRITE_TAC[ ];
  CONJ_TAC;
    REWRITE_TAC[ Misc_defs_and_lemmas.SUBSET_INTER ];
    CONJ_TAC;
      BY(REWRITE_TAC[ cone0_subset_lune ]);
    EXPAND_TAC "W";
    MATCH_MP_TAC CONE0_FCHANGED_SCALE;
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w`P`)));
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w`s`)));
    ASM_REWRITE_TAC[];
    REWRITE_TAC[SUBSET;IN_INSERT];
    BY(ASM_MESON_TAC[ NOT_IN_EMPTY ]);
  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));
    REPEAT WEAK_STRIP_TAC;
    ONCE_REWRITE_TAC[ INTER_COMM ];
    ONCE_REWRITE_TAC[ NORMBALL_BALL ];
    ONCE_REWRITE_TAC[ CONE0_AFF_GT ];
    BY(REWRITE_TAC[ MEASURABLE_BALL_AFF_GT ]);
  ASM_SIMP_TAC[];
  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));
    REPEAT WEAK_STRIP_TAC;
    REWRITE_TAC[ CONE0_AFF_GT ];
    MATCH_MP_TAC Vol1.aff_gt_radial;
    CONJ_TAC;
      REWRITE_TAC[ DISJOINT ; Local_lemmas.EMPTY_NOT_EXISTS_IN ];
      REWRITE_TAC[ IN_SING; IN_INTER; IN_INSERT ];
      BY(ASM_MESON_TAC [ Planarity.notcoplanar_disjoint ]);
    BY(FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC);
  ASM_SIMP_TAC[];
  GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`w0`;`v`;`w1`]) vol_solid_triangle_ortho)));
  ASM_REWRITE_TAC[];
  ANTS_TAC;
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`{vec 0 ,w0, v, w1} = {vec 0 ,v,w0,w1}`) SUBST1_TAC));
      BY(SET_TAC []);
    BY(ASM_REWRITE_TAC[]);
  LET_TAC;
  LET_TAC;
  DISCH_THEN (fun t -> REWRITE_TAC [ GSYM t ]);
  GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`(vec 0):real^3`;`cone0 (vec 0) {v,w0,w1}`;`rho'`]) Pack_defs.sol)));
  GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`(vec 0):real^3`;`cone0 (vec 0) {v,w0,w1}`;`&1`]) Pack_defs.sol)));
  ASM_SIMP_TAC[arith `&0 < &1`;arith `x < y ==> y > x`];
  DISCH_THEN (fun t -> ALL_TAC);
  DISCH_THEN (fun t -> REWRITE_TAC[ GSYM t]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`{(vec 0),w0,v,w1}= {vec 0, v,w0,w1}`) ASSUME_TAC));
    BY(SET_TAC []);
  ASM_SIMP_TAC[arith `&1 > &0`;GSYM volume_props];
  REWRITE_TAC[solid_triangle];
  REWRITE_TAC[arith `x / &1 pow 3 = x`];
  REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`{w0,v,w1} = {v,w0,w1}`) MP_TAC));
    BY(SET_TAC[]);
  BY(MESON_TAC[INTER_COMM])
  ]);;

let  AZIM_LE_PI_EQ_DIHV_ALT = 
prove_by_refinement(
  `!a b x y. ~collinear {a, b, x} /\ ~collinear {a, b, y} /\
      azim a b x y <= pi
      ==> dihV a b x y = azim a b x y`,

  (* {{{ proof *)
  [
    MESON_TAC[Local_lemmas.AZIM_LE_PI_EQ_DIHV];
  ]);;
  (* }}} *)

let gotcjah_sol_lemma = 
prove_by_refinement(
  `!c3 v b P W t rho bet (w0:real^3) w1 w2 s.
    polyhedron P /\ bounded P /\ (&0 < b) /\
    (vec 0 IN interior P) /\
    (c3 facet_of P) /\
    (fchanged c3 = W) /\
    (&0 < t /\ t < &1 ) /\
    (&0 < rho) /\
    (&0 < s) /\
    (P INTER { p | p dot v = b } = c3) /\ 
    rcone_gt (vec 0) v t SUBSET W /\
    ~(v = vec 0) /\
    &0 < v dot v /\
    cos (arcV(vec 0) v w0) = t /\
    cos (arcV(vec 0) v w2) = t /\
    s % v IN c3 /\
    w0 IN c3 /\
    w1 IN c3 /\
    w2 IN c3 /\
    ~collinear {(vec 0), v, w0} /\
    ~collinear {(vec 0), v, w1} /\
    ~collinear {(vec 0), v, w2} /\
    s % v IN c3 /\
    w0 IN c3 /\
    w1 IN c3 /\
    w2 IN c3 /\
    azim (vec 0) v w0 w2 / &2 = bet /\
    // &0 < azim (vec 0) v w0 w2 /\
    azim (vec 0) v w0 w2 < pi /\
    azim (vec 0) v w0 w1 = bet /\
    azim (vec 0) v w1 w2 = bet /\
    (w1 - w0) dot v = &0 /\
    (w1 - w0) dot w0 = &0 /\
    (w1 - w2) dot v = &0 /\
    (w1 - w2) dot w2 = &0 
  ==>
    (?X.  X SUBSET (wedge (vec 0) v w0 w2 INTER W) /\
       measurable (X INTER normball (vec 0) rho) /\
       radial_norm rho (vec 0) (X INTER normball (vec 0) rho) /\
       &2 * (bet - asn (sin bet * t)) = sol (vec 0) X)
`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `dihV (vec 0) v w0 w1 = bet /\ dihV (vec 0) v w1 w2 = bet`) MP_TAC));
    GMATCH_SIMP_TAC AZIM_LE_PI_EQ_DIHV_ALT;
    GMATCH_SIMP_TAC AZIM_LE_PI_EQ_DIHV_ALT;
    ASM_REWRITE_TAC[];
    REPEAT (FIRST_X_ASSUM_ST `azim` MP_TAC);
    MP_TAC PI_POS;
    BY(REAL_ARITH_TAC);
  REPEAT WEAK_STRIP_TAC;
  COMMENT "CHANGE STARTS HERE";
  SUBGOAL_THEN `azim (vec 0) v w0 w2 = &0 \/ &0 < azim (vec 0) v w0 w2` MP_TAC;
    BY(MESON_TAC[AZIM_NN; arith `&0 <= x ==> (x = &0) \/ &0 < x`]);
  DISCH_THEN DISJ_CASES_TAC;
    EXISTS_TAC (`{}:real^3->bool`);
    REWRITE_TAC[INTER_EMPTY ; MEASURABLE_EMPTY; Conforming.RADIAL_EMPTY ];
    REWRITE_TAC[ EMPTY_SUBSET ];
    REWRITE_TAC[ Conforming.SOL_EMPTY ];
    FIRST_X_ASSUM_ST `&2` MP_TAC;
    ASM_REWRITE_TAC[];
    REWRITE_TAC[arith `&0/ &2 = bet <=> bet = &0`];
    DISCH_THEN SUBST1_TAC;
    REWRITE_TAC[ SIN_0 ; ASN_0; arith `&0 * t = &0`];
    BY(REAL_ARITH_TAC);
    (COMMENT "CHANGE ENDS HERE");
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`~coplanar {(vec 0),v,w0,w1} /\ ~coplanar {(vec 0),v,w1,w2}`) MP_TAC));
    ASSUME_TAC DIHV_EQ_0_PI_EQ_COPLANAR;
    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)`)));
      BY(ASM_MESON_TAC[]);
    REPEAT (FIRST_X_ASSUM_ST `azim` MP_TAC);
    MP_TAC PI_POS;
    REPEAT (FIRST_X_ASSUM_ST `dihV` MP_TAC);
    BY(REAL_ARITH_TAC);
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `cone0 (vec 0) {v,w0,w1}  UNION cone0 (vec 0) {v,w2,w1}`)));
  REWRITE_TAC[ UNION_SUBSET ];
  ONCE_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[UNION_OVER_INTER];
  GMATCH_SIMP_TAC MEASURABLE_UNION;
  GMATCH_SIMP_TAC Conforming.RADIAL_UNION;
  GMATCH_SIMP_TAC Conforming.SOL_DISJOINT_UNION;
  ONCE_REWRITE_TAC[arith `u2 = x + y <=> u2 - (x + y) = &0`];
  GMATCH_SIMP_TAC (arith `u = x /\ u = y ==> &2 * u - ( x + y) = &0`);
  GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`c3`;`v`;`b`;`P`;`W`;`t`;`rho'`;`bet`;`w0`;`w1`;`s`]) gotcjah_sol_half)));
  ASM_REWRITE_TAC[];
  WEAK_STRIP_TAC;
  FIRST_X_ASSUM_ST `cone0` (ASSUME_TAC o SYM);
  ASM_REWRITE_TAC[];
  GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`c3`;`v`;`b`;`P`;`W`;`t`;`rho'`;`bet`;`w2`;`w1`;`s`]) gotcjah_sol_half)));
  ASM_REWRITE_TAC[];
  ANTS_TAC;
    CONJ_TAC;
      FIRST_X_ASSUM_ST `coplanar` MP_TAC;
      GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w`{vec 0 , v,w1,w2} = {vec 0, v, w2,w1}`)));
        BY(MESON_TAC[]);
      BY(SET_TAC[]);
    ONCE_REWRITE_TAC[ DIHV_SYM ];
    BY(ASM_REWRITE_TAC[]);
  WEAK_STRIP_TAC;
  FIRST_X_ASSUM_ST `cone0` (ASSUME_TAC o SYM);
  ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC[INTER_COMM];
  ASM_REWRITE_TAC[];
  MATCH_MP_TAC (TAUT `b /\ c /\ a ==> a /\ b /\ c`);
  GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`(vec 0):real^3`;`v`;`w0`;`w2`;`w1`]) WEDGE_SPLIT)));
  ASM_REWRITE_TAC[];
  ANTS_TAC;
    REWRITE_TAC[wedge; IN;IN_ELIM_THM];
    ASM_REWRITE_TAC[];
    MP_TAC PI_POS;
    REPEAT (FIRST_X_ASSUM_ST `azim` MP_TAC);
    BY(REAL_ARITH_TAC);
  REPEAT WEAK_STRIP_TAC;
  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;
    GMATCH_SIMP_TAC WEDGE_LUNE_GT;
    GMATCH_SIMP_TAC WEDGE_LUNE_GT;
    ASM_REWRITE_TAC[];
    ASSUME_TAC PI_POS;
    CONJ_TAC;
      BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
    CONJ_TAC;
      BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
    REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
    BY(SET_TAC[]);
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC (TAUT `c /\ a /\ b ==> a /\ b /\ c`);
  CONJ_TAC;
    EXISTS_TAC `rho':real`;
    ONCE_REWRITE_TAC[INTER_COMM];
    ASM_REWRITE_TAC[];
    ASM_SIMP_TAC[arith `&0 < x ==> x > &0`;DISJOINT];
    ENOUGH_TO_SHOW_TAC `?Y Y'. X SUBSET Y /\ X' SUBSET Y' /\ Y INTER (Y':real^3->bool) = {}`;
      BY(SET_TAC[]);
    REPEAT (FIRST_X_ASSUM_ST `wedge` MP_TAC);
    REPEAT (FIRST_X_ASSUM_ST `aff_gt` MP_TAC);
    BY(MESON_TAC[ SUBSET_INTER]);
  REPEAT (FIRST_X_ASSUM_ST `wedge` MP_TAC);
  REPEAT (FIRST_X_ASSUM_ST `aff_gt` MP_TAC);
  BY(SET_TAC[])
  ]);;

let c3_lemma = 
prove_by_refinement(
  `!c3 (v:real^3) b.
    c3 SUBSET { p | p dot v = b } /\
    &0 < b ==>
    ({p | p dot v = b} INTER fchanged c3 SUBSET c3)`,

  (* {{{ proof *)
  [
  ONCE_REWRITE_TAC[INTER;SUBSET];
  REWRITE_TAC[IN;INTER;IN_ELIM_THM];
  REWRITE_TAC[ Polyhedron.fchanged ;IN_ELIM_THM];
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`c3 v1`) ASSUME_TAC));
    BY(ASM_MESON_TAC[ SUBSET;IN;IN_ELIM_THM;RELATIVE_INTERIOR_SUBSET ]);
  SUBGOAL_THEN`t * b = b` ASSUME_TAC;
    BY(ASM_MESON_TAC[ DOT_LMUL ]);
  SUBGOAL_THEN `t = &1` ASSUME_TAC;
    MATCH_MP_TAC (REAL_RING `~(b = &0) /\ (t * b= b) ==> (t = &1)`);
    BY(ASM_SIMP_TAC [arith `&0 < b==> ~(b = &0)`]);
  BY(ASM_MESON_TAC[arith `&1 % (v1:real^3) = v1`])
  ]);;
  (* }}} *)

let NOT_COLLINEAR = 
prove_by_refinement(
  `!(v:real^3). ~(v = vec 0)==> (?u. ~collinear {(vec 0),v,u})`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  ASM_SIMP_TAC [ Local_lemmas.COLLINEAR_ONCE_VEC_0 ];
  SUBGOAL_THEN `&0 < (v:real^3) dot v` ASSUME_TAC;
    BY(ASM_REWRITE_TAC[DOT_POS_LT]);
  GOAL_TERM (fun w -> (MP_TAC (ISPEC ( env w `v`) Trigonometry2.EXISTS_OTHOR_VECTOR_DIFFF_VEC0)));
  REPEAT WEAK_STRIP_TAC;
  EXISTS_TAC `v':real^3`;
  REWRITE_TAC[ NOT_EXISTS_THM ];
  GEN_TAC;
  ONCE_REWRITE_TAC[MESON[] `a = b <=> (b = a)`];
  DISCH_TAC;
  REPEAT (FIRST_X_ASSUM_ST `0` MP_TAC);
  EXPAND_TAC "v'";
  REWRITE_TAC[DOT_RMUL];
  REWRITE_TAC[REAL_ENTIRE];
  REWRITE_TAC[ VECTOR_MUL_EQ_0 ];
  BY(REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let gotcjah_prep = 
prove_by_refinement(
  `!c v b P  WF t n u0 A. 
    polyhedron P /\ bounded P /\  (&0 < b) /\
    (vec 0 IN interior P) /\ 
    c facet_of P /\ 
    ( { (p:real^3) | p dot v = b} = A) /\
    ( (b / (v dot v)) % (v:real^3) = u0 ) /\ 
    fchanged c = WF /\
    (&0 < t /\ t < &1) /\
    (P INTER { p | p dot v = b } = c) /\ 
    rcone_gt (vec 0) v t SUBSET WF /\
    ( {f | f facet_of c } HAS_SIZE n) ==>
    (c SUBSET A) /\
    ( ~((v:real^3) = vec 0)   )  /\
    ( &0 < (v:real^3) dot v ) /\ 
    ( (u0:real^3) IN rcone_gt (vec 0) v t ) /\ 
    ( (u0:real^3) IN c ) /\
    ( rcone_gt (vec 0) v t INTER A SUBSET c ) /\
    ( ?u. ~(collinear {(vec 0), v, u }))`,

  (* {{{ proof *)
  [
  X_GENv_TAC "c3";
  REPEAT WEAK_STRIP_TAC;
  SUBCONJ_TAC;
    FIRST_X_ASSUM_ST `INTER` MP_TAC;
    ASM_REWRITE_TAC[];
    BY(SET_TAC[]);
  DISCH_TAC;
  SUBGOAL_THEN `~((v:real^3) = vec 0)` ASSUME_TAC;
    DISCH_TAC;
    HASH_UNDISCH_TAC 2896;
    ASM_REWRITE_TAC[DOT_RZERO];
    REWRITE_TAC[ FUN_EQ_THM ;IN_ELIM_THM];
    DISCH_TAC;
    (fun gl -> (SUBGOAL_THEN ( env gl`A = {}`) ASSUME_TAC) gl);
      BY((REPEAT (FIRST_X_ASSUM MP_TAC) THEN SET_TAC[arith `&0 < b ==> ~(&0 = b)`]));
    (fun gl -> (SUBGOAL_THEN ( env gl`c3 = {}`) ASSUME_TAC) gl);
      FIRST_X_ASSUM_ST `SUBSET` MP_TAC;
      FIRST_X_ASSUM MP_TAC;
      BY(SET_TAC[]);
    BY((ASM_MESON_TAC[ facet_of ]));
  COMMENT "1";
  COMMENT "v dot v";
  SUBGOAL_THEN `&0 < (v:real^3) dot v` ASSUME_TAC;
    BY((ASM_REWRITE_TAC[DOT_POS_LT]));
  COMMENT "subgoal";
  ASM_SIMP_TAC[ NOT_COLLINEAR ];
  SUBCONJ_TAC;
    REWRITE_TAC[rcone_gt ; rconesgn ; IN_ELIM_THM ; VECTOR_SUB_RZERO ; DIST_0 ];
    EXPAND_TAC "u0";
    REWRITE_TAC[ DOT_LMUL ];
    REWRITE_TAC[ NORM_MUL ];
    REWRITE_TAC[ GSYM NORM_POW_2 ];
    REWRITE_TAC[ arith `x pow 2 = x * x`];
    REWRITE_TAC[ arith `x > y <=> y < x`];
    (fun gl -> (SUBGOAL_THEN ( env gl`abs (b / (norm v * norm v)) = b / (norm v * norm v)`) SUBST1_TAC) gl);
      MATCH_MP_TAC Trigonometry2.LT_IMP_ABS_REFL;
      MATCH_MP_TAC REAL_LT_DIV;
      BY((ASM_MESON_TAC [ NORM_POW_2 ; arith `x pow 2 = x * x` ]));
    REWRITE_TAC[ arith `(a * b) * c = a * (b * c)`];
    REWRITE_TAC[ arith `x * x = x pow 2`; NORM_POW_2 ; arith `a * b * c * d = a * (b * c) * d`];
    MATCH_MP_TAC REAL_LT_LMUL;
    CONJ_TAC;
      BY((ASM_MESON_TAC [ REAL_LT_DIV ]));
    REWRITE_TAC[ arith `a * t < a <=> &0 < a * (&1 - t)`];
    BY((ASM_MESON_TAC [ REAL_LT_MUL ; arith `t < &1 <=> &0 < &1 - t`]));
  DISCH_TAC;
  COMMENT "u0";
  SUBGOAL_THEN `(u0:real^3) IN c3` ASSUME_TAC;
    ENOUGH_TO_SHOW_TAC `(u0:real^3) IN fchanged c3 /\ (u0 IN affine hull c3)`;
      REWRITE_TAC[ GSYM IN_INTER];
      BY((ASM_MESON_TAC[FCHANGED_AFFINE; SUBSET; IN; RELATIVE_INTERIOR_SUBSET ]));
    CONJ_TAC;
      BY((ASM_MESON_TAC[SUBSET; IN]));
    GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w[`P`;`c3`;`v`;`b`]) affine_facet_hyper )));
    ANTS_TAC;
      ASM_REWRITE_TAC[];
      CONJ_TAC;
        MATCH_MP_TAC Polyhedron.INTERIOR_AFFINIE_HUL_EQ_UNIV;
        BY((ASM_MESON_TAC[]));
      EXPAND_TAC "c3";
      AP_TERM_TAC;
      MATCH_MP_TAC EQ_EXT;
      REWRITE_TAC[ IN_ELIM_THM ];
      BY((MESON_TAC[ DOT_SYM ]));
    DISCH_THEN SUBST1_TAC;
    REWRITE_TAC[ IN_ELIM_THM ];
    EXPAND_TAC "u0";
    REWRITE_TAC [ DOT_RMUL ];
    CALC_ID_TAC;
    BY((REPEAT (FIRST_X_ASSUM MP_TAC ) THEN REAL_ARITH_TAC));
  ASM_REWRITE_TAC[];
  COMMENT "1";
  MATCH_MP_TAC SUBSET_TRANS;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `A INTER WF'`)));
  CONJ_TAC;
    REPEAT (FIRST_X_ASSUM_ST `rcone_gt` MP_TAC);
    BY(SET_TAC[]);
  BY(ASM_MESON_TAC[c3_lemma])
  ]);;
  (* }}} *)



let azim_pos = 
prove_by_refinement(
  `!x v u w1 w2.
    azim x v u w1 < azim x v u w2 /\
     ~collinear {x, v, w1} /\
          ~collinear {x, v, w2} /\
          ~collinear {x, v, u}
          ==> &0 < azim x v w1 w2`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`x`;`v`;`u`;`w1`;`w2`]) Fan.sum4_azim_fan )));
  ASM_REWRITE_TAC[];
  ANTS_TAC;
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let convex_sum_corollary = 
prove_by_refinement(
  `!n t bet. 0 < n /\ 
  &0 < t /\ t < &1 /\  
    sum (1..n) bet = pi /\ 
  (!i. i IN 1..n ==> &0 <= bet i /\ bet i <= pi) ==>
  (pi - &n * asn (sin (pi / &n) * t)) <= sum (1..n) (\i. bet i - asn (sin (bet i) * t))`,

  (* {{{ proof *)
  [
  REPEAT GEN_TAC;
  REWRITE_TAC[TAUT `(a /\ b ==> c) <=> (a ==> (b ==> c))`];
  DISCH_TAC;
  ASM_SIMP_TAC[ SUM_OFFSET_0 ; arith `0 < n ==> 1 <= n`];
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC GOTCJAH_convex_sum;
  ASM_REWRITE_TAC[];
  SUBGOAL_THEN `pi <= &n * pi /\ &0 <= pi` (fun t -> REWRITE_TAC[t]);
    ASSUME_TAC PI_POS;
    SIMP_TAC[ arith `pi <= &n * pi <=> &0 <= pi * (&n - &1)`;];
    GMATCH_SIMP_TAC Real_ext.REAL_PROP_NN_MUL2;
    ONCE_REWRITE_TAC[arith `&0 <= &n - &1 <=> &1 <= &n`];
    REWRITE_TAC[Real_ext.REAL_LE];
    BY(ASM_MESON_TAC[arith `0<n ==> 1<=n`;arith `&0 < pi ==> &0 <= pi`]);
  REPEAT WEAK_STRIP_TAC;
  FIRST_X_ASSUM MATCH_MP_TAC;
  REWRITE_TAC[IN_NUMSEG];
  BY(ASM_SIMP_TAC[arith `i < n ==> i+1 <=n`;arith `1 <= i + 1`])
  ]);;
  (* }}} *)

let SOL_SUBSET = 
prove_by_refinement(
  `!x s t r. r > &0 /\
         measurable (s INTER normball x r) /\
         measurable (t INTER normball x r) /\
         s SUBSET t /\
         radial_norm r x (s INTER normball x r) /\
         radial_norm r x (t INTER normball x r)
         ==> sol x s <= sol x t`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`x`;`s`;`t DIFF s`;`r`]) Conforming.SOL_DISJOINT_UNION)));
  ASM_REWRITE_TAC[];
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `s UNION t DIFF s = t`) SUBST1_TAC));
    FIRST_X_ASSUM_ST `SUBSET` MP_TAC;
    BY(SET_TAC[]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `DISJOINT s (t DIFF s)`) (fun t -> ONCE_REWRITE_TAC[t])));
    BY(SET_TAC[]);
  REWRITE_TAC[];
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!u. (t DIFF s) INTER u = (t INTER u DIFF (s INTER u))`) ASSUME_TAC));
    GEN_TAC;
    FIRST_X_ASSUM_ST `SUBSET` MP_TAC;
    BY(SET_TAC[]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `measurable ((t DIFF s) INTER normball x r)`) ASSUME_TAC));
    ASM_SIMP_TAC[];
    MATCH_MP_TAC MEASURABLE_DIFF;
    BY(ASM_REWRITE_TAC[]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `radial_norm r x ((t DIFF s) INTER normball x r)`) ASSUME_TAC));
    ASM_SIMP_TAC[];
    MATCH_MP_TAC Conforming.RADIAL_DIFF;
    ASM_REWRITE_TAC[];
    FIRST_X_ASSUM_ST `SUBSET` MP_TAC;
    BY(SET_TAC[]);
  ASM_REWRITE_TAC[];
  ENOUGH_TO_SHOW_TAC ( `&0 <= sol x (t DIFF s)`);
    BY(REAL_ARITH_TAC);
  GMATCH_SIMP_TAC Vol1.sol;
  EXISTS_TAC `r:real`;
  ASM_REWRITE_TAC[];
  MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2;
  CONJ_TAC;
    BY(REAL_ARITH_TAC);
  MATCH_MP_TAC REAL_LE_DIV;
  CONJ_TAC;
    MATCH_MP_TAC MEASURE_POS_LE;
    BY(ASM_MESON_TAC[]);
  MATCH_MP_TAC REAL_POW_LE;
  BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let GOTCJAH_concl = `!c v b P  WF t n. 
    polyhedron P /\ bounded P /\  (&0 < b) /\
    (vec 0 IN interior P) /\ 
    c facet_of P /\ 
    fchanged c = WF /\
    (&0 < t /\ t < &1) /\
    (c = P INTER { p | p dot v = b } /\ rcone_gt (vec 0) v t SUBSET WF) /\
    ( {u | u facet_of c } HAS_SIZE n) 
   ==> &2 * pi - &2* &n * asn (t* sin(pi/ &n)) <= sol (vec 0)  WF`;;

let GOTCJAH = prove_by_refinement(
  GOTCJAH_concl,
  (* {{{ proof *)
  [
  X_GENv_TAC "c3";
  REPEAT WEAK_STRIP_TAC;
  TYPED_ABBREV_TAC (`A = { (p:real^3) | p dot v = b}`);
  TYPED_ABBREV_TAC `u0 = (b / (v dot v)) % (v:real^3)`;
  GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`c3`; `v`; `b`; `P`; `WF'`; `t`; `n`; `u0`; `A`]) gotcjah_prep)));
  ASM_REWRITE_TAC[];
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`P`; `c3`; `A`; `n`; `{ c | c facet_of c3 }`; `t`; `u`; `v`; `b`] ) EUSOTYP2_general)));
  ASM_REWRITE_TAC[];
  REPEAT WEAK_STRIP_TAC;
  SUBGOAL_THEN `1 IN 1..n /\ (!i. (i IN 1..n) ==> (i+1) IN 1..n \/ (i=n))` ASSUME_TAC;
    FIRST_X_ASSUM_ST `1 < n` MP_TAC;
    REWRITE_TAC[ IN_NUMSEG ];
    BY((ARITH_TAC));
  SUBGOAL_THEN `&0 < b/ ((v:real^3) dot v)` ASSUME_TAC;
    MATCH_MP_TAC REAL_LT_DIV;
    BY((ASM_REWRITE_TAC[]));
  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;
    GEN_TAC;
    REWRITE_TAC [MESON[] `(?X bet. (p ==> q X bet)) <=> p ==> (?X bet. q X bet)`];
    DISCH_TAC;
    TYPED_ABBREV_TAC (`bet = azim (vec 0) v (g i) (g (i+1))/ &2 `);
    EXISTS_TAC `bet:real`;
    REWRITE_TAC[];
    MATCH_MP_TAC ( gotcjah_sol_lemma);
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `c3`)));
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `b`)));
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `P`)));
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `h i`)));
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `b / (v dot v)`)));
    ASM_REWRITE_TAC[];
    ASM_SIMP_TAC[arith `&0 < &1`];
    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));
      ASM_CASES_TAC `i=(n:num)`;
        ASM_REWRITE_TAC[];
        FIRST_X_ASSUM MATCH_MP_TAC;
        BY((ASM_REWRITE_TAC[]));
      FIRST_X_ASSUM MATCH_MP_TAC;
      FIRST_X_ASSUM MP_TAC;
      REPLICATE_TAC 2 (FIRST_X_ASSUM_ST `1..n` MP_TAC);
      BY((MESON_TAC[]));
    ASM_REWRITE_TAC[];
    ASM_CASES_TAC `i = (n:num)`;
      ASM_REWRITE_TAC[];
      FIRST_X_ASSUM MATCH_MP_TAC;
      BY((ASM_REWRITE_TAC[]));
    FIRST_X_ASSUM MATCH_MP_TAC;
    FIRST_X_ASSUM MP_TAC;
    REPLICATE_TAC 2 (FIRST_X_ASSUM_ST `1..n` MP_TAC);
    BY((MESON_TAC[]));
  FIRST_X_ASSUM MP_TAC;
  REWRITE_TAC[SKOLEM_THM];
  REPEAT WEAK_STRIP_TAC;
  COMMENT "Have bet and X";
  ONCE_REWRITE_TAC[arith `&2 * pi - &2 * u <= s <=> (pi - u) <= s/ &2`];
  MATCH_MP_TAC REAL_LE_TRANS;
  EXISTS_TAC `sum (1..n) (\i. bet i - asn (sin (bet i) * t))`;
  ONCE_REWRITE_TAC [arith `t * sin u = sin u * t`];
  CONJ_TAC;
    MATCH_MP_TAC convex_sum_corollary;
    ASM_SIMP_TAC [arith `1 < n ==> 0 < n`];
    MATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`);
    CONJ_TAC;
      REPEAT WEAK_STRIP_TAC;
      SUBGOAL_THEN (`bet i = azim (vec 0) v (g i ) (g (i+1)) / &2`) SUBST1_TAC;
        BY((ASM_SIMP_TAC[]));
      GMATCH_SIMP_TAC(arith `&0 <= x ==> &0 <= x/ &2`);
      GMATCH_SIMP_TAC(arith `x < &2 * pi ==> x / &2 <= pi`);
      BY((REWRITE_TAC[ Local_lemmas.AZIM_RANGE ]));
    SUBGOAL_THEN `sum (1..n) bet = sum (1..n) (\i. (&1/ &2) * azim (vec 0) v (g i) (g (i+1)))` SUBST1_TAC;
      MATCH_MP_TAC SUM_EQ;
      REPEAT WEAK_STRIP_TAC;
      BETA_TAC;
      ONCE_REWRITE_TAC[arith ` (&1/ &2) * u = u / &2`];
      BY((ASM_SIMP_TAC[]));
    REWRITE_TAC[ SUM_LMUL ];
    REWRITE_TAC[arith `(&1 / &2) * t = pi <=> t = &2 * pi`];
    MATCH_MP_TAC ORDER_AZIM_SUM2Pi;
    EXISTS_TAC `u:real^3`;
    BY((ASM_REWRITE_TAC[]));
  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));
    REPEAT WEAK_STRIP_TAC;
    REWRITE_TAC[DISJOINT];
    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));
      BY((SET_TAC[]));
    EXISTS_TAC `wedge (vec 0) v (g i) (g (i+1))`;
    EXISTS_TAC `wedge (vec 0) v (g j) (g (j+1))`;
    CONJ_TAC;
      BY((ASM_MESON_TAC[SUBSET_INTER]));
    CONJ_TAC;
      BY((ASM_MESON_TAC[SUBSET_INTER]));
    GMATCH_SIMP_TAC WEDGE_ORDER_DISJOINT;
    EXISTS_TAC `u:real^3`;
    EXISTS_TAC `n:num`;
    BY((ASM_REWRITE_TAC[]));
  COMMENT "1a";
  ONCE_REWRITE_TAC[arith `x <= u/ &2 <=> &2 * x <= u`; ];
  SUBGOAL_THEN `sol ((vec 0):real^3) (UNIONS (IMAGE X (1..n))) = sum ((IMAGE X (1..n))) (\s. sol (vec 0) s)` ASSUME_TAC;
    MATCH_MP_TAC Conforming.SOL_UNIONS;
    EXISTS_TAC `&1`;
    REWRITE_TAC[ arith `&1 > &0`; IN_IMAGE ];
    CONJ_TAC;
      MATCH_MP_TAC FINITE_IMAGE;
      BY((REWRITE_TAC[ FINITE_NUMSEG ]));
    CONJ_TAC;
      GEN_TAC;
      BY((ASM_MESON_TAC[]));
    REPEAT WEAK_STRIP_TAC;
    ASM_REWRITE_TAC[];
    FIRST_X_ASSUM MATCH_MP_TAC;
    BY((ASM_MESON_TAC[]));
  FIRST_X_ASSUM MP_TAC;
  GMATCH_SIMP_TAC SUM_IMAGE_NONZERO;
  CONJ_TAC;
    REWRITE_TAC[ FINITE_NUMSEG];
    REPEAT WEAK_STRIP_TAC;
    GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `X x = {}`)));
      DISCH_THEN SUBST1_TAC;
      BY((REWRITE_TAC[ Conforming.SOL_EMPTY ]));
    REPLICATE_TAC 5 (FIRST_X_ASSUM MP_TAC);
    REWRITE_TAC[ DISJOINT; Local_lemmas.EMPTY_NOT_EXISTS_IN; IN_INTER ];
    BY((MESON_TAC[]));
  COMMENT "1b";
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(\s. sol (vec 0) s) o X = (\i. sol (vec 0) (X i))`) SUBST1_TAC));
    ONCE_REWRITE_TAC[FUN_EQ_THM];
    BETA_TAC;
    BY((REWRITE_TAC[o_THM]));
  DISCH_TAC;
  MATCH_MP_TAC REAL_LE_TRANS;
  EXISTS_TAC (`sol ((vec 0):real^3) (UNIONS (IMAGE X (1..n)))`);
  CONJ_TAC;
    ASM_REWRITE_TAC[];
    MATCH_MP_TAC (arith `x = y ==> x<= y`);
    ONCE_REWRITE_TAC[ GSYM SUM_LMUL ];
    MATCH_MP_TAC SUM_EQ;
    REPEAT WEAK_STRIP_TAC;
    BETA_TAC;
    BY((ASM_MESON_TAC[]));
  (COMMENT "1c");
  MATCH_MP_TAC SOL_SUBSET;
  EXISTS_TAC `&1`;
  CONJ_TAC;
    BY(REAL_ARITH_TAC);
  CONJ_TAC;
    REWRITE_TAC[ Conforming.UNIONS_INTER ];
    MATCH_MP_TAC MEASURABLE_UNIONS;
    CONJ_TAC;
      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));
        ONCE_REWRITE_TAC[ FUN_EQ_THM];
        REWRITE_TAC[ IN; IMAGE ;IN_ELIM_THM];
        BY(MESON_TAC[ ]);
      MATCH_MP_TAC FINITE_IMAGE;
      BY(REWRITE_TAC[ FINITE_NUMSEG]);
    REWRITE_TAC[IN_ELIM_THM];
    REWRITE_TAC[ IN_IMAGE ];
    FIRST_X_ASSUM_ST `azim` MP_TAC;
    BY(MESON_TAC[]);
  CONJ_TAC;
    EXPAND_TAC "WF'";
    MATCH_MP_TAC FCHANGED_MEASURABLE;
    BY(ASM_MESON_TAC[]);
  CONJ_TAC;
    REWRITE_TAC[ UNIONS_SUBSET ];
    REWRITE_TAC[ IN_IMAGE ];
    FIRST_X_ASSUM_ST `azim` MP_TAC;
    BY(MESON_TAC[ SUBSET_INTER ]);
  CONJ_TAC;
    REWRITE_TAC[ Conforming.UNIONS_INTER ];
    MATCH_MP_TAC Conforming.RADIAL_UNIONS;
    CONJ_TAC;
      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));
        ONCE_REWRITE_TAC[ FUN_EQ_THM];
        REWRITE_TAC[ IN; IMAGE ;IN_ELIM_THM];
        BY(MESON_TAC[ ]);
      MATCH_MP_TAC FINITE_IMAGE;
      BY(REWRITE_TAC[ FINITE_NUMSEG]);
    REWRITE_TAC[IN_ELIM_THM];
    REWRITE_TAC[ IN_IMAGE ];
    FIRST_X_ASSUM_ST `azim` MP_TAC;
    BY(MESON_TAC[]);
  EXPAND_TAC "WF'";
  REWRITE_TAC[ GSYM Marchal_cells_2_new.RADIAL_VS_RADIAL_NORM ];
  MATCH_MP_TAC FCHANGED_RADIAL;
  BY(ASM_MESON_TAC[])
  ]);;
  (* }}} *)

(* Lemmas related to last two theorems in "Counting Spheres" *)



let rcone_def_alt = 
prove_by_refinement(
  `!(v:real^A) t p. p IN rcone_gt (vec 0) v t <=> norm p * norm v * t < p dot v`,

  (* {{{ proof *)
  [
  REWRITE_TAC[Sphere.rcone_gt;Sphere.rconesgn;varith `(x:real^A) - vec 0  = x`;IN;IN_ELIM_THM; DIST_0 ];
  BY(REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let rcone_refl = 
prove_by_refinement(
  `!(v:real^A) t.  t < &1 /\ ~(v = vec 0) ==> v IN rcone_gt (vec 0) v t`,

  (* {{{ proof *)
  [
  REWRITE_TAC[rcone_def_alt];
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC[ DOT_SQUARE_NORM ];
  REWRITE_TAC[ arith `x * x * t < x pow 2 <=> &0 < (&1 - t ) * (x * x)`];
  (MATCH_MP_TAC REAL_LT_MUL );
  CONJ_TAC;
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  (MATCH_MP_TAC REAL_LT_MUL);
  BY(ASM_REWRITE_TAC [ NORM_POS_LT ])
  ]);;
  (* }}} *)

let rcone_nz = 
prove_by_refinement(
  `!(v:real^A) p t.  (&0 < t ) /\ (p IN rcone_gt (vec 0) v t) ==> ~(p = vec 0) /\ ~(v = vec 0)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[ rcone_def_alt ];
  REPEAT WEAK_STRIP_TAC;
  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)
  ]);;
  (* }}} *)

let rcone_dot_pos = 
prove_by_refinement(
  `!(v:real^A) t p.  &0 < t /\
      p IN rcone_gt (vec 0) v t ==> &0 < p dot v`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w` ~(p = vec 0) /\ ~(v = vec 0)`) ASSUME_TAC));
    BY(ASM_MESON_TAC[rcone_nz]);
  FIRST_X_ASSUM_ST `rcone_gt` MP_TAC;
  REWRITE_TAC[rcone_def_alt];
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC REAL_LT_TRANS;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `norm p * norm v * t`)));
  ASM_REWRITE_TAC[];
  MATCH_MP_TAC REAL_LT_MUL;
  CONJ_TAC;
    BY(ASM_REWRITE_TAC[ NORM_POS_LT ]);
  MATCH_MP_TAC REAL_LT_MUL;
  BY(ASM_REWRITE_TAC [ NORM_POS_LT ])
  ]);;
  (* }}} *)

let rcone_hyperplane = 
prove_by_refinement(
  `!(v:real^A) t b q p. 
    (&0 < t /\ t < &1) /\
    (p IN rcone_gt (vec 0) v t) /\
     ( ( b / (p dot v)) % p = q) ==>
 	(q dot v = b)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[ rcone_def_alt];
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`&0 < (p dot v)`) ASSUME_TAC));
    MATCH_MP_TAC rcone_dot_pos;
    BY(ASM_MESON_TAC[ rcone_def_alt ]);
  EXPAND_TAC "q";
  REWRITE_TAC[ DOT_LMUL ];
  Calc_derivative.CALC_ID_TAC;
  BY(FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let rcone_gt_arcV = 
prove_by_refinement(
  `!(v:real^3) g p.
    (&0 < g) /\ (g < pi / &2) /\
    p IN rcone_gt (vec 0) v (cos g) ==>
    arcV (vec 0) p v < g `,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w` ~(p = vec 0) /\ ~(v = vec 0)`) ASSUME_TAC));
    MATCH_MP_TAC rcone_nz;
    BY(ASM_MESON_TAC[COS_POS_PI2]);
  GMATCH_SIMP_TAC (GSYM COS_MONO_LT_EQ);
  REWRITE_TAC[ Local_lemmas1.ARCV_BOUNDS ];
  ASSUME_TAC PI_POS;
  ASM_SIMP_TAC [arith `&0 < pi /\ g < pi / &2 ==> g <= pi`;arith `&0 < g ==> &0 <= g`];
  FIRST_X_ASSUM_ST `IN` MP_TAC;
  REWRITE_TAC[ rcone_def_alt];
  REWRITE_TAC[ Trigonometry1.DOT_COS ];
  GMATCH_SIMP_TAC REAL_LT_LMUL_EQ;
  ASM_SIMP_TAC[ NORM_POS_LT ];
  GMATCH_SIMP_TAC REAL_LT_LMUL_EQ;
  BY(ASM_SIMP_TAC[ NORM_POS_LT ])
   ]);;
  (* }}} *)

let cos_bounds_0_Pi2 = 
prove_by_refinement(
  `!x. &0 < x /\ x < pi / &2 ==>
    &0 < cos x /\ cos x < &1`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  CONJ_TAC;
    BY(ASM_SIMP_TAC[ Trigonometry.CFXEKKP2 ]);
  SUBGOAL_THEN `cos x <= &1` MP_TAC;
    BY(MESON_TAC[ COS_BOUNDS ]);
  DISCH_TAC;
  GMATCH_SIMP_TAC ( arith `u <= &1 /\ ~( u = &1) ==> (u < &1 )`);
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  FIRST_X_ASSUM MP_TAC;
  REWRITE_TAC[ COS_ONE_2PI ];
  REWRITE_TAC[ NOT_EXISTS_THM; DE_MORGAN_THM ];
  CONJ_TAC;
    STRIP_TAC;
    DISJ_CASES_TAC (ARITH_RULE `n = 0 \/ 1 <= n`);
      ASM_REWRITE_TAC[];
      BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
    FIRST_X_ASSUM MP_TAC;
    REWRITE_TAC[ GSYM REAL_OF_NUM_LE ];
    REPEAT WEAK_STRIP_TAC;
    FIRST_X_ASSUM_ST `pi / &2` MP_TAC;
    ASM_REWRITE_TAC[];
    REWRITE_TAC[ arith `~(&n * &2 * pi < pi/ &2)  <=> (&0 <= pi * (&n * &2 - &1 / &2))` ];
    MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2;
    CONJ_TAC;
      BY(MP_TAC PI_POS THEN REAL_ARITH_TAC);
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  STRIP_TAC;
  MATCH_MP_TAC (arith `(&0 < x /\ &0 <= u ==> ~(x = -- u))`);
  ASM_REWRITE_TAC[];
  MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2;
  GMATCH_SIMP_TAC Real_ext.REAL_PROP_NN_MUL2;
  MP_TAC PI_POS;
  BY(REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let rcone_gt_arc_triangle = 
prove_by_refinement(
  `!(p:real^3) v w gv gw.
    ~(w = vec 0) /\
    (&0 < gv) /\ (gv < pi / &2) /\
    p IN rcone_gt (vec 0) v (cos gv) /\
    gv + gw <= arcV (vec 0) v w ==>
    gw < arcV (vec 0) p w`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  SUBGOAL_THEN `&0 < cos gv /\ cos gv < &1` ASSUME_TAC;
    BY(ASM_SIMP_TAC[ cos_bounds_0_Pi2 ]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`~(p = vec 0) /\ ~(v = vec 0)`) ASSUME_TAC));
    BY(ASM_MESON_TAC[rcone_nz]);
  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));
    MATCH_MP_TAC Trigonometry2.ARCV_INEQUALTY;
    BY(ASM_REWRITE_TAC[]);
  GOAL_TERM (fun w -> (MP_TAC (ISPECL ( envl w [`v`;`gv`;`p`]) rcone_gt_arcV)));
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  FIRST_X_ASSUM (fun t -> MP_TAC (ONCE_REWRITE_RULE[ Trigonometry2.ARC_SYM ] t));
  BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let rcone_gt_facet = 
prove_by_refinement(
  `!gv gw v w q (p:real^3). 
    (&0 < gv /\ gv < pi / &2) /\
    (&0 < gw /\ gw < pi / &2) /\ 
    ~(w = vec 0) /\
    (p IN rcone_gt (vec 0) v (cos (gv))) /\
    (q = (((norm v) * cos (gv)) / (p dot v)) % p) /\
    (gv + gw <= arcV (vec 0) v w) ==>
    (q dot w < norm w * cos gw)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  SUBGOAL_THEN `&0 < cos gv /\ cos gv < &1 /\ &0 < cos gw /\ cos gw < &1` ASSUME_TAC;
    BY((ASM_SIMP_TAC[ cos_bounds_0_Pi2 ]));
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`~(p = vec 0) /\ ~(v = vec 0)`) ASSUME_TAC));
    BY((ASM_MESON_TAC[rcone_nz]));
  SUBGOAL_THEN `&0 < p dot (v:real^3)` ASSUME_TAC;
    GMATCH_SIMP_TAC rcone_dot_pos;
    BY(ASM_MESON_TAC[]);
  ASM_REWRITE_TAC[];
  REWRITE_TAC[ DOT_LMUL ];
  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`)));
    BY(ASM_MESON_TAC[ REAL_LT_LMUL_EQ ]);
  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])));
    Calc_derivative.CALC_ID_TAC;
    BY(FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `&0 < norm w /\ &0 < norm p /\ &0 < norm v`) ASSUME_TAC));
    BY(ASM_SIMP_TAC[ NORM_POS_LT ]);
  ASM_SIMP_TAC [ Trigonometry1.DOT_COS ];
  ONCE_REWRITE_TAC [arith `(a * b) * c * d *e < (c * a * f ) * d * g <=> (a * c * d) * b * e < (a*c*d)* (f *g)`];
  GMATCH_SIMP_TAC REAL_LT_LMUL_EQ;
  CONJ_TAC;
    GMATCH_SIMP_TAC REAL_LT_MUL;
    ASM_SIMP_TAC[];
    GMATCH_SIMP_TAC REAL_LT_MUL;
    BY(ASM_SIMP_TAC[]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`&0 < cos (arcV (vec 0) p v)`) ASSUME_TAC));
    FIRST_X_ASSUM_ST `dot` MP_TAC;
    REWRITE_TAC[ Trigonometry1.DOT_COS ];
    BY(ASM_SIMP_TAC[ REAL_LT_MUL_EQ ]);
  GOAL_TERM (fun w -> (ASM_CASES_TAC ( env w`&0 < cos (arcV (vec 0) p w)`)));
    MATCH_MP_TAC REAL_LT_TRANS;
    GOAL_TERM (fun w -> ((EXISTS_TAC ( env w`cos (arcV (vec 0) p v) * cos (arcV (vec 0) p w)`))));
    CONJ_TAC;
      ONCE_REWRITE_TAC[arith `x * y = y * x`];
      GMATCH_SIMP_TAC REAL_LT_LMUL_EQ;
      ASM_REWRITE_TAC[];
      GMATCH_SIMP_TAC COS_MONO_LT_EQ;
      ASM_SIMP_TAC[ Local_lemmas1.ARCV_BOUNDS ];
      CONJ_TAC;
        MP_TAC PI_POS;
        BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
      MATCH_MP_TAC rcone_gt_arcV;
      BY(ASM_SIMP_TAC[]);
    GMATCH_SIMP_TAC REAL_LT_LMUL_EQ;
    ASM_REWRITE_TAC[];
    GMATCH_SIMP_TAC COS_MONO_LT_EQ;
    ASM_SIMP_TAC[ Local_lemmas1.ARCV_BOUNDS ];
    CONJ_TAC;
      MP_TAC PI_POS;
      BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
    MATCH_MP_TAC rcone_gt_arc_triangle;
    BY(ASM_MESON_TAC[]);
  MATCH_MP_TAC REAL_LET_TRANS;
  EXISTS_TAC `&0`;
  CONJ_TAC;
    REWRITE_TAC[ arith `x * y <= &0 <=> &0 <= x * --y`];
    MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2;
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  MATCH_MP_TAC REAL_LT_MUL;
  BY(ASM_REWRITE_TAC[])
  ]);;
  (* }}} *)


let edges_of_facet_of = 
prove_by_refinement(
  `!(P:real^3->bool)  f.
    polyhedron P /\ bounded P /\ (vec 0 IN interior P) ==>
    (f edge_of P <=> (?c. f facet_of c /\ c facet_of P))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC[edge_of];
  REWRITE_TAC [ Geomdetail.EQ_EXPAND ];
  CONJ_TAC;
    REPEAT WEAK_STRIP_TAC;
    INTRO_TAC FACE_OF_POLYHEDRON_SUBSET_FACET [`P`;`f`];
    ASM_REWRITE_TAC[];
    ANTS_TAC;
      REWRITE_TAC[ GSYM AFF_DIM_POS_LE ];
      CONJ_TAC;
        ASM_REWRITE_TAC[];
        BY(INT_ARITH_TAC);
      DISCH_TAC;
      INTRO_TAC Polyhedron.AFF_DIM_INTERIOR_EQ_3 [`(vec 0):real^3`;`P`];
      ASM_REWRITE_TAC[];
      EXPAND_TAC "P";
      ASM_REWRITE_TAC[];
      BY(INT_ARITH_TAC);
    REPEAT WEAK_STRIP_TAC;
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `f'`)));
    ASM_REWRITE_TAC[ ];
    REWRITE_TAC[ facet_of ];
    ASM_REWRITE_TAC[];
    CONJ_TAC;
      GMATCH_SIMP_TAC FACE_OF_FACE;
      BY(ASM_MESON_TAC[ facet_of ]);
    CONJ_TAC;
      REWRITE_TAC[ GSYM AFF_DIM_POS_LE ];
      ASM_REWRITE_TAC[];
      BY(INT_ARITH_TAC);
    GMATCH_SIMP_TAC FACET_AFF_DIM_2;
    CONJ_TAC;
      BY(ASM_MESON_TAC[]);
    BY(INT_ARITH_TAC);
  REPEAT WEAK_STRIP_TAC;
  CONJ_TAC;
    BY(ASM_MESON_TAC [ FACE_OF_TRANS ; facet_of ]);
  INTRO_TAC FACET_AFF_DIM_2 [`P`;`c`];
  ANTS_TAC;
    BY(ASM_REWRITE_TAC[]);
  FIRST_X_ASSUM kill;
  FIRST_X_ASSUM MP_TAC;
  REWRITE_TAC[ facet_of ];
  DISCH_THEN (fun t-> REWRITE_TAC[t]);
  DISCH_THEN (fun t-> REWRITE_TAC[t]);
  BY(INT_ARITH_TAC)
  ]);;
  (* }}} *)

let BIJ_SYM = 
prove_by_refinement(
  `!(a:A->bool) (b:B->bool). 
    (?f. BIJ f a b) ==> (?g. BIJ g b a)`,

  (* {{{ proof *)
  [
  BY(MESON_TAC[ Misc_defs_and_lemmas.INVERSE_BIJ ])
  ]);;
  (* }}} *)

let BIJ_TRANS = 
prove_by_refinement(
  `! (B:B->bool)  (A:A->bool) (C:C->bool) .
    (?pab. BIJ pab A B) /\ (?pbc. BIJ pbc B C) ==> (?pab. BIJ pab A C)`,

  (* {{{ proof *)
  [
  MESON_TAC[ Hypermap.COMPOSE_BIJ ]
  ]);;
  (* }}} *)

let SND_BIJ = 
prove_by_refinement(
  `!(a:A) B:(B->bool). BIJ SND { (x,y) | x = a /\ B y } B`,

  (* {{{ proof *)
  [
  REWRITE_TAC[BIJ;INJ;SURJ;IN_ELIM_THM;IN];
  BY(MESON_TAC[FST;SND])
  ]);;
  (* }}} *)

let FST_BIJ = 
prove_by_refinement(
  `!(A:A->bool) b:B. BIJ FST { (x,y) | A x  /\ ( y = b) } A`,

  (* {{{ proof *)
  [
  REWRITE_TAC[BIJ;INJ;SURJ;IN_ELIM_THM;IN];
  BY(MESON_TAC[FST;SND])
  ]);;
  (* }}} *)

let PREIMAGE_BIJ = 
prove_by_refinement(
  `!(A:A->bool) (B:B->bool) (C:C->bool) f g.
    (!a. (a IN A) ==> (f a IN C) ) /\
    (!b. (b IN B) ==> (g b IN C)) /\
    (!c. (c IN C) ==> ?p. BIJ p (preimage A f {c}) (preimage B g {c})) ==>
    (?q. BIJ q A B)`,

  (* {{{ proof *)
  [
  REPEAT GEN_TAC;
  DISCH_THEN (fun t -> MP_TAC(ONCE_REWRITE_RULE[ RIGHT_IMP_EXISTS_THM ] t));
  ONCE_REWRITE_TAC[SKOLEM_THM];
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `\a. p (f a) a`)));
  FIRST_X_ASSUM MP_TAC;
  REWRITE_TAC[BIJ;INJ;SURJ; Misc_defs_and_lemmas.in_preimage ;IN_SING];
  BY(ASM_MESON_TAC[])
  ]);;
  (* }}} *)

let BIJ_FACET_HYPERFACE = 
prove_by_refinement(
  `!(p:real^3->bool).
   polyhedron p /\ bounded p /\ (vec 0 IN interior p) ==>
    (?b. BIJ b {f | f facet_of p} (face_set(hypermap1_of_fanx (vec 0,vertices p,edges p))))
    `,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC (INST_TYPE [`:(real^3->bool)`,`:B`] BIJ_TRANS);
  EXISTS_TAC (`(topological_component_yfan (vec 0,vertices p,edges p))`);
  SUBGOAL_THEN `{(f:real^3 -> bool) | f facet_of p } = \f. f facet_of p` MP_TAC;
    ONCE_REWRITE_TAC[FUN_EQ_THM];
    BETA_TAC;
    BY(REWRITE_TAC[IN;IN_ELIM_THM]);
  DISCH_THEN SUBST1_TAC;
  CONJ_TAC;
    BY(ASM_MESON_TAC[ Polyhedron.AMHFNXP_BIJ]);
  BY(ASM_MESON_TAC[ Cfyxfty.WBLARHH_BIJ; BIJ_SYM; ])
  ]);;
  (* }}} *)

let POLYHEDRON_CONFORMING_FAN = 
prove_by_refinement(
  `!(p:real^3->bool). bounded p /\ polyhedron p /\ vec 0 IN interior p ==>
    (conforming_fan ((vec 0), vertices p, edges p))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC Conforming.PIIJBJK;
  ASM_SIMP_TAC[ Polyhedron.POLYHEDRON_FAN ];
  ASM_SIMP_TAC[ Polyhedron.POLYTOPE_FAN80 ];
  BY(ASM_SIMP_TAC[ Polyhedron.CARD_SET_OF_EDGE_INEQ_1_POLYHEDRON ])
  ]);;
  (* }}} *)

let POLYHEDRON_D1_D = 
prove_by_refinement(
  `!(p:real^3->bool). bounded p /\ polyhedron p /\ vec 0 IN interior p ==>
    d_fan ((vec 0), vertices p,edges p) = d1_fan((vec 0),vertices p,edges p)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC Fan.dartset_fully_surrounded_is_non_isolated_fan;
  BY(ASM_MESON_TAC[ Polyhedron.POLYHEDRON_FAN ; Polyhedron.CARD_SET_OF_EDGE_INEQ_1_POLYHEDRON])
  ]);;
  (* }}} *)

let POLYHEDRON_PLAIN = 
prove_by_refinement(
  `!(p:real^3->bool). bounded p /\ polyhedron p /\ vec 0 IN interior p ==>
    (plain_hypermap (hypermap1_of_fanx ((vec 0), vertices p, edges p)))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  INTRO_TAC POLYHEDRON_CONFORMING_FAN [`p`];
  INTRO_TAC Polyhedron.POLYHEDRON_FAN [`p`;`(vec 0):real^3`];
  ASM_REWRITE_TAC[];
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC[Hypermap.plain_hypermap];
  REWRITE_TAC[FUN_EQ_THM];
  REWRITE_TAC[I_DEF;o_DEF];
  GEN_TAC;
  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)))`;
  INTRO_TAC Fan.hypermap_of_fan_rep [`(vec 0):real^3`;`vertices p`;`edges p`;`r`];
  ASM_REWRITE_TAC[];
  REPEAT WEAK_STRIP_TAC;
  ASM_REWRITE_TAC[];
  INTRO_TAC POLYHEDRON_D1_D [`p`];
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  GOAL_TERM (fun w -> (ASM_CASES_TAC ( env w `x IN d1_fan((vec 0),vertices p,edges p)`)));
    INTRO_TAC (GEN_ALL Fan.into_domain_e_fan) [`r`;`(vec 0):real^3`;`vertices p`;`edges p`];
    ASM_REWRITE_TAC[];
    DISCH_TAC;
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `r e_fan x IN d1_fan (vec 0,vertices p,edges p)`) ASSUME_TAC));
      FIRST_X_ASSUM MATCH_MP_TAC;
      BY(ASM_REWRITE_TAC[]);
    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));
      BY(ASM_MESON_TAC[ Fan.into_domain_efn_fan ]);
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `r e_fan x = e_fan (vec 0) (vertices p) (edges p) x`) SUBST1_TAC));
      BY(ASM_MESON_TAC[ Fan.into_domain_efn_fan ]);
    BY(ASM_MESON_TAC[ Fan.plain_hypermap_fan; ]);
  INTRO_TAC (GEN_ALL Fan.id_enf_fan ) [`r`;`(vec 0):real^3`;`vertices p`;`edges p`;`x`];
  BY(ASM_SIMP_TAC[])
  ]);;
  (* }}} *)

let POLYHEDRON_NODE_3 = 
prove_by_refinement(
  `!(p:real^3->bool) x. bounded p /\ polyhedron p /\ vec 0 IN interior p /\
    x IN d_fan (vec 0,vertices p,edges p) ==>
    3 <= CARD (node (hypermap1_of_fanx (vec 0,vertices p,edges p)) x)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  INTRO_TAC POLYHEDRON_CONFORMING_FAN [`p`];
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  INTRO_TAC Polyhedron.POLYHEDRON_FAN [`p`;`(vec 0):real^3`];
  ASM_REWRITE_TAC[];
  REPEAT WEAK_STRIP_TAC;
  INTRO_TAC Polyhedron.BSXAQBQ [`p`];
  ASM_SIMP_TAC[];
  DISCH_TAC;
  MATCH_MP_TAC (arith `~(u <= 2) ==> (3 <= u)`);
  DISCH_TAC;
  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`];
  ASM_REWRITE_TAC[];
  (ASM_SIMP_TAC[ Polyhedron.CARD_SET_OF_EDGE_INEQ_1_POLYHEDRON ]);
  REWRITE_TAC[ GSYM Hypermap.lemma_in_node_set ];
  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)))`;
  INTRO_TAC Fan.hypermap_of_fan_rep [`(vec 0):real^3`;`vertices p`;`edges p`;`r`];
  ASM_REWRITE_TAC[];
  REPEAT WEAK_STRIP_TAC;
  FIRST_X_ASSUM MP_TAC;
  ASM_REWRITE_TAC[];
  MATCH_MP_TAC (arith `(a < b) ==> ~(a = b)`);
  MATCH_MP_TAC REAL_LTE_TRANS;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `sum (node (hypermap1_of_fanx (vec 0,vertices p,edges p)) x) (\y. pi)`)));
  CONJ_TAC;
    MATCH_MP_TAC SUM_LT_ALL;
    BETA_TAC;
    CONJ_TAC;
      BY(REWRITE_TAC[ Hypermap.NODE_FINITE ]);
    CONJ_TAC;
      REWRITE_TAC[ Misc_defs_and_lemmas.EMPTY_EXISTS ];
      BY(MESON_TAC[ Hypermap.node_refl ]);
    REPEAT WEAK_STRIP_TAC;
    FIRST_X_ASSUM MATCH_MP_TAC;
    BY(ASM_MESON_TAC[ Hypermap.lemma_node_subset ; SUBSET; IN ]);
  GMATCH_SIMP_TAC SUM_CONST;
  REWRITE_TAC[ Hypermap.NODE_FINITE ];
  GMATCH_SIMP_TAC REAL_LE_RMUL_EQ;
  REWRITE_TAC[PI_POS];
  BY(ASM_MESON_TAC[ REAL_OF_NUM_LE ])
  ]);;
  (* }}} *)

let POLYHEDRON_TGJISOK = 
prove_by_refinement(
  `!(p:real^3->bool) H. bounded p /\ polyhedron p /\ vec 0 IN interior p /\
    (H= hypermap1_of_fanx ((vec 0), vertices p, edges p)) ==>
    CARD (dart (H)) <= 6 * number_of_faces H - 12`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC Hypermap.lemmaTGJISOK;
  INTRO_TAC POLYHEDRON_CONFORMING_FAN [`p`];
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  INTRO_TAC Polyhedron.POLYHEDRON_FAN [`p`;`(vec 0):real^3`];
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  SUBCONJ_TAC;
    MATCH_MP_TAC Conforming.WGVWSKE;
    BY(ASM_REWRITE_TAC[ ]);
  DISCH_TAC;
  SUBCONJ_TAC;
    MATCH_MP_TAC POLYHEDRON_PLAIN;
    BY(ASM_REWRITE_TAC[]);
  DISCH_TAC;
  SUBCONJ_TAC;
    BY(ASM_SIMP_TAC[ Conforming.GGRLKHP ]);
  DISCH_TAC;
  GEN_TAC;
  DISCH_TAC;
  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));
    BY(ASM_MESON_TAC[ Fan.hypermap_of_fan_rep ]);
  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)))`;
  INTRO_TAC Fan.hypermap_of_fan_rep [`(vec 0):real^3`;`vertices p`;`edges p`;`r`];
  ASM_REWRITE_TAC[];
  REPEAT WEAK_STRIP_TAC;
  FIRST_X_ASSUM MP_TAC;
  ASM_REWRITE_TAC[];
  INTRO_TAC POLYHEDRON_D1_D [`p`];
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `r e_fan x = e_fan (vec 0) (vertices p) (edges p) x`) SUBST1_TAC));
    BY((ASM_MESON_TAC[ Fan.into_domain_efn_fan ]));
  DISCH_TAC;
  MATCH_MP_TAC (TAUT `a /\ b ==> b/\ a`);
  CONJ_TAC;
    BY(ASM_MESON_TAC[POLYHEDRON_NODE_3]);
  BY(ASM_MESON_TAC[ Fan.e_fan_no_fix_point ])
  ]);;
  (* }}} *)

let EDGE_PAIR_pr23 = 
prove_by_refinement(
  `!x V E d d'. 
    e_fan x V E d = d' ==>
    pr2 d = pr3 d' /\ pr3 d = pr2 d'`,

  (* {{{ proof *)
  [
  REWRITE_TAC[ Fan.e_fan ];
  REPEAT GEN_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?x0 v w w1. d = (x0,v,w,w1)`) MP_TAC));
    BY(MESON_TAC[PAIR_SURJECTIVE]);
  WEAK_STRIP_TAC;
  ASM_REWRITE_TAC[];
  DISCH_THEN (fun t -> ONCE_REWRITE_TAC[GSYM t ]);
  REWRITE_TAC[ Fan.pr2; Fan.pr3];
  ]);;
  (* }}} *)

let EDGE_pr23 = 
prove_by_refinement(
  `!x V E y y1.
          FAN (x,V,E) /\
          (!v. v IN V ==> CARD (set_of_edge v V E) > 1) /\
          y IN d1_fan (x,V,E) /\
          y1 IN d1_fan (x,V,E) /\
          {pr2 y,pr3 y} = {pr2 y1,pr3 y1} /\ ~(y = y1) ==>
       y = edge_map (hypermap1_of_fanx (x,V,E)) y1`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  TYPED_ABBREV_TAC `r = (\t. res (t (x:real^3) (V:real^3->bool) E ) (d1_fan (x,V,E)))`;
  INTRO_TAC Fan.hypermap_of_fan_rep [`x`;`V`;`E`;`r`];
  ASM_REWRITE_TAC[];
  REPEAT WEAK_STRIP_TAC;
  ASM_REWRITE_TAC[];
  INTRO_TAC (GEN_ALL Fan.into_domain_efn_fan) [`r`;`x`;`V`;`E`];
  ASM_REWRITE_TAC[];
  DISCH_THEN (fun t -> ASM_SIMP_TAC[t]);
  FIRST_X_ASSUM_ST `pr2` MP_TAC;
  REWRITE_TAC[ Geomdetail.PAIR_EQ_EXPAND ];
  DISCH_THEN DISJ_CASES_TAC;
    PROOF_BY_CONTR_TAC;
    FIRST_X_ASSUM kill;
    FIRST_X_ASSUM_ST `~` MP_TAC;
    REWRITE_TAC[];
    MATCH_MP_TAC Planarity.EQ_PAIR_IMP_EQ_4_FAN;
    ASM_REWRITE_TAC[];
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `x`)));
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `V`)));
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `E`)));
    ASM_REWRITE_TAC[];
    BY(ASM_MESON_TAC[ Fan.dartset_fully_surrounded_is_non_isolated_fan; PAIR_EQ ]);
  INTRO_TAC EDGE_PAIR_pr23 [`x`;`V`;`E`;`y1`;`e_fan x V E y1`];
  ASM_REWRITE_TAC[];
  REPEAT WEAK_STRIP_TAC;
  TYPED_ABBREV_TAC `y2 = e_fan x V E y1`;
  MATCH_MP_TAC Planarity.EQ_PAIR_IMP_EQ_4_FAN;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `x`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `V`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `E`)));
  ASM_REWRITE_TAC[];
  BY(ASM_MESON_TAC[ Fan.dartset_fully_surrounded_is_non_isolated_fan; Fan.into_domain_e_fan ; Fan.into_domain_efn_fan ])
  ]);;
  (* }}} *)

let SIMPLE_FACE_EDGE_INJ = 
prove_by_refinement(
  `!H (y:A) y1. simple_hypermap H /\ (1 < CARD(node H (face_map H y))) /\
    (y IN dart H) /\
    (y IN face H y1) ==>
    ~(y = edge_map H y1)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  SUBGOAL_THEN `(y1:A) = (node_map H o face_map H) y` MP_TAC;
    ONCE_REWRITE_TAC[ GSYM Hypermap.inverse_hypermap_maps ];
    ONCE_REWRITE_TAC[ EQ_SYM_EQ ];
    GMATCH_SIMP_TAC PERMUTES_INVERSE_EQ;
    ASM_REWRITE_TAC[];
    BY(MESON_TAC [Hypermap.edge_map_and_darts]);
  REWRITE_TAC[o_THM];
  TYPED_ABBREV_TAC `(y2:A) = face_map H y`;
  DISCH_TAC;
  SUBGOAL_THEN `y2 = node_map H (y2:A)` ASSUME_TAC;
    MATCH_MP_TAC Hypermap_and_fan.SIMPLE_HYPERMAP_IMP_FACE_INJ;
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `H`)));
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `y2`)));
    ASM_REWRITE_TAC[];
    CONJ_TAC;
      BY(ASM_MESON_TAC[ Hypermap.lemma_dart_invariant ]);
    CONJ_TAC;
      BY(REWRITE_TAC[ Hypermap.node_refl ]);
    CONJ_TAC;
      BY(ASM_MESON_TAC [Hypermap.lemma_in_node2; Hypermap.POWER_1]);
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `face H y2 = face H y`) SUBST1_TAC));
      ONCE_REWRITE_TAC[ EQ_SYM_EQ ];
      MATCH_MP_TAC Hypermap.lemma_face_identity;
      BY(ASM_MESON_TAC[ Hypermap.lemma_in_face ; Hypermap.POWER_1 ]);
    ONCE_REWRITE_TAC[ EQ_SYM_EQ ];
    MATCH_MP_TAC Hypermap.lemma_face_identity;
    BY(ASM_MESON_TAC[]);
  SUBGOAL_THEN `node H (y2:A) = {y2 }` ASSUME_TAC;
    REWRITE_TAC[ Hypermap.node ];
    GMATCH_SIMP_TAC Hypermap.orbit_cyclic;
    EXISTS_TAC `1`;
    REWRITE_TAC[arith `~(1=0)`;Hypermap.POWER_1];
    CONJ_TAC;
      BY(ASM_MESON_TAC[]);
    ONCE_REWRITE_TAC[FUN_EQ_THM];
    REWRITE_TAC[REWRITE_RULE[IN] IN_SING;IN_ELIM_THM];
    REWRITE_TAC[ arith `k < 1 <=> k=0`];
    BY(MESON_TAC[ Hypermap.POWER_0 ; I_DEF]);
  FIRST_X_ASSUM_ST `CARD` MP_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[ Hypermap.CARD_SINGLETON ];
  BY(ARITH_TAC)
  ]);;
  (* }}} *)

let INJ_EDGES_FACE_pr23 = 
prove_by_refinement(
  `!p:real^3->bool f y1 y.
	bounded p /\ polyhedron p /\ vec 0 IN interior p /\
	f IN face_set (hypermap1_of_fanx  (vec 0,vertices p,edges p)) /\
	y IN f /\
	y1 IN f /\
	{ pr2 y,pr3 y} = {pr2 y1,pr3 y1} ==>
    (y = y1)
 `,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  PROOF_BY_CONTR_TAC;
  INTRO_TAC POLYHEDRON_CONFORMING_FAN [`p`];
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  INTRO_TAC Polyhedron.POLYHEDRON_FAN [`p`;`(vec 0):real^3`];
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(y = edge_map (hypermap1_of_fanx  (vec 0,vertices p,edges p)) y1)`) ASSUME_TAC));
    MATCH_MP_TAC SIMPLE_FACE_EDGE_INJ;
    CONJ_TAC;
      BY(ASM_MESON_TAC[ Conforming.SRPRNPL ]);
    CONJ_TAC;
      MATCH_MP_TAC (arith `3 <= x ==> 1 < x`);
      MATCH_MP_TAC POLYHEDRON_NODE_3;
      ASM_REWRITE_TAC[];
      TYPED_ABBREV_TAC `H = hypermap1_of_fanx  (vec 0,vertices p,edges p)`;
      GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`d_fan (vec 0,vertices p,edges p)= dart H `) ASSUME_TAC));
        BY(ASM_MESON_TAC [Fan.hypermap_of_fan_rep]);
      ASM_REWRITE_TAC[];
      GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `y IN dart H`) ASSUME_TAC));
        BY(ASM_MESON_TAC[ Hypermap.lemma_face_representation; Hypermap.lemma_face_subset; SUBSET]);
      BY(ASM_SIMP_TAC[ Hypermap.lemma_dart_invariant ]);
    CONJ_TAC;
      BY(ASM_MESON_TAC[ Hypermap.lemma_face_representation; Hypermap.lemma_face_subset; SUBSET]);
    FIRST_X_ASSUM (fun t -> MP_TAC (MATCH_MP Hypermap.lemma_face_representation t));
    REPEAT WEAK_STRIP_TAC;
    BY(ASM_MESON_TAC[ Hypermap.face_refl; Hypermap.lemma_face_identity]);
  COMMENT "1";
  FIRST_X_ASSUM MP_TAC;
  REWRITE_TAC[];
  MATCH_MP_TAC EDGE_pr23;
  ASM_REWRITE_TAC[];
  TYPED_ABBREV_TAC `H = hypermap1_of_fanx  (vec 0,vertices p,edges p)`;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`d_fan (vec 0,vertices p,edges p)= dart H `) ASSUME_TAC));
    BY(ASM_MESON_TAC [Fan.hypermap_of_fan_rep]);
  INTRO_TAC POLYHEDRON_D1_D[`p`];
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `y IN dart H /\ y1 IN dart H`) ASSUME_TAC));
    BY(ASM_MESON_TAC[ Hypermap.lemma_face_representation; Hypermap.lemma_face_subset; SUBSET]);
  ASM_REWRITE_TAC[];
  CONJ_TAC;
    BY(ASM_SIMP_TAC[ Polyhedron.CARD_SET_OF_EDGE_INEQ_1_POLYHEDRON ]);
  BY(ASM_MESON_TAC[])
  ]);;
  (* }}} *)

let BIJ_EDGES_DART_FACE = 
prove_by_refinement(
  `!p:real^3->bool f f1.
     bounded (p:real^3->bool) /\ polyhedron p /\ vec 0 IN interior p 
     /\ f IN face_set (hypermap1_of_fanx  (vec 0,vertices p,edges p)) 
     /\ f1 facet_of p /\ 							 
    fchanged f1 =dartset_leads_into_fan (vec 0) (vertices p) (edges p) f
    ==>   
    (?b. BIJ b (edges f1) f)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `edges f1 = {{pr2 e,pr3 e} | e IN f}`) SUBST1_TAC));
    ASM_SIMP_TAC[GSYM Cfyxfty.CFYXFTY0];
    BY(ASM_SIMP_TAC[GSYM Cfyxfty.CFYXFTY1]);
  MATCH_MP_TAC BIJ_SYM;
  EXISTS_TAC (`(\e. {pr2 e, pr3 e}):real^3#real^3#real^3#real^3->real^3->bool`);
  REWRITE_TAC[BIJ;SURJ];
  MATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`);
  SUBCONJ_TAC;
    REWRITE_TAC[IN;IN_ELIM_THM];
    BY(MESON_TAC[]);
  DISCH_TAC;
  REWRITE_TAC[INJ];
  (ASM_REWRITE_TAC[]);
  BY(ASM_MESON_TAC[ INJ_EDGES_FACE_pr23])
  ]);;
  (* }}} *)

let SEGMENT_EDGE_ONTO = 
prove_by_refinement(
  `!(p:real^3->bool) e.
    polyhedron p /\ bounded p /\
    e edge_of p ==>
    (?v w. e = segment [v,w])`,

  (* {{{ proof *)
  [
  BY(ASM_MESON_TAC[ Polyhedron.EXPAND_EDGE_POLYTOPE; edge_of; POLYTOPE_EQ_BOUNDED_POLYHEDRON])
  ]);;
  (* }}} *)

let EDGE_OF_FACET_OF = 
prove_by_refinement(
  `!(p:real^3->bool) c f.
    polyhedron p /\ bounded p /\ (vec 0 IN interior p) /\ c facet_of p ==> 
    ((e edge_of c) <=> (e facet_of c))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC[edge_of;facet_of];
  MATCH_MP_TAC (TAUT `(a ==> (b <=>c)) ==> ((a /\ b) <=> (a /\ c))`);
  DISCH_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`aff_dim c = &2`) ASSUME_TAC));
    BY(ASM_MESON_TAC[ FACET_AFF_DIM_2 ]);
  ASM_REWRITE_TAC[];
  SUBGOAL_THEN `int_of_num 2 - &1 = &1` SUBST1_TAC;
    BY(INT_ARITH_TAC);
  MATCH_MP_TAC (TAUT `(a ==> (c)) ==> ((a) <=> (c /\ a))`);
  ONCE_REWRITE_TAC [ GSYM AFF_DIM_POS_LE ];
  BY(INT_ARITH_TAC)
  ]);;
  (* }}} *)

let EDGE_OF_FACET_EDGE = 
prove_by_refinement(
  `!(p:real^3->bool) c e.
   polyhedron p /\ bounded p /\ (vec 0 IN interior p) /\ c facet_of p /\ e facet_of c ==>
    ((e edge_of p))
    `,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`e edge_of c`) MP_TAC));
    BY(ASM_MESON_TAC[EDGE_OF_FACET_OF]);
  REWRITE_TAC[ edge_of ];
  BY(ASM_MESON_TAC[ FACE_OF_TRANS ; facet_of ])
  ]);;
  (* }}} *)

let BIJ_FACET2_EDGE = 
prove_by_refinement(
  `!(p:real^3 -> bool) c.
   polyhedron p /\ bounded p /\ (vec 0 IN interior p) /\ c facet_of p ==>
    (?b. BIJ b {e | e IN edges c } {u | u facet_of c} )
    `,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  (REWRITE_TAC[edges;IN_ELIM_THM]);
  EXISTS_TAC ( `((hull) convex):(real^3->bool)->real^3->bool`);
  REWRITE_TAC[BIJ];
  REWRITE_TAC[INJ];
  SUBCONJ_TAC;
    REWRITE_TAC[IN_ELIM_THM];
    SUBCONJ_TAC;
      BY(ASM_MESON_TAC[ SEGMENT_CONVEX_HULL ; EDGE_OF_FACET_OF ]);
    DISCH_TAC;
    BY(ASM_MESON_TAC[ SEGMENT_CONVEX_HULL ; SEGMENT_EQ; Collect_geom.PER_SET2 ]);
  REWRITE_TAC[SURJ];
  REPEAT WEAK_STRIP_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[IN_ELIM_THM];
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC (MESON[] (`(?v w. p v w /\ R {v,w}) ==> (?y. (?v w. p v w /\ y = {v,w}) /\ R y)`));
  INTRO_TAC SEGMENT_EDGE_ONTO [`p`;`x`];
  ASM_REWRITE_TAC[];
  ANTS_TAC;
    MATCH_MP_TAC EDGE_OF_FACET_EDGE;
    BY(ASM_MESON_TAC[]);
  BY(ASM_MESON_TAC[ SEGMENT_CONVEX_HULL ; EDGE_OF_FACET_OF ])
  ]);;
  (* }}} *)

let HYPERFACE_EXISTS = 
prove_by_refinement(
 `!P:real^3->bool U.
     bounded (P:real^3->bool) /\ polyhedron P /\ vec 0 IN interior P /\
	topological_component_yfan (vec 0,vertices P,edges P) U ==>
   (?!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 = U))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  INTRO_TAC Polyhedron.WBLARHH_BIJ [`P`];
  ASM_REWRITE_TAC[BIJ;INJ;SURJ];
  BY(ASM_MESON_TAC[IN])
  ]);;
  (* }}} *)

let BIJ_DART_POLYEDGE = 
prove_by_refinement(
  `!P:real^3->bool.
     bounded (P:real^3->bool) /\ polyhedron P /\ vec 0 IN interior P ==>
   (?b. BIJ b (dart(hypermap1_of_fanx (vec 0,vertices P,edges P)))
      {(e,f1) | e facet_of f1 /\ f1 facet_of P })`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC (INST_TYPE [`:(real^3)->bool`,`:C`] PREIMAGE_BIJ);
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `IMAGE fchanged { f1 | f1 facet_of P }`)));
  TYPED_ABBREV_TAC `H = hypermap1_of_fanx (vec 0,vertices P,edges P)`;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `dartset_leads_into_fan (vec 0) (vertices P) (edges P) o (face H)`)));
  EXISTS_TAC (`(fchanged o SND): (real^3->bool)#(real^3->bool)->real^3->bool`);
  SUBCONJ_TAC;
    REWRITE_TAC[IN_IMAGE;o_THM];
    REWRITE_TAC[IN_ELIM_THM];
    REPEAT WEAK_STRIP_TAC;
    INTRO_TAC Polyhedron.WBLARHH [`P`];
    ASM_REWRITE_TAC[];
    DISCH_THEN (C INTRO_TAC[`(face H a)`]);
    ASM_REWRITE_TAC[ GSYM Hypermap.lemma_in_face_set ];
    REWRITE_TAC[ EXISTS_UNIQUE_THM ];
    REPEAT WEAK_STRIP_TAC;
    BY(ASM_MESON_TAC[]);
  DISCH_TAC;
  COMMENT "1";
  SUBCONJ_TAC;
    REWRITE_TAC[IN_IMAGE;IN_ELIM_THM;o_THM];
    BY(ASM_MESON_TAC[SND]);
  DISCH_TAC;
  GEN_TAC;
  REWRITE_TAC[IN_IMAGE;IN_ELIM_THM];
  REPEAT WEAK_STRIP_TAC;
  COMMENT "1";
  GOAL_TERM (fun w -> (MATCH_MP_TAC ( ISPEC ( env w `{e | e facet_of x}`) BIJ_TRANS)));
  MATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`);
  CONJ_TAC;
    MATCH_MP_TAC BIJ_SYM;
    EXISTS_TAC `FST:((real^3)->bool)#((real^3)->bool) -> real^3 -> bool`;
    REWRITE_TAC[ Misc_defs_and_lemmas.preimage ];
    REWRITE_TAC[o_THM; IN_SING ];
    REWRITE_TAC[BIJ];
    REWRITE_TAC[INJ];
    SUBCONJ_TAC;
      REWRITE_TAC[IN_ELIM_THM];
      SUBCONJ_TAC;
        X_GENv_TAC "ef";
        REPEAT WEAK_STRIP_TAC;
        ASM_REWRITE_TAC[];
        FIRST_X_ASSUM MP_TAC;
        ASM_REWRITE_TAC[];
        DISCH_TAC;
        GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `f1 = x`)));
          BY(ASM_MESON_TAC[]);
        MATCH_MP_TAC Polyhedron.FCHANGED_ONE_TO_ONE;
        GOAL_TERM (fun w -> (EXISTS_TAC ( env w `P`)));
        ASM_REWRITE_TAC[];
        REWRITE_TAC[INTER_IDEMPOT];
        REWRITE_TAC[ Misc_defs_and_lemmas.EMPTY_EXISTS];
        MATCH_MP_TAC Polyhedron.EXISTS_POINT_IN_FCHANGED;
        BY(ASM_MESON_TAC[]);
      REPEAT WEAK_STRIP_TAC;
      ASM_REWRITE_TAC[PAIR_EQ];
      REPEAT (FIRST_X_ASSUM_ST `FST` MP_TAC);
      REPEAT (FIRST_X_ASSUM_ST `SND` MP_TAC);
      ASM_REWRITE_TAC[FST;SND];
      REPEAT WEAK_STRIP_TAC;
      ASM_REWRITE_TAC[];
      MATCH_MP_TAC Polyhedron.FCHANGED_ONE_TO_ONE;
      GOAL_TERM (fun w -> (EXISTS_TAC ( env w `P`)));
      ASM_REWRITE_TAC[];
      REWRITE_TAC[ INTER_IDEMPOT; Misc_defs_and_lemmas.EMPTY_EXISTS ];
      MATCH_MP_TAC Polyhedron.EXISTS_POINT_IN_FCHANGED;
      BY(ASM_MESON_TAC[]);
    DISCH_TAC;
    REWRITE_TAC[SURJ];
    ASM_REWRITE_TAC[];
    REWRITE_TAC[IN_ELIM_THM];
    REPEAT WEAK_STRIP_TAC;
    BY(ASM_MESON_TAC[FST;SND]);
  COMMENT "1g";
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `topological_component_yfan (vec 0,vertices P,edges P) c`) ASSUME_TAC));
    BY(ASM_MESON_TAC[Polyhedron.AMHFNXP_BIJ; BIJ;SURJ;IN]);
  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));
    MATCH_MP_TAC HYPERFACE_EXISTS;
    BY(ASM_REWRITE_TAC[]);
  REWRITE_TAC[ EXISTS_UNIQUE ];
  REPEAT WEAK_STRIP_TAC;
  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));
    REWRITE_TAC[Misc_defs_and_lemmas.preimage];
    REWRITE_TAC[o_THM;IN_SING];
    ONCE_REWRITE_TAC[FUN_EQ_THM];
    GEN_TAC;
    REWRITE_TAC[IN_ELIM_THM];
    REWRITE_TAC[ Geomdetail.EQ_EXPAND ];
    CONJ_TAC;
      REPEAT WEAK_STRIP_TAC;
      GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `face H x' = f`) ASSUME_TAC));
        FIRST_X_ASSUM MATCH_MP_TAC;
        BY(ASM_MESON_TAC[IN;Hypermap.lemma_in_face_set;Conforming.identity_face_in_face_set]);
      BY(ASM_MESON_TAC[IN;Hypermap.face_refl;Hypermap.lemma_in_face_set;Conforming.identity_face_in_face_set]);
    BY(ASM_MESON_TAC[IN;Hypermap.face_refl;Hypermap.lemma_in_face_set;Conforming.identity_face_in_face_set]);
  COMMENT "1h";
  GOAL_TERM (fun w -> (MATCH_MP_TAC (ISPEC ( env w`{e | e IN edges x}`) BIJ_TRANS)));
  CONJ2_TAC;
    MATCH_MP_TAC BIJ_FACET2_EDGE;
    BY(ASM_MESON_TAC[]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{e | e IN edges x} = edges x`) SUBST1_TAC));
    ONCE_REWRITE_TAC[FUN_EQ_THM];
    BY(REWRITE_TAC[IN_ELIM_THM;IN]);
  MATCH_MP_TAC BIJ_SYM;
  MATCH_MP_TAC BIJ_EDGES_DART_FACE;
  BY(ASM_MESON_TAC[])
  ]);;
  (* }}} *)

let FINITE_EDGE = 
prove_by_refinement(
  `!P:real^A->bool. polyhedron P  /\ bounded P ==> 
    (!f. f facet_of P ==> FINITE { e | e facet_of f}) /\
        FINITE { f | f facet_of P } /\
   FINITE  {(f,e) | f facet_of P /\ e facet_of f}`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  CONJ_TAC;
    REPEAT WEAK_STRIP_TAC;
    GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `{e' | e' facet_of f } SUBSET {e' | e' face_of P}`)));
      BY(ASM_MESON_TAC[FINITE_SUBSET; FINITE_POLYHEDRON_FACES ]);
    REWRITE_TAC[SUBSET;IN_ELIM_THM];
    BY(ASM_MESON_TAC[FACET_OF_IMP_FACE_OF; FACE_OF_TRANS; SUBSET]);
  CONJ_TAC;
    MATCH_MP_TAC FINITE_POLYTOPE_FACETS;
    BY(ASM_MESON_TAC[ POLYTOPE_EQ_BOUNDED_POLYHEDRON ]);
  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}`)));
    BY(BY(ASM_MESON_TAC[ FINITE_SUBSET; FINITE_CROSS ; FINITE_POLYHEDRON_FACES ]));
  REWRITE_TAC[CROSS;SUBSET];
  REWRITE_TAC[IN_ELIM_THM];
  REPEAT WEAK_STRIP_TAC;
  BY(BY(ASM_MESON_TAC[PAIR; FACET_OF_IMP_FACE_OF; FACE_OF_TRANS]))
  ]);;
  (* }}} *)

let polyhedron_sum_sum_edge = 
prove_by_refinement(
  `!(P:real^3->bool) . bounded P /\ polyhedron P ==> 
   sum {f | f facet_of P } (\f. &(CARD {e | e facet_of f })) = 
     &( CARD {(f,e) | f facet_of P /\ e facet_of f})`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  GMATCH_SIMP_TAC CARD_EQ_SUM;
  ASM_SIMP_TAC[FINITE_EDGE];
  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));
    ONCE_REWRITE_TAC[ GSYM CARD_EQ_SUM ];
    BINOP_TAC;
      BY(REWRITE_TAC[IN_ELIM_THM]);
    REWRITE_TAC[FUN_EQ_THM];
    BY(REWRITE_TAC[ LAMBDA_PAIR ]);
  INTRO_TAC SUM_SUM_PRODUCT [`{f | f facet_of P}`;`\f. {e' | e' facet_of (f:real^3->bool)}`];
  DISCH_THEN (fun t -> MP_TAC (ISPEC (`(\ f e. &1):(real^3->bool)->(real^3->bool)->real`) t));
  ANTS_TAC;
    REWRITE_TAC[IN_ELIM_THM];
    ASM_SIMP_TAC[FINITE_EDGE];
    BY(ASM_MESON_TAC[FINITE_EDGE]);
  MATCH_MP_TAC (MESON[] (`(x = x') /\ (y = y') ==> ((x = y) ==> (x' = y'))`));
  CONJ_TAC;
    MATCH_MP_TAC SUM_EQ;
    REWRITE_TAC[IN_ELIM_THM];
    REPEAT WEAK_STRIP_TAC;
    GMATCH_SIMP_TAC CARD_EQ_SUM;
    BY(ASM_MESON_TAC[FINITE_EDGE]);
  BETA_TAC;
  BY(REWRITE_TAC[IN_ELIM_THM])
  ]);;
  (* }}} *)

let polyhedron_edge_sum = 
prove_by_refinement(
 `(!(P:real^3->bool) n. bounded P /\ polyhedron P /\ (vec 0) IN interior P /\
     {f | f facet_of P} HAS_SIZE n /\ (2 <= n) ==>
     sum {f | f facet_of P } (\f. &(CARD {e | e facet_of f })) <= &6 * &n - &12)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  ASM_SIMP_TAC[polyhedron_sum_sum_edge];
  TYPED_ABBREV_TAC `m = CARD {f,e | f facet_of (P:real^3->bool) /\ e facet_of f}`;
  GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `m <= 6 * n - 12`)));
    REWRITE_TAC[arith `&m <= x - &12 <=> &m + &12 <= x`];
    REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_MUL;REAL_OF_NUM_LE];
    FIRST_X_ASSUM_ST `2` MP_TAC;
    BY(ARITH_TAC);
  TYPED_ABBREV_TAC `H = hypermap1_of_fanx (vec 0,vertices P,edges (P:real^3->bool))`;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `n = number_of_faces H`) SUBST1_TAC));
    REWRITE_TAC[ Hypermap.number_of_faces ];
    FIRST_X_ASSUM_ST `HAS_SIZE` MP_TAC;
    REWRITE_TAC[HAS_SIZE];
    REPEAT WEAK_STRIP_TAC;
    EXPAND_TAC "n";
    MATCH_MP_TAC Misc_defs_and_lemmas.BIJ_CARD;
    ASM_REWRITE_TAC[];
    BY(ASM_MESON_TAC[ BIJ_FACET_HYPERFACE]);
  GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `m = CARD(dart H)`)));
    BY(ASM_MESON_TAC[POLYHEDRON_TGJISOK]);
  EXPAND_TAC "m";
  MATCH_MP_TAC Misc_defs_and_lemmas.BIJ_CARD;
  ASM_SIMP_TAC[FINITE_EDGE];
  GOAL_TERM (fun w -> (MATCH_MP_TAC (ISPEC ( env w`{(e,f) | e facet_of f /\ f facet_of P }`) BIJ_TRANS)));
  CONJ_TAC;
    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)`)));
    REWRITE_TAC[BIJ;INJ;SURJ;IN_ELIM_THM;FST;SND;PAIR_EQ];
    BY(ASM_MESON_TAC[PAIR;FST;SND]);
  MATCH_MP_TAC BIJ_SYM;
  EXPAND_TAC "H";
  MATCH_MP_TAC BIJ_DART_POLYEDGE;
  BY(ASM_REWRITE_TAC[])
  ]);;
  (* }}} *)


let  RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT_ALT  = 
prove_by_refinement(
  `!(V:A->bool) (P:real^B ->bool) h a b p v0.
    FINITE V /\
   (!v. (v IN V ) ==> (h v  = { p | a v dot p <= b v })) /\
   P = INTERS (IMAGE h V) /\
  (v0 IN V) /\ a v0 dot p = b v0 /\ 
  (!w. (w IN V) /\ ~(w = v0) ==> a w dot p < b w) ==> 
  (p IN relative_interior (P INTER { p | a v0 dot p= b v0}))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC[IN_RELATIVE_INTERIOR];
  REWRITE_TAC[IN_INTER;IN_INTERS;IN_IMAGE];
  REWRITE_TAC[IN_ELIM_THM];
  SUBCONJ_TAC;
    ASM_REWRITE_TAC[];
    ASM_REWRITE_TAC[IN_INTERS;IN_IMAGE];
    ASM_REWRITE_TAC[IN_ELIM_THM];
    REPEAT WEAK_STRIP_TAC;
    ASM_SIMP_TAC[];
    REWRITE_TAC[IN_ELIM_THM];
    GOAL_TERM (fun w -> (ASM_CASES_TAC ( env w `x = v0`)));
      BY(ASM_REWRITE_TAC[arith `u <= u`]);
    MATCH_MP_TAC (arith `x < y ==> x <= y`);
    BY(ASM_SIMP_TAC[]);
  DISCH_TAC;
  COMMENT "1";
  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));
    ASM_REWRITE_TAC[SUBSET;IN_INTER;IN_INTERS;IN_IMAGE;IN_DIFF;IN_SING];
    ASM_REWRITE_TAC[IN_ELIM_THM];
    REPEAT WEAK_STRIP_TAC;
    ASM_REWRITE_TAC[];
    REPEAT WEAK_STRIP_TAC;
    ASM_SIMP_TAC[];
    REWRITE_TAC[IN_ELIM_THM];
    GOAL_TERM (fun w -> (ASM_CASES_TAC ( env w `x' = v0`)));
      ASM_REWRITE_TAC[];
      BY(REWRITE_TAC[arith `u <= u`]);
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `x IN h x'`) MP_TAC));
      FIRST_X_ASSUM MATCH_MP_TAC;
      BY(ASM_MESON_TAC[]);
    ASM_SIMP_TAC[];
    BY(REWRITE_TAC[IN_ELIM_THM]);
  COMMENT "1b";
  TYPED_ABBREV_TAC `ho = \ (v:A). {(p : real^B) | a v dot p < b v}`;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!v. ho v = {p | a v dot p < b v}`) ASSUME_TAC));
    GEN_TAC;
    EXPAND_TAC "ho";
    BY(REWRITE_TAC[]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `p IN INTERS (IMAGE ho (V DIFF {v0}))`) ASSUME_TAC));
    REWRITE_TAC[IN_INTERS;IN_IMAGE;IN_DIFF;IN_SING];
    REPEAT WEAK_STRIP_TAC;
    ASM_REWRITE_TAC[];
    REWRITE_TAC[IN_ELIM_THM];
    BY(ASM_MESON_TAC[]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `open (INTERS (IMAGE ho (V DIFF {v0})))`) ASSUME_TAC));
    MATCH_MP_TAC OPEN_INTERS;
    SUBCONJ_TAC;
      MATCH_MP_TAC FINITE_IMAGE;
      MATCH_MP_TAC FINITE_DIFF;
      BY(ASM_REWRITE_TAC[]);
    DISCH_TAC;
    REWRITE_TAC[IN_IMAGE;IN_DIFF;IN_SING];
    REPEAT WEAK_STRIP_TAC;
    ASM_REWRITE_TAC[];
    BY(REWRITE_TAC[ OPEN_HALFSPACE_LT ]);
  FIRST_X_ASSUM MP_TAC;
  REWRITE_TAC[ OPEN_CONTAINS_BALL ];
  GOAL_TERM (fun w -> (DISCH_THEN (fun t -> MP_TAC (ISPEC ( env w `p`) t))));
  ASM_REWRITE_TAC[];
  REPEAT WEAK_STRIP_TAC;
  EXISTS_TAC `e:real`;
  ASM_REWRITE_TAC[];
  MATCH_MP_TAC SUBSET_TRANS;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `ball(p,e) INTER { p | a v0 dot p = b v0}`)));
  CONJ_TAC;
    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}`)));
      BY(SET_TAC[]);
    MATCH_MP_TAC SUBSET_TRANS;
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `affine hull {p | a v0 dot p = b v0}`)));
    CONJ_TAC;
      MATCH_MP_TAC Marchal_cells_2_new.AFFINE_SUBSET_KY_LEMMA;
      BY(SET_TAC[]);
    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}`)));
      BY(SET_TAC[]);
    INTRO_TAC AFFINE_HYPERPLANE [`a v0`;`b v0`];
    BY(MESON_TAC[ AFFINE_HULL_EQ ]);
  COMMENT "1c";
  MATCH_MP_TAC SUBSET_TRANS;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `INTERS (IMAGE h (V DIFF {v0})) INTER {p  | a v0 dot p = b v0}`)));
  CONJ2_TAC;
    BY(ASM_MESON_TAC[]);
  GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w`INTERS (IMAGE ho (V DIFF {v0})) SUBSET INTERS (IMAGE h (V DIFF {v0}))`)));
    FIRST_X_ASSUM MP_TAC;
    BY(SET_TAC[]);
  REWRITE_TAC[INTERS_IMAGE;SUBSET;IN_ELIM_THM;IN_DIFF;IN_SING];
  REPEAT WEAK_STRIP_TAC;
  ASM_SIMP_TAC[IN_ELIM_THM];
  GOAL_TERM (fun w -> (FIRST_X_ASSUM (fun t -> MP_TAC (ISPEC ( env w `x'`) t))));
  EXPAND_TAC "ho";
  REWRITE_TAC[IN_ELIM_THM];
  ASM_REWRITE_TAC[];
  BY(REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let FACET_RELEVANT = 
prove_by_refinement(
  `!(V:A->bool) a b (p:real^B) v0.
    FINITE V /\
    (!v. v IN V ==> (&0 < b v)) /\
    (a v0 dot p = b v0) /\ 
    (v0 IN V) /\
    (!w. w IN V /\ ~(v0 = w) ==> a w dot p < b w) ==>
    (?t. b v0 < a v0 dot (t % p) /\ 
       (!w. w IN V /\ ~(v0 = w) ==> a w dot (t % p) < b w))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  TYPED_ABBREV_TAC `h = (\ (v:A). { q | a v dot (q:real^B)  < b v })`;
  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));
    MATCH_MP_TAC OPEN_INTERS;
    SUBCONJ_TAC;
      MATCH_MP_TAC FINITE_IMAGE;
      MATCH_MP_TAC FINITE_DIFF;
      BY(BY(ASM_REWRITE_TAC[]));
    DISCH_TAC;
    REWRITE_TAC[IN_IMAGE;IN_DIFF;IN_SING];
    REPEAT WEAK_STRIP_TAC;
    ASM_REWRITE_TAC[];
    EXPAND_TAC "h";
    BY(BY(REWRITE_TAC[ OPEN_HALFSPACE_LT ]));
  FIRST_X_ASSUM MP_TAC;
  REWRITE_TAC[ OPEN_CONTAINS_BALL ];
  REWRITE_TAC[IN_IMAGE;IN_DIFF;IN_SING;IN_INTERS;SUBSET];
  GOAL_TERM (fun w -> (DISCH_THEN (fun t -> MP_TAC (ISPEC ( env w `p`) t))));
  ANTS_TAC;
    EXPAND_TAC "h";
    REPEAT WEAK_STRIP_TAC;
    ASM_REWRITE_TAC[IN_ELIM_THM];
    FIRST_X_ASSUM MATCH_MP_TAC;
    BY(ASM_MESON_TAC[]);
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`~(p = vec 0)`) ASSUME_TAC));
    DISCH_TAC;
    FIRST_X_ASSUM_ST `u dot v = c` MP_TAC;
    ASM_REWRITE_TAC[ DOT_RZERO ];
    BY(ASM_MESON_TAC[arith `&0 < x ==> ~(&0 = x)`]);
  TYPED_ABBREV_TAC `s = &1 + e / (&2 * norm (p:real^B))`;
  EXISTS_TAC `s:real`;
  COMMENT "1";
  SUBGOAL_THEN `&1 < s` ASSUME_TAC;
    EXPAND_TAC "s";
    MATCH_MP_TAC (arith `&0 < x ==> &1 < &1 +x `);
    MATCH_MP_TAC REAL_LT_DIV;
    ASM_REWRITE_TAC[];
    MATCH_MP_TAC (arith `&0 < x ==> &0 < &2 * x`);
    BY(ASM_REWRITE_TAC[ NORM_POS_LT ]);
  CONJ_TAC;
    ASM_REWRITE_TAC[ DOT_RMUL ];
    MATCH_MP_TAC (arith `&1 * x < s * x ==> x < s * x`);
    MATCH_MP_TAC REAL_LT_RMUL;
    BY(ASM_SIMP_TAC[]);
  COMMENT "1b";
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (FIRST_X_ASSUM (MP_TAC o (ISPEC ( env w `s % p`)))));
  ANTS_TAC;
    REWRITE_TAC[IN_BALL];
    ONCE_REWRITE_TAC[DIST_SYM];
    REWRITE_TAC[dist];
    GOAL_TERM (fun w -> (REWRITE_TAC[varith ( env w `s % p - p = (s - &1) % p`)]));
    REWRITE_TAC[ NORM_MUL ];
    ASM_SIMP_TAC[arith `&1 < s ==> abs (s - &1) = (s - &1)`];
    EXPAND_TAC "s";
    REWRITE_TAC[arith `(&1 + x) - &1 = x`];
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( ( env w`(e / (&2 * norm p) * norm p = e / &2)`)) SUBST1_TAC));
      Calc_derivative.CALC_ID_TAC;
      ASM_REWRITE_TAC[ NORM_EQ_0 ];
      BY(REAL_ARITH_TAC);
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  COMMENT "1c";
  GOAL_TERM (fun w -> (DISCH_THEN (MP_TAC o (ISPEC ( env w `h w`)))));
  EXPAND_TAC "h";
  REWRITE_TAC[IN_ELIM_THM];
  DISCH_THEN MATCH_MP_TAC;
  BY(ASM_MESON_TAC[])
  ]);;
  (* }}} *)

let FACET_OF_POLYHEDRON_EXPLICIT_ALT  = 
prove_by_refinement(
 `!(V:A->bool) (P:real^B->bool) h a b.
   FINITE V /\
   (vec 0) IN interior P /\
   (!v. (v IN V ) ==> (h v  = { p | a v dot p <= b v })) /\
   (!v. v IN V ==> (&0 < b v)) /\
   INTERS (IMAGE h V) = P /\
  (!v. (v IN V ) ==> ~(a v = (vec 0))) /\
  (!v. (v IN V)  ==> (?p. a v dot p = b v /\ (!w. (w IN V) /\ ~(v = w) ==> a w dot p < b w))) ==>
  (BIJ (\v. P INTER {p | a v dot p = b v}) V { c | c facet_of P })`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!f. (f IN IMAGE h V) ==> (?q. (q IN V) /\ f = h q)`) MP_TAC));
    REWRITE_TAC[IN_IMAGE];
    BY(MESON_TAC[]);
  REWRITE_TAC[ RIGHT_IMP_EXISTS_THM ];
  REWRITE_TAC[SKOLEM_THM];
  REPEAT WEAK_STRIP_TAC;
  INTRO_TAC FACET_OF_POLYHEDRON_EXPLICIT [`P`;`(IMAGE h V)`;`(\f. a (q f))`;`(\f. b (q f))`];
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(FINITE (IMAGE h V))`) ASSUME_TAC));
    MATCH_MP_TAC FINITE_IMAGE;
    BY(ASM_REWRITE_TAC[]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(affine hull P) = (:real^B)`) SUBST1_TAC));
    BY(ASM_MESON_TAC[ AFFINE_HULL_NONEMPTY_INTERIOR; NOT_IN_EMPTY ]);
  ASM_REWRITE_TAC[ INTER_UNIV ];
  COMMENT "1";
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(!f'. f' PSUBSET IMAGE h V ==> P PSUBSET INTERS f')`) ASSUME_TAC));
    REWRITE_TAC[PSUBSET];
    REWRITE_TAC[SUBSET_IMAGE];
    REPEAT WEAK_STRIP_TAC;
    CONJ_TAC;
      ASM_REWRITE_TAC[];
      EXPAND_TAC "P";
      FIRST_X_ASSUM_ST `SUBSET` MP_TAC;
      REWRITE_TAC[INTERS;IN_IMAGE;SUBSET];
      REWRITE_TAC[IN_ELIM_THM];
      BY(MESON_TAC[]);
    COMMENT "2";
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?v0. v0 IN V /\ ~(h v0 IN f')`) MP_TAC));
      REPLICATE_TAC 2 (FIRST_X_ASSUM_ST `IMAGE` MP_TAC);
      REWRITE_TAC[IMAGE];
      ONCE_REWRITE_TAC[FUN_EQ_THM];
      REWRITE_TAC[IN_ELIM_THM];
      FIRST_X_ASSUM MP_TAC;
      REWRITE_TAC[SUBSET;IN];
      BY(MESON_TAC[]);
    REPEAT WEAK_STRIP_TAC;
    GOAL_TERM (fun w -> (FIRST_X_ASSUM (fun t -> MP_TAC (ISPEC ( env w `v0`) t))));
    ASM_REWRITE_TAC[];
    REWRITE_TAC[NOT_EXISTS_THM];
    REPEAT WEAK_STRIP_TAC;
    INTRO_TAC FACET_RELEVANT [`V`;`a`;`b`;`p`;`v0`];
    ASM_REWRITE_TAC[];
    REWRITE_TAC[ NOT_EXISTS_THM ];
    GEN_TAC;
    MATCH_MP_TAC (TAUT `(b ==> ~a) ==> ~(a /\ b)`);
    DISCH_TAC;
    MATCH_MP_TAC (arith `x <= y ==> ~(y < x)`);
    GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `t % p IN P`)));
      EXPAND_TAC "P";
      REWRITE_TAC[INTERS_IMAGE;IN_ELIM_THM];
      GOAL_TERM (fun w -> (DISCH_THEN (MP_TAC o (ISPEC ( env w`v0`)))));
      ASM_SIMP_TAC[];
      BY(REWRITE_TAC[IN_ELIM_THM]);
    ASM_REWRITE_TAC[];
    REWRITE_TAC[INTERS_IMAGE;IN_ELIM_THM];
    REPEAT WEAK_STRIP_TAC;
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(v0 IN u)`) ASSUME_TAC));
      DISCH_TAC;
      REPEAT (FIRST_X_ASSUM_ST `IN` MP_TAC);
      ASM_REWRITE_TAC[IN_IMAGE];
      BY(MESON_TAC[]);
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `x IN V`) ASSUME_TAC));
      BY(ASM_MESON_TAC[SUBSET]);
    ASM_SIMP_TAC[];
    REWRITE_TAC[IN_ELIM_THM];
    MATCH_MP_TAC (arith `x < y ==> x <= y`);
    FIRST_X_ASSUM MATCH_MP_TAC;
    BY(ASM_MESON_TAC[]);
  COMMENT "1";
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!v w. v IN V /\ w IN V /\ (h v = h w) ==> (v = w)`) ASSUME_TAC));
    REPEAT WEAK_STRIP_TAC;
    FIRST_X_ASSUM MP_TAC;
    ASM_SIMP_TAC[];
    ONCE_REWRITE_TAC[FUN_EQ_THM];
    REWRITE_TAC[IN_ELIM_THM];
    DISCH_TAC;
    PROOF_BY_CONTR_TAC;
    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));
      AP_TERM_TAC;
      ONCE_REWRITE_TAC[FUN_EQ_THM];
      REWRITE_TAC[IN_ELIM_THM];
      BY(ASM_REWRITE_TAC[]);
    ASM_SIMP_TAC[ INTERIOR_HALFSPACE_LE ];
    ONCE_REWRITE_TAC[FUN_EQ_THM];
    REWRITE_TAC[IN_ELIM_THM];
    BY(ASM_MESON_TAC[arith `x = y ==> ~(x < y)`]);
  COMMENT "1b";
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!x. x IN V ==> (q(h x) = x)`) MP_TAC));
    REPEAT WEAK_STRIP_TAC;
    FIRST_X_ASSUM MATCH_MP_TAC;
    ASM_REWRITE_TAC[];
    ONCE_REWRITE_TAC[ EQ_SYM_EQ ];
    FIRST_X_ASSUM MATCH_MP_TAC;
    REWRITE_TAC[IN_IMAGE];
    BY(ASM_MESON_TAC[]);
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  COMMENT "1b";
  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));
    REWRITE_TAC[IN_IMAGE];
    REPEAT WEAK_STRIP_TAC;
    ASM_REWRITE_TAC[];
    CONJ_TAC;
      FIRST_X_ASSUM MATCH_MP_TAC;
      BY(ASM_MESON_TAC[IN_IMAGE]);
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `q (h x) = x`) SUBST1_TAC));
      FIRST_X_ASSUM MATCH_MP_TAC;
      BY(ASM_REWRITE_TAC[]);
    FIRST_X_ASSUM MATCH_MP_TAC;
    BY(ASM_REWRITE_TAC[]);
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  COMMENT "1c";
  REWRITE_TAC[ BIJ; INJ ];
  SUBCONJ_TAC;
    SUBCONJ_TAC;
      REPEAT WEAK_STRIP_TAC;
      GOAL_TERM (fun w -> (FIRST_X_ASSUM (MP_TAC o (ISPEC ( env w `P INTER {p | a x dot p = b x}`)))));
      REWRITE_TAC[IN_ELIM_THM];
      DISCH_THEN SUBST1_TAC;
      BY(ASM_MESON_TAC[IN_IMAGE]);
    DISCH_TAC;
    REPEAT WEAK_STRIP_TAC;
    PROOF_BY_CONTR_TAC;
    GOAL_TERM (fun w -> (FIRST_X_ASSUM_ST `<` (MP_TAC o (ISPEC ( env w `y`)))));
    ANTS_TAC;
      BY(ASM_REWRITE_TAC[]);
    REPEAT WEAK_STRIP_TAC;
    FIRST_X_ASSUM_ST `INTER` MP_TAC;
    REWRITE_TAC[FUN_EQ_THM;X_IN IN_INTER;IN_ELIM_THM];
    EXPAND_TAC "P";
    REWRITE_TAC[INTERS_IMAGE;IN_ELIM_THM];
    RENAME_FREE_VAR (`x:A`,"v");
    REBIND_TAC (`x:A`,"w");
    REWRITE_TAC[ NOT_FORALL_THM ];
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `p`)));
    ASM_REWRITE_TAC[];
    MATCH_MP_TAC (TAUT (`a /\ ~b ==> (~(a /\ b <=> a))`));
    CONJ2_TAC;
      BY(ASM_MESON_TAC[arith `x < y ==> ~(x = y)`]);
    REPEAT WEAK_STRIP_TAC;
    ASM_SIMP_TAC[];
    REWRITE_TAC[IN_ELIM_THM];
    GOAL_TERM (fun w -> (ASM_CASES_TAC ( env w `y = w`)));
      EXPAND_TAC "w";
      REPLICATE_TAC 2 (FIRST_X_ASSUM_ST `dot` MP_TAC);
      BY(REAL_ARITH_TAC);
    MATCH_MP_TAC (arith `x < y ==> x <=y`);
    REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC);
    BY(MESON_TAC[]);
  REPEAT WEAK_STRIP_TAC;
  COMMENT "1d:SUR";
  REWRITE_TAC[SURJ];
  CONJ_TAC;
    BY(ASM_REWRITE_TAC[]);
  REWRITE_TAC[IN_ELIM_THM];
  REPEAT WEAK_STRIP_TAC;
  RENAME_FREE_VAR (`x:real^B->bool`,"c");
  FIRST_X_ASSUM MP_TAC;
  ASM_SIMP_TAC[];
  REWRITE_TAC[IN_IMAGE];
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `q h'`)));
  ASM_REWRITE_TAC[];
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `h x IN IMAGE h V`) MP_TAC));
    BY(ASM_MESON_TAC[IN_IMAGE]);
  BY(ASM_MESON_TAC[])
  ]);;
  (* }}} *)

let EXISTS_M_POLYHEDRON = 
prove_by_refinement(
`!(V:real^3 -> bool) theta r n.
    V SUBSET ball_annulus /\ packing V /\ 
    weakly_saturated V r (&2 * h0) /\
    (V HAS_SIZE n) /\
   ~(V = {}) /\ 
    (&2 <= r /\ r <= &2 * h0) /\
    (!v w. v IN V /\ w IN V /\ ~(v = w) ==> theta v + theta w <= arcV (vec 0) v w) /\
    (!v. v IN V ==> &0 < theta v /\ theta v < pi/ &2) ==>
    (?b f h P .
       (!v. v IN V ==> h v = {p | v dot p <= b v}) /\
        INTERS (IMAGE h V) = P /\
	(!v. v IN V ==> &0 < b v) /\
	polyhedron P /\
	bounded P /\
	(vec 0 IN interior P) /\
	BIJ f V {c |c facet_of P} /\
	(!v. v IN V ==> f v = P INTER { p | v dot p = b v}) /\
	(!v. v IN V ==> b v = norm v * cos (theta v)) /\
	(!v. v IN V ==> rcone_gt (vec 0) v (cos (theta v)) SUBSET fchanged (f v)) /\
	(!v. v IN V ==> &0 < cos (theta v) /\ cos(theta v) < &1))
    `,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!v. v IN V ==> ~(v = vec 0)`) ASSUME_TAC));
    FIRST_X_ASSUM_ST `ball_annulus` MP_TAC;
    REWRITE_TAC[ Pack_defs.ball_annulus ];
    REWRITE_TAC[ SUBSET; DIFF ;IN_ELIM_THM;ball;];
    ONCE_REWRITE_TAC[DIST_SYM];
    REWRITE_TAC[dist;varith `x - vec 0 = x`];
    BY(MESON_TAC[ NORM_0 ; arith `&0 < &2`]);
  COMMENT "0";
  TYPED_ABBREV_TAC `b = \ (v:real^3). norm v * cos (theta v)`;
  TYPED_ABBREV_TAC `h = \ (v:real^3). { p | v dot p <= b v }`;
  TYPED_ABBREV_TAC `(P:real^3->bool) = INTERS (IMAGE h (V:real^3->bool))`;
  TYPED_ABBREV_TAC `f = \ (v:real^3). P INTER { p | v dot p = b v}`;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `b`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `f`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `h`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `P`)));
  SUBCONJ_TAC;
    BY(ASM_MESON_TAC[]);
  DISCH_TAC;
  SUBCONJ_TAC;
    BY(ASM_REWRITE_TAC[]);
  DISCH_TAC;
  SUBGOAL_THEN (`(!v. v IN V ==> &0 < cos (theta v) /\ cos (theta (v:real^3)) < &1)`) ASSUME_TAC;
    BY(ASM_MESON_TAC[cos_bounds_0_Pi2]);
  ASM_REWRITE_TAC[];
  SUBGOAL_THEN (`(!v. v IN V ==> f v = P INTER {p | v dot p = b (v:real^3) })`) ASSUME_TAC;
    BY(ASM_MESON_TAC[]);
  ASM_REWRITE_TAC[];
  SUBGOAL_THEN (` (!v. v IN V ==> b v = norm v * cos (theta (v:real^3)))`) ASSUME_TAC;
    BY(ASM_MESON_TAC[]);
  ASM_REWRITE_TAC[];
  COMMENT "1";
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `polyhedron P`) ASSUME_TAC));
    REWRITE_TAC[ polyhedron ];
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `IMAGE h V`)));
    ASM_REWRITE_TAC[];
    CONJ_TAC;
      MATCH_MP_TAC FINITE_IMAGE;
      BY(ASM_MESON_TAC[HAS_SIZE]);
    REWRITE_TAC[IN_IMAGE];
    REPEAT WEAK_STRIP_TAC;
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `x`)));
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `b x`)));
    CONJ_TAC;
      FIRST_X_ASSUM MATCH_MP_TAC;
      BY(ASM_REWRITE_TAC[]);
    ASM_REWRITE_TAC[FUN_EQ_THM;IN_ELIM_THM];
    EXPAND_TAC "h";
    BY(REWRITE_TAC[IN_ELIM_THM]);
  ASM_REWRITE_TAC[];
  COMMENT "1b";
  SUBCONJ_TAC;
    REPEAT WEAK_STRIP_TAC;
    ASM_SIMP_TAC[];
    MATCH_MP_TAC Real_ext.REAL_PROP_POS_MUL2;
    ASM_SIMP_TAC[];
    REWRITE_TAC[ NORM_POS_LT ];
    BY(ASM_SIMP_TAC[]);
  DISCH_TAC;
  COMMENT "1c";
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(vec 0) IN P`) ASSUME_TAC));
    EXPAND_TAC "P";
    REWRITE_TAC[INTERS_IMAGE;IN_ELIM_THM];
    REPEAT WEAK_STRIP_TAC;
    EXPAND_TAC "h";
    REWRITE_TAC[IN_ELIM_THM];
    REWRITE_TAC[DOT_RZERO];
    BY(ASM_MESON_TAC[arith `&0 < x ==> &0 <= x`]);
  TYPED_ABBREV_TAC `ho = \ (v:real^3). {(p : real^3) |  v dot p < b v}`;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!v. ho v = {p | v dot p < b v}`) ASSUME_TAC));
    GEN_TAC;
    EXPAND_TAC "ho";
    BY(BY(REWRITE_TAC[]));
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(vec 0) IN INTERS (IMAGE ho V)`) ASSUME_TAC));
    REWRITE_TAC[INTERS_IMAGE;IN_ELIM_THM];
    REPEAT WEAK_STRIP_TAC;
    EXPAND_TAC "ho";
    REWRITE_TAC[IN_ELIM_THM];
    REWRITE_TAC[DOT_RZERO];
    BY(ASM_MESON_TAC[]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `open (INTERS (IMAGE ho (V )))`) ASSUME_TAC));
    MATCH_MP_TAC OPEN_INTERS;
    SUBCONJ_TAC;
      MATCH_MP_TAC FINITE_IMAGE;
      BY(ASM_MESON_TAC[HAS_SIZE]);
    DISCH_TAC;
    REWRITE_TAC[IN_IMAGE];
    REPEAT WEAK_STRIP_TAC;
    ASM_REWRITE_TAC[];
    BY(BY(REWRITE_TAC[ OPEN_HALFSPACE_LT ]));
  FIRST_X_ASSUM MP_TAC;
  REWRITE_TAC[ OPEN_CONTAINS_BALL ];
  GOAL_TERM (fun w -> (DISCH_THEN (fun t -> MP_TAC (ISPEC ( env w `(vec 0):real^3`) t))));
  ASM_REWRITE_TAC[];
  REPEAT WEAK_STRIP_TAC;
  COMMENT "1d";
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `vec 0 IN interior P`) ASSUME_TAC));
    REWRITE_TAC[ IN_INTERIOR];
    EXISTS_TAC `e:real`;
    ASM_REWRITE_TAC[];
    MATCH_MP_TAC SUBSET_TRANS;
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `INTERS (IMAGE ho V)`)));
    ASM_REWRITE_TAC[];
    EXPAND_TAC "P";
    REWRITE_TAC[SUBSET;INTERS_IMAGE];
    REWRITE_TAC[IN_ELIM_THM];
    EXPAND_TAC "ho";
    EXPAND_TAC "h";
    REWRITE_TAC[IN_ELIM_THM];
    REPEAT WEAK_STRIP_TAC;
    MATCH_MP_TAC (arith `x < y ==> x <= y`);
    FIRST_X_ASSUM MATCH_MP_TAC;
    BY(ASM_REWRITE_TAC[]);
  ASM_REWRITE_TAC[];
  COMMENT "1e";
  SUBCONJ_TAC;
    MATCH_MP_TAC Tarjjuw.TARJJUW;
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `V`)));
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `b`)));
    EXISTS_TAC `r:real`;
    EXISTS_TAC `&2 * h0`;
    ASM_REWRITE_TAC[];
    SUBCONJ_TAC;
      FIRST_X_ASSUM_ST `ball_annulus` MP_TAC;
      REWRITE_TAC[Pack_defs.ball_annulus];
      REWRITE_TAC[SUBSET;DIFF];
      REWRITE_TAC[IN_UNIV;IN_ELIM_THM];
      BY(MESON_TAC[]);
    DISCH_TAC;
    SUBCONJ_TAC;
      BY(ASM_MESON_TAC[HAS_SIZE]);
    DISCH_TAC;
    EXPAND_TAC "P";
    REWRITE_TAC[INTERS_IMAGE];
    REWRITE_TAC[INTERS;IN_ELIM_THM];
    REWRITE_TAC[FUN_EQ_THM;IN_ELIM_THM];
    REBIND_TAC (`u:real^3`,"w");
    EXPAND_TAC "h";
    REWRITE_TAC[IN_ELIM_THM; Tarjjuw.half_spaces];
    GEN_TAC;
    ONCE_REWRITE_TAC[ Geomdetail.EQ_EXPAND];
    SUBCONJ_TAC;
      REPEAT WEAK_STRIP_TAC;
      REWRITE_TAC[IN];
      BY(ASM_MESON_TAC[]);
    REPEAT WEAK_STRIP_TAC;
    GOAL_TERM (fun w -> (FIRST_X_ASSUM (MP_TAC o (ISPEC ( env w `{x | x' dot x <= b x'}`)))));
    REWRITE_TAC[IN_ELIM_THM];
    DISCH_THEN MATCH_MP_TAC;
    BY(ASM_MESON_TAC[]);
  DISCH_TAC;
  COMMENT "1f";
  SUBCONJ_TAC;
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(f = (\v. P INTER {p | I v dot p = b v}))`) SUBST1_TAC));
      EXPAND_TAC "f";
      BY(REWRITE_TAC[I_DEF]);
    MATCH_MP_TAC FACET_OF_POLYHEDRON_EXPLICIT_ALT;
    REWRITE_TAC[I_DEF];
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `h`)));
    ASM_REWRITE_TAC[];
    CONJ_TAC;
      BY(ASM_MESON_TAC[HAS_SIZE]);
    REPEAT WEAK_STRIP_TAC;
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `(b v / (v dot v)) % v`)));
    CONJ_TAC;
      REWRITE_TAC[ DOT_RMUL ];
      Calc_derivative.CALC_ID_TAC;
      BY(ASM_MESON_TAC[ DOT_EQ_0 ]);
    REPEAT WEAK_STRIP_TAC;
    INTRO_TAC rcone_gt_facet [`theta v`;`theta w`;`v`;`w`;`(b v / (v dot v)) % v`;`v`];
    ASM_SIMP_TAC[];
    ANTS_TAC;
      MATCH_MP_TAC rcone_refl;
      BY(ASM_MESON_TAC[]);
    MATCH_MP_TAC (arith `(x = y) ==> (x < z ==> y < z)`);
    REWRITE_TAC[DOT_RMUL;DOT_LMUL];
    BY(MESON_TAC[DOT_SYM]);
  DISCH_TAC;
  COMMENT "1g";
  REWRITE_TAC[SUBSET];
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC[ Polyhedron.fchanged ];
  REWRITE_TAC[ IN_ELIM_THM];
  TYPED_ABBREV_TAC `s = ((b:real^3->real) v)/ (x dot v)`;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `s % x`)));
  EXISTS_TAC (`&1 / s`);
  CONJ_TAC;
    REWRITE_TAC[ VECTOR_MUL_ASSOC ];
    REWRITE_TAC[ varith ` (x = u % x) <=> &1 % x = u % x `];
    REWRITE_TAC[ VECTOR_MUL_RCANCEL ];
    DISJ1_TAC;
    EXPAND_TAC "s";
    Calc_derivative.CALC_ID_TAC;
    ASM_SIMP_TAC[arith `~(&1 = &0)`;arith `&0 < x ==> ~(x = &0)`];
    MATCH_MP_TAC (arith `&0 < x ==> ~(x = &0)`);
    MATCH_MP_TAC rcone_dot_pos;
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `cos (theta v)`)));
    BY(ASM_SIMP_TAC[]);
  COMMENT "1h";
  CONJ2_TAC;
    EXPAND_TAC "s";
    MATCH_MP_TAC (arith `&0 < x ==> x > &0`);
    REWRITE_TAC[ GSYM Collect_geom.POS_EQ_INV_POS ];
    MATCH_MP_TAC REAL_LT_DIV;
    ASM_SIMP_TAC[];
    MATCH_MP_TAC rcone_dot_pos;
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `cos (theta v)`)));
    BY(ASM_SIMP_TAC[]);
  EXPAND_TAC "f";
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{p | v dot p = b v} = {p |  I v dot p = b v}`) SUBST1_TAC));
    BY(REWRITE_TAC[I_DEF]);
  MATCH_MP_TAC RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT_ALT;
  REWRITE_TAC[I_DEF];
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `V`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `h`)));
  ASM_REWRITE_TAC[];
  CONJ_TAC;
    BY(ASM_MESON_TAC[HAS_SIZE]);
  SUBCONJ_TAC;
    EXPAND_TAC "s";
    REWRITE_TAC[DOT_RMUL];
    Calc_derivative.CALC_ID_TAC;
    CONJ_TAC;
      MATCH_MP_TAC (arith `&0 < x ==> ~(x = &0)`);
      MATCH_MP_TAC rcone_dot_pos;
      GOAL_TERM (fun w -> (EXISTS_TAC ( env w `cos(theta v)`)));
      BY(ASM_SIMP_TAC[]);
    BY(ASM_MESON_TAC[DOT_SYM;arith `(x = z) ==> y * x - z * y = &0`]);
  REPEAT WEAK_STRIP_TAC;
  EXPAND_TAC "b";
  ONCE_REWRITE_TAC[DOT_SYM];
  MATCH_MP_TAC rcone_gt_facet;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `theta v`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `v`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `x`)));
  ASM_SIMP_TAC[];
  EXPAND_TAC "s";
  EXPAND_TAC "b";
  BY(REWRITE_TAC[])
  ]);;
  (* }}} *)

let LMFUN_LE_1 = 
prove_by_refinement(
  `!h. &1 <= h ==> lmfun h <= &1`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC[ Pack_defs.lmfun ];
  COND_CASES_TAC;
    ENOUGH_TO_SHOW_TAC (`(h0 - h)/ (h0 - &1) <= (h0 - &1) / (h0 - &1)`);
      MATCH_MP_TAC (arith `(x = y) ==> (z <= x ==> z <= y)`);
      Calc_derivative.CALC_ID_TAC;
      REWRITE_TAC[ Sphere.h0 ];
      BY(REAL_ARITH_TAC);
    GMATCH_SIMP_TAC REAL_LE_DIV2_EQ;
    REPEAT (FIRST_X_ASSUM MP_TAC);
    REWRITE_TAC [Sphere.h0];
    BY(REAL_ARITH_TAC);
  BY(REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let LMFUN_INEQ_CENTER_IMP_13 = 
prove_by_refinement(
  `!V. FINITE V /\ (V SUBSET ball_annulus) /\ ~(lmfun_ineq_center V) ==>
    (13 <= CARD V)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[ Pack_defs.lmfun_ineq_center ];
  REWRITE_TAC[SUBSET; ckq_in_ball_annulus ];
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC (arith `~(CARD V <= 12) ==> (13 <= CARD V)`);
  DISCH_TAC;
  FIRST_X_ASSUM_ST `lmfun` MP_TAC;
  REWRITE_TAC[];
  MATCH_MP_TAC REAL_LE_TRANS;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `sum V (\v. &1)`)));
  CONJ_TAC;
    MATCH_MP_TAC SUM_LE;
    ASM_REWRITE_TAC[];
    REPEAT WEAK_STRIP_TAC;
    REWRITE_TAC[ Marchal_cells_3.HL_2 ];
    REWRITE_TAC[ DIST_0 ];
    MATCH_MP_TAC LMFUN_LE_1;
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `&2 <= norm x`) MP_TAC));
      BY(ASM_MESON_TAC[]);
    BY(REAL_ARITH_TAC);
  ASM_SIMP_TAC [ GSYM CARD_EQ_SUM ];
  BY(ASM_REWRITE_TAC[ REAL_OF_NUM_LE ])
  ]);;
  (* }}} *)

let  LMFUN_INEQ_CENTER_SUBSET = 
prove_by_refinement(
  `!V W. FINITE V /\ W SUBSET V /\ (lmfun_ineq_center V)  ==>
    (lmfun_ineq_center W)`,

  (* {{{ proof *)
  [
  REPEAT GEN_TAC;
  REWRITE_TAC[ Pack_defs.lmfun_ineq_center ];
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC REAL_LE_TRANS;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `sum V (\v. lmfun (hl [vec 0; v]))`)));
  ASM_REWRITE_TAC[];
  MATCH_MP_TAC SUM_SUBSET_SIMPLE;
  ASM_REWRITE_TAC[];
  BY(ASM_MESON_TAC[ Marchal_cells_3.lmfun_pos_le ])
  ]);;
  (* }}} *)

let SATURATE_BALL_ANNULUS = 
prove_by_refinement(
  `!W S r. packing W /\ W SUBSET ball_annulus /\ ~(lmfun_ineq_center W) /\ (S SUBSET W) /\
     &2 <= r /\ r <= &2 * h0 /\ 
    (!v w. S v /\ W w /\ dist(v,w) < r ==> (v = w)  ) ==>
    (?V. V SUBSET ball_annulus /\ packing V /\ 
      weakly_saturated V r (&2 * h0) /\ FINITE V /\ (W SUBSET V) /\
      (!v w. S v /\ V w /\ dist(v,w)< r ==> (v = w)) /\
    ~(lmfun_ineq_center V) /\ (13 <= CARD V))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  INTRO_TAC weak_saturation [`W`;`S`;`r`];
  ASM_REWRITE_TAC[];
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `V`)));
  ASM_REWRITE_TAC[];
  SUBCONJ_TAC;
    BY(ASM_MESON_TAC[ LMFUN_INEQ_CENTER_SUBSET]);
  DISCH_TAC;
  MATCH_MP_TAC LMFUN_INEQ_CENTER_IMP_13;
  BY(ASM_REWRITE_TAC[])
  ]);;
  (* }}} *)

let POLYHEDRON_FACET_SUM_4Pi = 
prove_by_refinement(
  `!(P:real^3->bool). polyhedron P /\ bounded P /\
    (vec 0) IN interior P ==>
    (sum {c | c facet_of P } (\c. sol (vec 0) (fchanged c)) = &4 * pi)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  INTRO_TAC (GSYM Conforming.SUM_SOL_IN_FACE_SET_EQ_4PI) [`(vec 0):real^3`;`vertices P`;`edges P`];
  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));
    BY(ASM_SIMP_TAC[ Polyhedron.POLYHEDRON_FAN; POLYHEDRON_CONFORMING_FAN]);
  WEAK_STRIP_TAC;
  ASM_REWRITE_TAC[];
  DISCH_THEN SUBST1_TAC;
  ASM_SIMP_TAC[GSYM Conforming.SUM_SOL_IN_TOPOLOGICAL_COMPONENET_EQ_IN_FACE_SET];
  INTRO_TAC Polyhedron.AMHFNXP_BIJ [`P`];
  ASM_REWRITE_TAC[];
  REWRITE_TAC[BIJ;INJ];
  REPEAT WEAK_STRIP_TAC;
  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));
    MATCH_MP_TAC Misc_defs_and_lemmas.SURJ_IMAGE;
    ASM_REWRITE_TAC[];
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{c | c facet_of P} =  (\f. f facet_of P)`) ASSUME_TAC));
      BY(REWRITE_TAC[FUN_EQ_THM;IN_ELIM_THM]);
    BY(ASM_REWRITE_TAC[]);
  GMATCH_SIMP_TAC SUM_IMAGE;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{c | c facet_of P} =  (\f. f facet_of P)`) SUBST1_TAC));
    BY(REWRITE_TAC[FUN_EQ_THM;IN_ELIM_THM]);
  ASM_REWRITE_TAC[];
  REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
  REWRITE_TAC[FUN_EQ_THM];
  BY(REWRITE_TAC[o_DEF])
  ]);;
  (* }}} *)

let COSG = 
prove_by_refinement(
  `!h. -- &2 <= h /\ h <= &2 /\ g = acs (h/ &2) - pi / &6 ==> 
      cos g = h * sqrt(&3) / &4 + sqrt (&1 - (h / &2) pow 2) / &2`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[ COS_SUB];
  REWRITE_TAC[ COS_PI6; SIN_PI6];
  GMATCH_SIMP_TAC COS_ACS;
  GMATCH_SIMP_TAC SIN_ACS;
  BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let FACET_FINITE = 
prove_by_refinement(
  `!(p:real^3->bool) f. polyhedron p /\ f facet_of p ==>
    FINITE { e | e facet_of f}`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC FINITE_SUBSET;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `{ e | e face_of p}`)));
  ASM_SIMP_TAC[ FINITE_POLYHEDRON_FACES ];
  REWRITE_TAC[SUBSET;IN_ELIM_THM];
  BY(ASM_MESON_TAC[ FACET_OF_IMP_FACE_OF; FACE_OF_TRANS ])
  ]);;
  (* }}} *)

let BIJ_SUM = 
prove_by_refinement(
  `!(A:A->bool) (B:B->bool) f ab.
    BIJ ab A B ==> (sum A (f o ab) = sum B f)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[BIJ;INJ];
  BY(ASM_MESON_TAC[ SUM_IMAGE ; Misc_defs_and_lemmas.SURJ_IMAGE ])
  ]);;
  (* }}} *)

let CARD_AT_LEAST3 = 
prove_by_refinement(
  `!x y z (A:A->bool). FINITE A /\ x IN A /\ y IN A /\ z IN A /\
     ~(x = y) /\ ~(y = z) /\ ~(x = z) ==>
    (3 <= CARD A)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC (arith `2 <= CARD A /\ ~(CARD A = 2) ==> (3 <= CARD A)`);
  SUBCONJ_TAC;
    MATCH_MP_TAC Hypermap.CARD_ATLEAST_2;
    BY(ASM_MESON_TAC[]);
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `CARD {x,y} < CARD A`) ASSUME_TAC));
    MATCH_MP_TAC CARD_PSUBSET;
    ASM_REWRITE_TAC[ PSUBSET_MEMBER ];
    CONJ_TAC;
      BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN SET_TAC[]);
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `z`)));
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN SET_TAC[]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `CARD {x,y} = 2`) ASSUME_TAC));
    MATCH_MP_TAC Hypermap.CARD_TWO_ELEMENTS;
    BY(ASM_REWRITE_TAC[]);
  REPLICATE_TAC 4 (FIRST_X_ASSUM MP_TAC);
  BY(ARITH_TAC)
  ]);;
  (* }}} *)

let polyhedron_3_facets = 
prove_by_refinement(
  `!(p:real^A->bool). polyhedron p /\ bounded p /\ (&1 < aff_dim p) ==>
    FINITE { c | c facet_of p } /\ 3 <= CARD {c | c facet_of p }    `,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  SUBCONJ_TAC;
    BY(ASM_MESON_TAC[ FINITE_POLYHEDRON_FACETS ]);
  DISCH_TAC;
  INTRO_TAC POLYTOPE_FACET_EXISTS [`p`];
  ANTS_TAC;
    CONJ_TAC;
      BY(ASM_REWRITE_TAC[ POLYTOPE_EQ_BOUNDED_POLYHEDRON ]);
    FIRST_X_ASSUM_ST `aff_dim` MP_TAC;
    BY(INT_ARITH_TAC);
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`f SUBSET p`) ASSUME_TAC));
    BY(ASM_MESON_TAC[facet_of;FACE_OF_IMP_SUBSET]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(f = p)`) ASSUME_TAC));
    BY(ASM_MESON_TAC[ FACET_OF_REFL]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?x. x IN p DIFF f`) MP_TAC));
    REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC);
    BY(SET_TAC[]);
  REPEAT WEAK_STRIP_TAC;
  INTRO_TAC KREIN_MILMAN_MINKOWSKI [`p`];
  ANTS_TAC;
    CONJ_TAC;
      BY(ASM_SIMP_TAC [ POLYHEDRON_IMP_CONVEX ]);
    BY(ASM_MESON_TAC[POLYTOPE_IMP_COMPACT;POLYTOPE_EQ_BOUNDED_POLYHEDRON]);
  DISCH_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?y. y extreme_point_of p /\ ~(y IN f)`) MP_TAC));
    GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `~({x | x extreme_point_of p} SUBSET f)`)));
      REWRITE_TAC[SUBSET;IN_ELIM_THM];
      BY(MESON_TAC[]);
    DISCH_TAC;
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `p SUBSET convex hull f`) ASSUME_TAC));
      FIRST_X_ASSUM_ST `convex` SUBST1_TAC;
      MATCH_MP_TAC Marchal_cells.CONVEX_HULL_SUBSET;
      BY(ASM_REWRITE_TAC[]);
    FIRST_X_ASSUM MP_TAC;
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`convex hull f = f`) SUBST1_TAC));
      REWRITE_TAC[ CONVEX_HULL_EQ ];
      BY(ASM_MESON_TAC[ FACET_OF_IMP_FACE_OF; FACE_OF_IMP_CONVEX; ]);
    FIRST_X_ASSUM_ST `DIFF` MP_TAC;
    BY(SET_TAC[]);
  REWRITE_TAC[ GSYM FACE_OF_SING ];
  REPEAT WEAK_STRIP_TAC;
  INTRO_TAC FACE_OF_POLYHEDRON [`p`;`{y}`];
  ASM_REWRITE_TAC[];
  ANTS_TAC;
    CONJ_TAC;
      BY(SET_TAC[]);
    INTRO_TAC AFF_DIM_SING [`y`];
    REPEAT WEAK_STRIP_TAC;
    SUBGOAL_THEN `~(&1 < (int_of_num 0))` ASSUME_TAC;
      BY(INT_ARITH_TAC);
    BY(ASM_MESON_TAC[]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!f. {y} SUBSET f <=>  y IN f`) (fun t -> REWRITE_TAC[t])));
    BY(SET_TAC[]);
  TYPED_ABBREV_TAC `(A = { c | c facet_of p /\ (y:real^A) IN c })`;
  DISCH_TAC;
  COMMENT "1";
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(A = {})`) MP_TAC));
    DISCH_TAC;
    FIRST_X_ASSUM_ST `INTERS` MP_TAC;
    ASM_REWRITE_TAC[];
    REWRITE_TAC[ INTERS_0 ];
    REPEAT WEAK_STRIP_TAC;
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `p SUBSET {y}`) MP_TAC));
      BY(ASM_REWRITE_TAC[SUBSET_UNIV]);
    DISCH_TAC;
    FIRST_X_ASSUM (MP_TAC o (MATCH_MP AFF_DIM_SUBSET));
    REWRITE_TAC[ AFF_DIM_SING ];
    FIRST_X_ASSUM_ST `aff_dim` MP_TAC;
    BY(INT_ARITH_TAC);
  REWRITE_TAC[Misc_defs_and_lemmas.EMPTY_EXISTS ];
  REPEAT WEAK_STRIP_TAC;
  COMMENT "1b";
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `u facet_of p`) ASSUME_TAC));
    FIRST_X_ASSUM MP_TAC;
    EXPAND_TAC "A";
    REWRITE_TAC[IN_ELIM_THM];
    BY(MESON_TAC[]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `&1 <= aff_dim u`) ASSUME_TAC));
    FIRST_X_ASSUM MP_TAC;
    REWRITE_TAC[facet_of];
    FIRST_X_ASSUM_ST `aff_dim` MP_TAC;
    BY(INT_ARITH_TAC);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `aff_dim {y } = &0`) ASSUME_TAC));
    BY(REWRITE_TAC[ AFF_DIM_SING ]);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~( A = {u})`) MP_TAC));
    DISCH_TAC;
    FIRST_X_ASSUM_ST `INTERS` MP_TAC;
    ASM_REWRITE_TAC[];
    REWRITE_TAC[ INTERS_1 ];
    DISCH_TAC;
    REPEAT (FIRST_X_ASSUM_ST `aff_dim` MP_TAC);
    ASM_REWRITE_TAC[];
    BY(INT_ARITH_TAC);
  DISCH_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?v. v IN A /\ ~(v = u)`) ASSUME_TAC));
    FIRST_X_ASSUM MP_TAC;
    FIRST_X_ASSUM_ST `IN` MP_TAC;
    GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `{u} SUBSET A /\ ~(A = {u}) ==> (?v. v IN A DIFF {u})`)));
      REWRITE_TAC[SUBSET;IN_DIFF;IN_SING];
      BY(MESON_TAC[]);
    BY(SET_TAC[]);
  FIRST_X_ASSUM MP_TAC;
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC CARD_AT_LEAST3;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `f`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `u`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `v`)));
  ASM_REWRITE_TAC[IN_ELIM_THM];
  REPLICATE_TAC 2 (FIRST_X_ASSUM_ST `IN` MP_TAC);
  EXPAND_TAC "A";
  REWRITE_TAC[IN_ELIM_THM];
  BY(ASM_MESON_TAC[])
  ]);;
  (* }}} *)

let facet_3_facets = 
prove_by_refinement(
  `!(p:real^3->bool) f. 
    polyhedron p  /\ bounded p /\ (vec 0 IN interior p) /\
    f facet_of p ==>
    FINITE {e | e facet_of f} /\ 3 <= CARD {e | e facet_of f}
    `,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC polyhedron_3_facets;
  SUBCONJ_TAC;
    MATCH_MP_TAC FACE_OF_POLYHEDRON_POLYHEDRON;
    BY(ASM_MESON_TAC[ FACET_OF_IMP_FACE_OF ]);
  DISCH_TAC;
  CONJ_TAC;
    MATCH_MP_TAC BOUNDED_SUBSET;
    BY(ASM_MESON_TAC[ FACET_OF_IMP_FACE_OF; FACE_OF_IMP_SUBSET]);
  FIRST_X_ASSUM_ST `facet_of` MP_TAC;
  REWRITE_TAC[facet_of];
  ASM_SIMP_TAC[ (ISPEC `(vec 0):real^3` Polyhedron.AFF_DIM_INTERIOR_EQ_3) ];
  BY(INT_ARITH_TAC)
  ]);;
  (* }}} *)

let YSSKQOY_VECTOR = 
prove_by_refinement(
  `!v (w:real^3) theta. v IN ball_annulus /\ w IN ball_annulus /\ ~(v = w) /\
    &2 <= dist(v,w) /\
    (\ v. acs(norm v/ &4) - pi/ &6) = theta ==> 
    theta v + theta w <= arcV (vec 0) v w`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  INTRO_TAC Ysskqoy.YSSKQOY [`norm v / &2`;`norm w / &2 `];
  ANTS_TAC;
    INTRO_TAC ckq_in_ball_annulus [`v`];
    INTRO_TAC ckq_in_ball_annulus [`w`];
    ASM_REWRITE_TAC[];
    BY(REAL_ARITH_TAC);
  EXPAND_TAC "theta";
  MATCH_MP_TAC (arith `x = x' /\ y <= y' ==> (x <= y ==> x' <= y')`);
  CONJ_TAC;
    REWRITE_TAC[arith `x/ &2 / &2 = x/ &4`];
    BY(REAL_ARITH_TAC);
  GMATCH_SIMP_TAC Trigonometry1.arcVarc;
  REWRITE_TAC[DIST_0; arith `&2 * x / &2 = x`];
  REPEAT (GMATCH_SIMP_TAC Trigonometry1.ACS_ARCLENGTH);
  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));
    INTRO_TAC ckq_in_ball_annulus [`v`];
    INTRO_TAC ckq_in_ball_annulus [`w`];
    ASM_REWRITE_TAC[];
    MP_TAC Sphere.h0;
    REPEAT WEAK_STRIP_TAC;
    ASM_REWRITE_TAC[];
    REPEAT (FIRST_X_ASSUM MP_TAC);
    BY(REAL_ARITH_TAC);
  REPEAT WEAK_STRIP_TAC;
  ASM_REWRITE_TAC[];
  COMMENT "1";
  SUBCONJ_TAC;
    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])));
      BY(REWRITE_TAC[DIST_0]);
    BY(REWRITE_TAC[DIST_TRIANGLE]);
  DISCH_TAC;
  MATCH_MP_TAC ACS_MONO_LE;
  ASM_SIMP_TAC[ Trigonometry1.TRI_SQUARES_BOUNDS ];
  GMATCH_SIMP_TAC REAL_LE_DIV2_EQ;
  CONJ_TAC;
    BY(ASM_MESON_TAC[ Real_ext.REAL_PROP_POS_MUL2 ; arith `&0 < &2`]);
  MATCH_MP_TAC (arith `(c' <= c) ==> (a + b - c <= a + b - c')`);
  GMATCH_SIMP_TAC Misc_defs_and_lemmas.ABS_SQUARE_LE;
  BY(ASM_REWRITE_TAC[arith `abs(&2) = &2`])
  ]);;
  (* }}} *)

let PACK_INEQ_DEF_A_797 = 
prove_by_refinement(
  `!v (v0:real^3).
    pack_ineq_def_a /\
    norm v0 = &2 /\
    &2 * h0 <= dist (v,v0) /\
    &2 <= norm v /\ norm v <= &2 * h0 ==>
    #0.797 + acs(norm v / &4) - pi / &6 < arclength  (norm v) (&2) (dist(v,v0))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[Ysskqoy.pack_ineq_def_a];
  REPEAT WEAK_STRIP_TAC;
  REPLICATE_TAC 4 (FIRST_X_ASSUM MP_TAC);
  FIRST_X_ASSUM_ST `#0.797` MP_TAC;
  REPEAT (FIRST_X_ASSUM kill);
  REWRITE_TAC[Sphere.ineq];
  REWRITE_TAC[Sphere.acs_sqrt_x1_d4];
  REWRITE_TAC[Sphere.arclength_x_123];
  REPEAT WEAK_STRIP_TAC;
  FIRST_X_ASSUM (fun t-> INTRO_TAC t [`(norm v) pow 2`;`(norm v0) pow 2`;`(&2 * h0) pow 2`;`&1`;`&1`;`&1`]);
  ASM_REWRITE_TAC[arith `!x. x <= x`;arith `&2 pow 2  = &4`];
  ANTS_TAC;
    MP_TAC (GSYM Sphere.h0);
    REWRITE_TAC[ GSYM REAL_LE_SQUARE_ABS; arith `&4 = &2 pow 2`];
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`sqrt(norm v pow 2) = norm v`) SUBST1_TAC));
    MATCH_MP_TAC POW_2_SQRT;
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`sqrt((&2 * h0) pow 2) = (&2 * h0)`) SUBST1_TAC));
    MATCH_MP_TAC POW_2_SQRT;
    MP_TAC Sphere.h0;
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  REWRITE_TAC[ Collect_geom2.SQRT4_EQ2 ];
  DISCH_TAC;
  MATCH_MP_TAC REAL_LTE_TRANS;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `arclength (norm v) (&2) (&2 * h0)`)));
  CONJ_TAC;
    BY(FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC);
  COMMENT "1";
  REPEAT (GMATCH_SIMP_TAC Trigonometry1.ACS_ARCLENGTH);
  ASSUME_TAC (GSYM Sphere.h0);
  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));
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`dist(v,v0) <= dist(v,(vec 0)) + dist ((vec 0),v0)`) MP_TAC));
    BY(REWRITE_TAC[DIST_TRIANGLE]);
  ASM_REWRITE_TAC[DIST_0];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  MATCH_MP_TAC ACS_MONO_LE;
  ASM_SIMP_TAC[ Trigonometry1.TRI_SQUARES_BOUNDS ];
  GMATCH_SIMP_TAC REAL_LE_DIV2_EQ;
  CONJ_TAC;
    BY(BY(ASM_MESON_TAC[ Real_ext.REAL_PROP_POS_MUL2 ; arith `&0 < &2`]));
  MATCH_MP_TAC (arith `(c' <= c) ==> (a + b - c <= a + b - c')`);
  GMATCH_SIMP_TAC Misc_defs_and_lemmas.ABS_SQUARE_LE;
  BY(BY(ASM_SIMP_TAC[arith `(#1.26 = h0) ==> abs(&2 * h0) = &2 * h0`]))
  ]);;
  (* }}} *)

let YSSKQOY_VECTOR2 = 
prove_by_refinement(
  `!v0 (w:real^3). v0 IN ball_annulus /\ w IN ball_annulus /\ ~(w = v0) /\
    &2 * h0 <= dist(w,v0) /\
    pack_ineq_def_a /\
    norm v0 = &2 ==>
    #0.797 + acs(norm w/ &4) - pi/ &6 <= arcV (vec 0) v0 w`,

  (* {{{ proof *)
  [
 REPEAT WEAK_STRIP_TAC;
  REWRITE_TAC[];
  GMATCH_SIMP_TAC Trigonometry1.arcVarc;
  REWRITE_TAC[DIST_0];
  ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC[ Arc_properties.arc_sym];
  REPEAT (FIRST_X_ASSUM_ST `ball_annulus` MP_TAC);
  REWRITE_TAC[ ckq_in_ball_annulus];
  REPEAT WEAK_STRIP_TAC;
  ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC[DIST_SYM];
  MATCH_MP_TAC (arith `x < y ==> (x <= y)`);
  MATCH_MP_TAC PACK_INEQ_DEF_A_797;
  BY(ASM_REWRITE_TAC[])
  ]);;
  (* }}} *)

let YSSKQOY_VECTOR2_ALT = 
prove_by_refinement(
  `!V v w (v0:real^3) theta. 
    V SUBSET ball_annulus /\
    packing V /\
    (v IN V) /\ (w IN V) /\ (v0 IN V) /\
    ~(v = w) /\
    (!w. w IN V /\ ~(w = v0) ==> &2 * h0 <= dist (w,v0)) /\
    pack_ineq_def_a /\
    norm v0 = &2 /\
    (\ v. (if (v = v0) then #0.797 else acs(norm v/ &4) - pi/ &6)) = theta ==> 
    theta v + theta w <= arcV (vec 0) v w`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  EXPAND_TAC "theta";
  REPEAT (COND_CASES_TAC);
        BY(ASM_MESON_TAC[]);
      MATCH_MP_TAC YSSKQOY_VECTOR2;
      BY(ASM_MESON_TAC[ SUBSET]);
    ONCE_REWRITE_TAC[arith `a + b = b + a`];
    ASM_REWRITE_TAC[];
    ONCE_REWRITE_TAC[ Trigonometry2.ARC_SYM ];
    MATCH_MP_TAC YSSKQOY_VECTOR2;
    BY(ASM_MESON_TAC[ SUBSET ]);
  INTRO_TAC YSSKQOY_VECTOR [`v`;`w`;`(\v. acs (norm (v:real^3) / &4) - pi / &6)`];
  ASM_REWRITE_TAC[];
  DISCH_THEN MATCH_MP_TAC;
  FIRST_X_ASSUM_ST `packing` MP_TAC;
  REWRITE_TAC[Sphere.packing];
  BY(ASM_MESON_TAC[IN;SUBSET])
  ]);;
  (* }}} *)

let ACS_ROOT32 = 
prove_by_refinement(
  `acs (sqrt(&3) / &2) = pi / &6`,

  (* {{{ proof *)
  [
  REWRITE_TAC[GSYM COS_PI6];
  MATCH_MP_TAC ACS_COS;
  MP_TAC PI_POS;
  BY(REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let ASN_HALF = 
prove_by_refinement(
  `asn (&1 / &2) = pi/ &6`,

  (* {{{ proof *)
  [
  REWRITE_TAC[GSYM SIN_PI6];
  MATCH_MP_TAC ASN_SIN;
  MP_TAC PI_POS;
  BY(REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let THETA_BOUNDS = 
prove_by_refinement(
  `!v theta. (v IN ball_annulus) /\ (\v. acs(norm v / &4) - pi/ &6) = theta
    ==> ( &0 < theta v /\ theta v < pi / &2)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  EXPAND_TAC "theta";
  REWRITE_TAC[arith `x - y < u <=> -- y < u -x `;arith `&0 < x - y <=> y < x`];
  SUBGOAL_THEN `!x y. y <= x ==> -- (pi/ &6) < x - y` GMATCH_SIMP_TAC;
    REPEAT GEN_TAC;
    MP_TAC PI_POS;
    BY(REAL_ARITH_TAC);
  REWRITE_TAC[ GSYM ACS_0 ];
  REWRITE_TAC[ GSYM ACS_ROOT32];
  GMATCH_SIMP_TAC ACS_MONO_LT;
  GMATCH_SIMP_TAC ACS_MONO_LE;
  FIRST_X_ASSUM_ST `IN` MP_TAC;
  REWRITE_TAC[ ckq_in_ball_annulus ];
  MP_TAC Sphere.h0;
  MP_TAC Flyspeck_constants.bounds;
  REWRITE_TAC[Sphere.sqrt3];
  BY(REAL_ARITH_TAC)
  ]);;
  (* }}} *)

let INJ_FINITE_EXISTS = 
prove_by_refinement(
  `!n (A:A->bool) (B:B->bool).
    A HAS_SIZE n /\ FINITE B /\ n <= CARD B  ==>
    (?j. INJ j A B)
    `,

  (* {{{ proof *)
  [
  INDUCT_TAC;
    REWRITE_TAC[HAS_SIZE];
    REPEAT WEAK_STRIP_TAC;
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `A = {}`) (fun t -> REWRITE_TAC[t])));
      BY(ASM_MESON_TAC[ CARD_EQ_0; SUBSET_EMPTY]);
    BY(REWRITE_TAC[INJ;NOT_IN_EMPTY]);
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(A = {}) /\ ~(B = {})`) (fun t -> ASSUME_TAC t THEN MP_TAC t)));
    REWRITE_TAC[ GSYM HAS_SIZE_0];
    REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC);
    REWRITE_TAC[HAS_SIZE];
    BY(MESON_TAC[ arith `~(0 = SUC n) /\ ~(SUC n <= 0)`]);
  REWRITE_TAC[ Misc_defs_and_lemmas.EMPTY_EXISTS ];
  REPEAT WEAK_STRIP_TAC;
  FIRST_X_ASSUM (C INTRO_TAC[`A DELETE u`;`B DELETE u'`]);
  ANTS_TAC;
    ASM_REWRITE_TAC[ FINITE_DELETE ];
    CONJ_TAC;
      FIRST_X_ASSUM_ST `HAS_SIZE` MP_TAC;
      REWRITE_TAC[ HAS_SIZE_SUC ];
      BY(ASM_MESON_TAC[]);
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?m. (n <= m) /\  B HAS_SIZE (SUC m)`) MP_TAC));
      ASM_REWRITE_TAC[HAS_SIZE];
      GOAL_TERM (fun w -> (EXISTS_TAC ( env w `PRE (CARD B)`)));
      FIRST_X_ASSUM_ST `SUC` MP_TAC;
      BY(ARITH_TAC);
    REPEAT WEAK_STRIP_TAC;
    FIRST_X_ASSUM MP_TAC;
    REWRITE_TAC[ HAS_SIZE_SUC ];
    BY(ASM_MESON_TAC[HAS_SIZE]);
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `\ a. if (a = u) then u' else j a`)));
  REWRITE_TAC[INJ];
  SUBCONJ_TAC;
    REPEAT WEAK_STRIP_TAC;
    COND_CASES_TAC;
      BY(ASM_REWRITE_TAC[]);
    FIRST_X_ASSUM_ST `INJ` MP_TAC;
    REWRITE_TAC[INJ;IN_DELETE];
    BY(ASM_MESON_TAC[]);
  DISCH_TAC;
  REPEAT GEN_TAC;
  FIRST_X_ASSUM_ST `INJ` MP_TAC;
  REWRITE_TAC[INJ;IN_DELETE];
  BY(REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN TRY (ASM_MESON_TAC[]))
  ]);;
  (* }}} *)

let INJ_EXTENSION = 
prove_by_refinement(
  `!(A:A->bool) (B:B->bool) A' j'.
    INJ j' A' B /\ A' SUBSET A /\ FINITE A /\ FINITE B /\ CARD A <= CARD B ==>
     (?j. INJ j A B /\ (!a. a IN A' ==> j a = j' a))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?k. INJ k (A DIFF A') (B DIFF (IMAGE j' A'))`) MP_TAC));
    MATCH_MP_TAC INJ_FINITE_EXISTS;
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `CARD (A DIFF A')`)));
    SUBCONJ_TAC;
      BY(ASM_MESON_TAC[HAS_SIZE;FINITE_DIFF]);
    DISCH_TAC;
    CONJ_TAC;
      BY(ASM_MESON_TAC[FINITE_DIFF]);
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `IMAGE j' A' SUBSET B`) MP_TAC));
      FIRST_X_ASSUM_ST `INJ` MP_TAC;
      REWRITE_TAC[INJ;SUBSET;IN_IMAGE];
      BY(MESON_TAC[]);
    DISCH_TAC;
    ASM_SIMP_TAC[ CARD_DIFF ];
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `CARD (IMAGE j' A') <= CARD (A')`) MP_TAC));
      MATCH_MP_TAC CARD_IMAGE_LE;
      BY(ASM_MESON_TAC[FINITE_SUBSET]);
    FIRST_X_ASSUM_ST `(<=):(num->num->bool)` MP_TAC;
    BY(ARITH_TAC);
  REPEAT WEAK_STRIP_TAC;
  REPEAT (FIRST_X_ASSUM MP_TAC);
  REWRITE_TAC[SUBSET;INJ;IN_DIFF;IN_IMAGE];
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `\v. if (v IN A') then j' v else k v`)));
  BY(REPEAT (COND_CASES_TAC) THEN TRY (ASM_MESON_TAC[]))
  ]);;
  (* }}} *)

let BIJ_EXTENDS_INJ = 
prove_by_refinement(
  `! (A:A->bool) (B:B->bool) A' j'.
     FINITE A /\ FINITE B /\ A' SUBSET A /\ (INJ j' A' B) /\
    (CARD A = CARD B)  ==> 
    (?j. BIJ j A B /\ (!a. a IN A' ==> j' a = j a))`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  INTRO_TAC INJ_EXTENSION [`A`;`B`;`A'`;`j'`];
  ASM_REWRITE_TAC[];
  ANTS_TAC;
    FIRST_X_ASSUM MP_TAC;
    BY(ARITH_TAC);
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `j`)));
  ASM_REWRITE_TAC[BIJ];
  BY(ASM_MESON_TAC[Ysskqoy.INJ_IFF_SURJ])
  ]);;
  (* }}} *)

let DLWCHEM_VECTOR_sum = 
prove_by_refinement(
  `!k (V:real^3->bool) n theta. pack_ineq_def_a /\
    (\v. acs (norm v / &4) - pi / &6) = theta /\
    (!v. v IN V ==> (3 <= k v)) /\
    (12 < n) /\ 
    (V HAS_SIZE n) /\
    (V SUBSET ball_annulus) /\
    (sum V (\v. &(k v)) <= (&6 * &n - &12)) /\
    (sum V (\v. max (&0) (regular_spherical_polygon_area (cos(theta v)) (&(k v)))) <= &4 * pi) /\ 
    ~(lmfun_ineq_center V)
 ==> (n < 16)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC DLWCHEM_sum;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?b. BIJ b (0..(n-1)) V`) MP_TAC));
    INTRO_TAC BIJ_EXTENDS_INJ [`(0..(n-1))`;`V`;`{}:num->bool`];
    REWRITE_TAC[EMPTY_SUBSET;INJ;NOT_IN_EMPTY];
    DISCH_THEN MATCH_MP_TAC;
    INTRO_TAC HAS_SIZE_NUMSEG [`0`;`n-1`];
    FIRST_X_ASSUM_ST `HAS_SIZE` MP_TAC;
    REWRITE_TAC[HAS_SIZE];
    FIRST_X_ASSUM_ST `12 < n` MP_TAC;
    BY(MESON_TAC[arith `12 < n ==> (n - 1 + 1) - 0 =  n`]);
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `(\v. (norm v) / &2) o b`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `k o b`)));
  ASM_REWRITE_TAC[];
  SUBCONJ_TAC;
    REPEAT WEAK_STRIP_TAC;
    REWRITE_TAC[o_DEF];
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `b i IN V`) ASSUME_TAC));
      FIRST_X_ASSUM_ST `BIJ` MP_TAC;
      REWRITE_TAC[BIJ;INJ;IN_NUMSEG];
      BY(ASM_MESON_TAC[arith `i < n ==> 0 <= i /\ i <= n-1`]);
    ASM_SIMP_TAC[];
    FIRST_X_ASSUM_ST `ball_annulus` MP_TAC;
    REWRITE_TAC[ckq_in_ball_annulus; SUBSET];
    DISCH_THEN (C INTRO_TAC[`b i`]);
    ASM_REWRITE_TAC[];
    MP_TAC Sphere.h0;
    BY(REAL_ARITH_TAC);
  DISCH_TAC;
  COMMENT "1";
  CONJ_TAC;
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(\i. &((k o b) i)) = (\v. &(k v)) o b`) SUBST1_TAC));
      BY(REWRITE_TAC[FUN_EQ_THM;o_DEF]);
    GMATCH_SIMP_TAC BIJ_SUM;
    BY(ASM_MESON_TAC[]);
  CONJ_TAC;
    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))`];
    DISCH_THEN GMATCH_SIMP_TAC;
    CONJ_TAC;
      GEN_TAC;
      REWRITE_TAC[FUN_EQ_THM;o_DEF;IN_NUMSEG];
      REPEAT WEAK_STRIP_TAC;
      REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
      GMATCH_SIMP_TAC COSG;
      GOAL_TERM (fun w -> (EXISTS_TAC ( env w `norm (b x) / &2`)));
      EXPAND_TAC "theta";
      REWRITE_TAC[arith `x / &2 / &2 = x / &4`;arith `#4.0 = &4`;Sphere.sqrt3];
      FIRST_X_ASSUM (MP_TAC o (ISPEC `x:num`));
      ANTS_TAC;
        REPEAT (FIRST_X_ASSUM MP_TAC);
        BY(ARITH_TAC);
      REWRITE_TAC[o_DEF];
      MP_TAC Sphere.h0;
      BY(REAL_ARITH_TAC);
    GMATCH_SIMP_TAC BIJ_SUM;
    BY(ASM_MESON_TAC[]);
  FIRST_X_ASSUM_ST `lmfun_ineq_center` MP_TAC;
  REWRITE_TAC[ Pack_defs.lmfun_ineq_center ; arith `~(x <= &12) <=> (&12 < x)`];
  INTRO_TAC SUM_EQ [`(\i. lfun (((\v. norm v / &2) o b) i))`;`(\v. lmfun (hl [vec 0; v])) o b`;`(0..(n-1))`];
  DISCH_THEN GMATCH_SIMP_TAC;
  CONJ_TAC;
    REWRITE_TAC[FUN_EQ_THM;IN_NUMSEG;o_DEF];
    REPEAT WEAK_STRIP_TAC;
    REWRITE_TAC[ Marchal_cells_3.HL_2 ; DIST_0; arith `inv (&2) *x = x/ &2`];
    GMATCH_SIMP_TAC Nonlinear_lemma.lmfun_lfun;
    FIRST_X_ASSUM (MP_TAC o (ISPEC `x:num`));
    ANTS_TAC;
      REPEAT (FIRST_X_ASSUM MP_TAC);
      BY(ARITH_TAC);
    REWRITE_TAC[o_DEF];
    MP_TAC Sphere.h0;
    BY(REAL_ARITH_TAC);
  GMATCH_SIMP_TAC BIJ_SUM;
  BY(ASM_MESON_TAC[])
  ]);;
  (* }}} *)

let XULJEPR_VECTOR_sum = 
prove_by_refinement(
  `!k V n theta v0. ( pack_ineq_def_a /\
    (v0 IN V) /\
    (\v. (if (v = v0) then (#0.797) else acs (norm v / &4) - pi / &6)) = theta /\
    (12 < n) /\ 
    (norm v0 = &2) /\
    (!v. (v IN V ==> 3 <= k v)) /\
    V HAS_SIZE n /\
    V SUBSET ball_annulus /\
    sum V (\v. &(k v)) <= &6 * &n - &12 /\
    sum V (\v. max (&0)  (regular_spherical_polygon_area (cos (theta v)) (&(k v)))) <=  &4 * pi /\
    ~lmfun_ineq_center V ==> F)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC XULJEPR_sum;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `?b. BIJ b (0..(n-1)) V /\ b 0 = v0`) MP_TAC));
    INTRO_TAC BIJ_EXTENDS_INJ [`(0..(n-1))`;`V`;`{0}`;`\ (i:num). v0`];
    REWRITE_TAC[IN_SING];
    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])));
      BY(MESON_TAC[]);
    DISCH_THEN MATCH_MP_TAC;
    INTRO_TAC HAS_SIZE_NUMSEG [`0`;`n-1`];
    FIRST_X_ASSUM_ST `HAS_SIZE` MP_TAC;
    REWRITE_TAC[HAS_SIZE];
    FIRST_X_ASSUM_ST `12 < n` MP_TAC;
    REWRITE_TAC[INJ;SUBSET;IN_SING;IN_NUMSEG];
    BY(BY(ASM_MESON_TAC[arith `12 < n ==> (n - 1 + 1) - 0 =  n`;arith `0 <= 0 /\ (12 < n==> 0 <= n-1)`]));
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `(\v. (norm v) / &2) o b`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `k o b`)));
  EXISTS_TAC `n:num`;
  ASM_REWRITE_TAC[];
  COMMENT "1";
  CONJ_TAC;
    ASM_REWRITE_TAC[o_DEF];
    BY(REAL_ARITH_TAC);
  SUBCONJ_TAC;
    REPEAT WEAK_STRIP_TAC;
    REWRITE_TAC[o_DEF];
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `b i IN V`) ASSUME_TAC));
      FIRST_X_ASSUM_ST `BIJ` MP_TAC;
      REWRITE_TAC[BIJ;INJ;IN_NUMSEG];
      BY(BY(ASM_MESON_TAC[arith `i < n ==> 0 <= i /\ i <= n-1`]));
    ASM_SIMP_TAC[];
    FIRST_X_ASSUM_ST `ball_annulus` MP_TAC;
    REWRITE_TAC[ckq_in_ball_annulus; SUBSET];
    DISCH_THEN (C INTRO_TAC[`b i`]);
    ASM_REWRITE_TAC[];
    MP_TAC Sphere.h0;
    BY(BY(REAL_ARITH_TAC));
  DISCH_TAC;
  COMMENT "1a 6n-12";
  CONJ_TAC;
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(\i. &((k o b) i)) = (\v. &(k v)) o b`) SUBST1_TAC));
      BY(BY(REWRITE_TAC[FUN_EQ_THM;o_DEF]));
    GMATCH_SIMP_TAC BIJ_SUM;
    BY(BY(ASM_MESON_TAC[]));
  CONJ2_TAC;
    FIRST_X_ASSUM_ST `lmfun_ineq_center` MP_TAC;
    REWRITE_TAC[ Pack_defs.lmfun_ineq_center ; arith `~(x <= &12) <=> (&12 < x)`];
    INTRO_TAC SUM_EQ [`(\i. lfun (((\v. norm v / &2) o b) i))`;`(\v. lmfun (hl [vec 0; v])) o b`;`(0..(n-1))`];
    DISCH_THEN GMATCH_SIMP_TAC;
    CONJ_TAC;
      REWRITE_TAC[FUN_EQ_THM;IN_NUMSEG;o_DEF];
      REPEAT WEAK_STRIP_TAC;
      REWRITE_TAC[ Marchal_cells_3.HL_2 ; DIST_0; arith `inv (&2) *x = x/ &2`];
      GMATCH_SIMP_TAC Nonlinear_lemma.lmfun_lfun;
      FIRST_X_ASSUM (MP_TAC o (ISPEC `x:num`));
      ANTS_TAC;
        REPEAT (FIRST_X_ASSUM MP_TAC);
        BY(BY(ARITH_TAC));
      REWRITE_TAC[o_DEF];
      MP_TAC Sphere.h0;
      BY(BY(REAL_ARITH_TAC));
    GMATCH_SIMP_TAC BIJ_SUM;
    BY(BY(ASM_MESON_TAC[]));
  COMMENT "1b last conjunct";
  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));
    INTRO_TAC (GSYM SUM_COMBINE_R) [` ((\v. max (&0) (regular_spherical_polygon_area (cos (theta v)) (&(k v)))) o  b)`;`0`;`0`;`n - 1`];
    ANTS_TAC;
      BY(ARITH_TAC);
    DISCH_THEN SUBST1_TAC;
    REWRITE_TAC[arith `0+1 = 1`;SUM_SING_NUMSEG];
    MATCH_MP_TAC (arith `a = a' /\ b = b' ==> (a + b = a'+b')`);
    CONJ_TAC;
      REWRITE_TAC[o_DEF];
      ASM_REWRITE_TAC[];
      REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
      EXPAND_TAC "theta";
      BY(REWRITE_TAC[]);
    MATCH_MP_TAC SUM_EQ;
    GEN_TAC;
    REWRITE_TAC[FUN_EQ_THM;o_DEF;IN_NUMSEG];
    REPEAT WEAK_STRIP_TAC;
    REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
    GMATCH_SIMP_TAC COSG;
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `norm (b x) / &2`)));
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `theta (b x) = acs(norm (b x) / &4) - pi / &6`) SUBST1_TAC));
      EXPAND_TAC "theta";
      COND_CASES_TAC;
        SUBGOAL_THEN `x = 0` MP_TAC;
          FIRST_X_ASSUM_ST `BIJ` MP_TAC;
          REWRITE_TAC[BIJ;INJ;IN_NUMSEG];
          BY(ASM_MESON_TAC[arith `0 <= 0 /\ (12 < n ==> 0 <= n-1) /\ (1 <= x ==> 0 <= x)`]);
        REPLICATE_TAC 2 (FIRST_X_ASSUM_ST `1` MP_TAC);
        BY(ARITH_TAC);
      BY(REWRITE_TAC[]);
    REWRITE_TAC[arith `x / &2 / &2 = x / &4`;arith `#4.0 = &4`;Sphere.sqrt3];
    FIRST_X_ASSUM (MP_TAC o (ISPEC `x:num`));
    ANTS_TAC;
      REPEAT (FIRST_X_ASSUM MP_TAC);
      BY(BY(ARITH_TAC));
    REWRITE_TAC[o_DEF];
    MP_TAC Sphere.h0;
    BY(BY(REAL_ARITH_TAC));
  GMATCH_SIMP_TAC BIJ_SUM;
  BY(BY(ASM_MESON_TAC[]))
  ]);;
  (* }}} *)

let SOL_NN = 
prove_by_refinement(
  `!x U. (?r. &0 < r /\ measurable (U INTER normball x r) /\
      radial_norm r x (U INTER normball x r)) ==> &0 <= sol x U`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  GMATCH_SIMP_TAC Vol1.sol;
  EXISTS_TAC `r:real`;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
    BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
  MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2;
  CONJ_TAC;
    BY(BY(REAL_ARITH_TAC));
  MATCH_MP_TAC REAL_LE_DIV;
  CONJ_TAC;
    MATCH_MP_TAC MEASURE_POS_LE;
    BY(BY(ASM_MESON_TAC[]));
  MATCH_MP_TAC REAL_POW_LE;
  BY(BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC))
  ]);;
  (* }}} *)

let FACET_SOL_NN = 
prove_by_refinement(
  `!p c. polyhedron p /\ bounded p /\ (vec 0) IN interior p /\
    c facet_of p ==>
    &0 <= sol (vec 0) (fchanged c)`,

  (* {{{ proof *)
  [
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC SOL_NN;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `&1`)));
  ASM_SIMP_TAC[FCHANGED_RADIAL;FCHANGED_MEASURABLE];
  BY(ASM_MESON_TAC[Marchal_cells_2_new.RADIAL_VS_RADIAL_NORM;FCHANGED_RADIAL;FCHANGED_MEASURABLE;arith `&0 < &1`])
  ]);;
  (* }}} *)

let DLWCHEM = 
prove_by_refinement(
`!V. packing V /\ pack_ineq_def_a /\
  V SUBSET ball_annulus /\ ~(lmfun_ineq_center V) ==>
   (CARD V = 13 \/ CARD V = 14 \/ CARD V = 15)`,

  (* {{{ proof *)
  [
  X_GENv_TAC "W";
  REPEAT WEAK_STRIP_TAC;
  INTRO_TAC LMFUN_INEQ_CENTER_IMP_13 [`W`];
  ASM_SIMP_TAC[fat_lemma1];
  GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `CARD W < 16`)));
    BY((ARITH_TAC));
  INTRO_TAC SATURATE_BALL_ANNULUS [`W`;`{}:real^3->bool`;`&2`];
  ASM_REWRITE_TAC[arith `&2 <= &2`;EMPTY_SUBSET];
  ANTS_TAC;
    CONJ_TAC;
      MP_TAC Sphere.h0;
      BY((REAL_ARITH_TAC));
    BY((REWRITE_TAC[X_IN NOT_IN_EMPTY]));
  REWRITE_TAC[X_IN NOT_IN_EMPTY];
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `CARD V < 16`)));
    MATCH_MP_TAC (arith `y <= x ==> x < z ==> y < (z:num)`);
    MATCH_MP_TAC CARD_SUBSET;
    BY((ASM_REWRITE_TAC[]));
  FIRST_X_ASSUM_ST `SUBSET` kill;
  REPLICATE_TAC 6 (FIRST_X_ASSUM MP_TAC);
  FIRST_X_ASSUM_ST `pack_ineq_def_a` MP_TAC;
  REPEAT (FIRST_X_ASSUM kill);
  REPEAT WEAK_STRIP_TAC;
  COMMENT "1 saturated";
  TYPED_ABBREV_TAC (`n = CARD (V:real^3 ->bool)`);
  TYPED_ABBREV_TAC (`theta = \ (v:real^3). acs(norm v / &4) - pi / &6`);
  INTRO_TAC EXISTS_M_POLYHEDRON [`V`;`theta`;`&2`;`n`];
  ASM_REWRITE_TAC[];
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `V HAS_SIZE n`) ASSUME_TAC));
    BY((ASM_MESON_TAC[HAS_SIZE]));
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(V = {})`) ASSUME_TAC));
    BY((ASM_MESON_TAC[CARD_CLAUSES;arith `~(13 <= 0)`]));
  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));
    REPEAT WEAK_STRIP_TAC;
    MATCH_MP_TAC YSSKQOY_VECTOR;
    ASM_REWRITE_TAC[];
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `&2 <= dist(v,w)`) (fun t -> REWRITE_TAC[t])));
      FIRST_X_ASSUM_ST `packing` MP_TAC;
      REWRITE_TAC[Sphere.packing];
      DISCH_THEN MATCH_MP_TAC;
      BY((ASM_MESON_TAC[IN]));
    BY((ASM_MESON_TAC[SUBSET]));
  ASM_REWRITE_TAC[];
  (COMMENT "1a");
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w ` (!v. v IN V ==> &0 < theta v /\ theta v < pi / &2)`) ASSUME_TAC));
    REPEAT WEAK_STRIP_TAC;
    MATCH_MP_TAC THETA_BOUNDS;
    ASM_REWRITE_TAC[];
    BY(ASM_MESON_TAC[SUBSET]);
  ASM_REWRITE_TAC[];
  ANTS_TAC;
    MP_TAC Sphere.h0;
    BY(REAL_ARITH_TAC);
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC DLWCHEM_VECTOR_sum;
  TYPED_ABBREV_TAC `k = \ (v:real^3). CARD { (e:real^3->bool) | e facet_of (f v) }`;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `k`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `V`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `theta`)));
  ASM_REWRITE_TAC[];
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!v. v IN V ==> f v facet_of P`) ASSUME_TAC));
    FIRST_X_ASSUM_ST `BIJ` MP_TAC;
    REWRITE_TAC[BIJ;INJ;IN_ELIM_THM];
    BY(MESON_TAC[]);
  SUBCONJ_TAC;
    EXPAND_TAC "k";
    BY(ASM_MESON_TAC[facet_3_facets]);
  DISCH_TAC;
  CONJ_TAC;
    FIRST_X_ASSUM_ST `13` MP_TAC;
    BY(ARITH_TAC);
  CONJ_TAC;
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(\v. &(k v)) = (\ c. &(CARD {e | e facet_of c })) o f`) SUBST1_TAC));
      EXPAND_TAC "k";
      BY(REWRITE_TAC[FUN_EQ_THM;o_DEF]);
    GMATCH_SIMP_TAC BIJ_SUM;
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `{ c | c facet_of P }`)));
    ASM_REWRITE_TAC[];
    MATCH_MP_TAC polyhedron_edge_sum;
    ASM_SIMP_TAC[arith `13 <= n ==> 2 <= n`];
    REWRITE_TAC[HAS_SIZE];
    BY(ASM_MESON_TAC[ Misc_defs_and_lemmas.BIJ_CARD; Misc_defs_and_lemmas.FINITE_BIJ]);
  COMMENT "last conjunct: 4 pi";
  ASM_SIMP_TAC[GSYM POLYHEDRON_FACET_SUM_4Pi];
  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));
    GMATCH_SIMP_TAC BIJ_SUM;
    BY(ASM_MESON_TAC[]);
  MATCH_MP_TAC SUM_LE;
  ASM_REWRITE_TAC[];
  X_GENv_TAC "v";
  DISCH_TAC;
  REWRITE_TAC[o_DEF];
  MATCH_MP_TAC (arith `a <= x /\ b <= x==>    (max a b <= x)`);
  SUBCONJ_TAC;
    MATCH_MP_TAC FACET_SOL_NN;
    BY(ASM_MESON_TAC[]);
  DISCH_TAC;
  REWRITE_TAC[ Sphere.regular_spherical_polygon_area ];
  MATCH_MP_TAC GOTCJAH;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `f v`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `v`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `b v`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `P`)));
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{u | u facet_of f v} HAS_SIZE k v`) (fun t -> REWRITE_TAC[t])));
    EXPAND_TAC "k";
    REWRITE_TAC[HAS_SIZE];
    MATCH_MP_TAC FACET_FINITE;
    BY(ASM_MESON_TAC[]);
  ASM_SIMP_TAC[];
  AP_TERM_TAC;
  REWRITE_TAC[FUN_EQ_THM;IN_ELIM_THM];
  GEN_TAC;
  REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
  BY(MESON_TAC[DOT_SYM]) 
  ]);;
  (* }}} *)

let XULJEPR_concl = `!V. packing V /\ V SUBSET ball_annulus /\ pack_ineq_def_a /\
 (?v.  v IN V /\ norm (v) = &2 /\ (!u.  (u IN V) /\ ~(u = v) ==> &2 * h0 <= dist(u,v) ))
==> (lmfun_ineq_center V)`;;

let XULJEPR = 
prove_by_refinement(
`!V. packing V /\ V SUBSET ball_annulus /\ pack_ineq_def_a /\
 (?v.  v IN V /\ norm (v) = &2 /\ (!u.  (u IN V) /\ ~(u = v) ==> &2 * h0 <= dist(u,v) ))
==> (lmfun_ineq_center V)`,

  (* {{{ proof *)
  [
  X_GENv_TAC "W";
  REPEAT WEAK_STRIP_TAC;
  PROOF_BY_CONTR_TAC;
  INTRO_TAC LMFUN_INEQ_CENTER_IMP_13 [`W`];
  ASM_SIMP_TAC[fat_lemma1];
  DISCH_TAC;
  INTRO_TAC SATURATE_BALL_ANNULUS [`W`;`{v}`;`&2 * h0`];
  ANTS_TAC;
    ASM_REWRITE_TAC[arith `&2 * h0 <= &2 * h0`];
    CONJ_TAC;
      ASM_REWRITE_TAC[IN_SING;SUBSET];
      BY(ASM_MESON_TAC[]);
    CONJ_TAC;
      MP_TAC Sphere.h0;
      BY(((REAL_ARITH_TAC)));
    REWRITE_TAC[X_IN IN_SING];
    REPEAT WEAK_STRIP_TAC;
    BY(ASM_MESON_TAC[IN;arith `x <= y ==> ~(y < x)`;DIST_SYM]);
  REPEAT WEAK_STRIP_TAC;
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `v IN V`) MP_TAC));
    BY(ASM_MESON_TAC[SUBSET]);
  REPLICATE_TAC 8 (FIRST_X_ASSUM MP_TAC);
  REWRITE_TAC[X_IN IN_SING];
  FIRST_X_ASSUM_ST `norm` MP_TAC;
  FIRST_X_ASSUM_ST `pack_ineq_def_a` MP_TAC;
  REPEAT (FIRST_X_ASSUM kill);
  REPEAT WEAK_STRIP_TAC;
  COMMENT "1 saturated";
  TYPED_ABBREV_TAC (`n = CARD (V:real^3 ->bool)`);
  RENAME_FREE_VAR (`v:real^3`,"v0");
  TYPED_ABBREV_TAC (`theta = \ (v:real^3). if (v = v0) then (#0.797) else acs(norm v / &4) - pi / &6`);
  INTRO_TAC EXISTS_M_POLYHEDRON [`V`;`theta`;`&2 * h0`;`n`];
  ASM_REWRITE_TAC[];
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `V HAS_SIZE n`) ASSUME_TAC));
    BY(((ASM_MESON_TAC[HAS_SIZE])));
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `~(V = {})`) ASSUME_TAC));
    BY(((ASM_MESON_TAC[CARD_CLAUSES;arith `~(13 <= 0)`])));
  COMMENT "1 still on M polyhedron ";
  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));
    REPEAT WEAK_STRIP_TAC;
    MATCH_MP_TAC YSSKQOY_VECTOR2_ALT;
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `V`)));
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `v0`)));
    ASM_REWRITE_TAC[];
    REWRITE_TAC[IN];
    BY(ASM_MESON_TAC[IN;DIST_SYM;arith `~(x < y) ==> (y <= x)`]);
  ASM_REWRITE_TAC[];
  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])));
    REPEAT WEAK_STRIP_TAC;
    FIRST_X_ASSUM_ST `packing` MP_TAC;
    REWRITE_TAC[Sphere.packing];
    DISCH_THEN MATCH_MP_TAC;
    BY(((ASM_MESON_TAC[IN])));
  (COMMENT "1a");
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w ` (!v. v IN V ==> &0 < theta v /\ theta v < pi / &2)`) ASSUME_TAC));
    REPEAT WEAK_STRIP_TAC;
    GOAL_TERM (fun w -> (ASM_CASES_TAC ( env w `v = v0`)));
      EXPAND_TAC "theta";
      ASM_REWRITE_TAC[];
      MP_TAC Flyspeck_constants.bounds;
      BY(REAL_ARITH_TAC);
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `theta v = (\ v . acs (norm v / &4) - pi / &6 ) v`) SUBST1_TAC));
      EXPAND_TAC "theta";
      BY(ASM_REWRITE_TAC[]);
    MATCH_MP_TAC THETA_BOUNDS;
    ASM_REWRITE_TAC[];
    BY((ASM_MESON_TAC[SUBSET]));
  ASM_REWRITE_TAC[];
  SUBGOAL_THEN `&2 <= &2 * h0 /\ &2 * h0 <= &2 * h0` (fun t -> REWRITE_TAC[t]);
    MP_TAC Sphere.h0;
    BY((REAL_ARITH_TAC));
  MATCH_MP_TAC (TAUT `( p ==> F) ==> ~p`);
  REPEAT WEAK_STRIP_TAC;
  MATCH_MP_TAC XULJEPR_VECTOR_sum;
  TYPED_ABBREV_TAC `k = \ (v:real^3). CARD { (e:real^3->bool) | e facet_of (f v) }`;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `k`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `V`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `n`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `theta`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `v0`)));
  ASM_REWRITE_TAC[];
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!v. v IN V ==> f v facet_of P`) ASSUME_TAC));
    FIRST_X_ASSUM_ST `BIJ` MP_TAC;
    REWRITE_TAC[BIJ;INJ;IN_ELIM_THM];
    BY((MESON_TAC[]));
  CONJ_TAC;
    FIRST_X_ASSUM_ST `13` MP_TAC;
    BY(ARITH_TAC);
  SUBCONJ_TAC;
    EXPAND_TAC "k";
    BY((ASM_MESON_TAC[facet_3_facets]));
  DISCH_TAC;
  CONJ_TAC;
    GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `(\v. &(k v)) = (\ c. &(CARD {e | e facet_of c })) o f`) SUBST1_TAC));
      EXPAND_TAC "k";
      BY((REWRITE_TAC[FUN_EQ_THM;o_DEF]));
    GMATCH_SIMP_TAC BIJ_SUM;
    GOAL_TERM (fun w -> (EXISTS_TAC ( env w `{ c | c facet_of P }`)));
    ASM_REWRITE_TAC[];
    MATCH_MP_TAC polyhedron_edge_sum;
    ASM_SIMP_TAC[arith `13 <= n ==> 2 <= n`];
    REWRITE_TAC[HAS_SIZE];
    BY((ASM_MESON_TAC[ Misc_defs_and_lemmas.BIJ_CARD; Misc_defs_and_lemmas.FINITE_BIJ]));
  COMMENT "last conjunct: 4 pi";
  ASM_SIMP_TAC[GSYM POLYHEDRON_FACET_SUM_4Pi];
  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));
    GMATCH_SIMP_TAC BIJ_SUM;
    BY((ASM_MESON_TAC[]));
  MATCH_MP_TAC SUM_LE;
  ASM_REWRITE_TAC[];
  X_GENv_TAC "v";
  DISCH_TAC;
  REWRITE_TAC[o_DEF];
  MATCH_MP_TAC (arith `a <= x /\ b <= x==>    (max a b <= x)`);
  SUBCONJ_TAC;
    MATCH_MP_TAC FACET_SOL_NN;
    BY((ASM_MESON_TAC[]));
  DISCH_TAC;
  REWRITE_TAC[ Sphere.regular_spherical_polygon_area ];
  MATCH_MP_TAC GOTCJAH;
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `f v`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `v`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `b v`)));
  GOAL_TERM (fun w -> (EXISTS_TAC ( env w `P`)));
  GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `{u | u facet_of f v} HAS_SIZE k v`) (fun t -> REWRITE_TAC[t])));
    EXPAND_TAC "k";
    REWRITE_TAC[HAS_SIZE];
    MATCH_MP_TAC FACET_FINITE;
    BY((ASM_MESON_TAC[]));
  ASM_SIMP_TAC[];
  AP_TERM_TAC;
  REWRITE_TAC[FUN_EQ_THM;IN_ELIM_THM];
  GEN_TAC;
  REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
  BY((MESON_TAC[DOT_SYM]))
  ]);;
  (* }}} *)

end;;