(* ========================================================================== *)
(* 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)))`,
(* }}} *)
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)))`,
(* }}} *)
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;;