text_formalization/nonlinear/merge_ineq.hl

   1 (* ========================================================================== *)
   2 (* FLYSPECK - BOOK FORMALIZATION                                              *)
   3 (*                                                                            *)
   4 (* Chapter: Nonlinear                                                         *)
   5 (* Author: Thomas C. Hales                                                    *)
   6 (* Date: 2012-06-08                                                           *)
   7 (* ========================================================================== *)
   8
   9 (*
  10 Copies DIHV_EQ_DIH_Y from Tame_general.
  11
  12 *)
  13
  14 (*
  15
  16 There are many nonlinear inequalities in the database, which have
  17 been broken into pieces to simplify verification.  However, the text
  18 "Dense Sphere Packings" uses the inequalities in a merged formed that
  19 combine many separate pieces.  Here we merge the inequalities
  20 into the form used in the text.
  21
  22 In particular the 5*46 inequalities of nonlinear/ineqdata3q1h.hl have
  23 been merged into a single inequality: ox3q1h_merge (in 13 variables).
  24 The assumption ox3q1h is the conjunction of these 230 inequalities.
  25
  26 This file is rather slow to load because it processes hundreds of
  27 inequalities.
  28
  29 Major results in this file:
  30  ox3q1h_merge : the 5*46 inequalities merged into one.
  31  TSKAJXY_DERIVED4: tsk; that is, Ineq.TSKAJXY_DERIVED.ineq
  32  ztg4 : ztg4_concl : combining ZTGIJCF4 ineqs.
  33  lindih inequalities.
  34
  35 This file also proves many compatibilities of definitions.
  36 *)
  37
  38 (* bug b14<->b34 fixed, feb 13, 2013 tchales *)
  39
  40 flyspeck_needs "nonlinear/ineqdata3q1h.hl";;
  41
  42 module Merge_ineq = struct
  43
  44   open Sphere;;
  45   open Hales_tactic;;
  46
  47   let CALC_ID_TAC = Calc_derivative.CALC_ID_TAC;;
  48
  49   let let_RULE = fun th -> REWRITE_RULE[DEPTH_CONV let_CONV (concl th)] th;;
  50
  51   let critical_edge_y = new_definition `critical_edge_y y = ((&2*hminus <= y) /\ (y <= &2 *hplus))`;;
  52
  53 let add_hyp s concl =
  54   let nonlinear = map (fun t -> (hd(Ineq.getexact t)).ineq) s in
  55   let conj = end_itlist (curry mk_conj) nonlinear in
  56     mk_imp(conj,concl);;
  57
  58 let COND_FALSE = prove_by_refinement(
  59   `!a (b:B) c. (~a) ==> ((if a then b else c) = c)`,
  60   (* {{{ proof *)
  61   [
  62   BY(MESON_TAC[])
  63   ]);;
  64   (* }}} *)
  65
  66
  67 (* ========================================================================== *)
  68 (* Merge ineqdata3q1h.hl into a single inequality *)
  69 (* ========================================================================== *)
  70
  71 let idq_of_string s = hd(Ineq.getexact s);;
  72
  73 (* idq_of_string "OXLZLEZ 6346351218 1 18";; *)
  74
  75
  76 (* merge the inequalities in ineqdata3q1h.hl *)
  77
  78 let ox n i =
  79   (idq_of_string (Printf.sprintf "OXLZLEZ 6346351218 %d %d" i n)).ineq;;
  80
  81 let tm0 n = ox n 0;;
  82 let tm1 n = ox n 1;;
  83 let tm2 n = ox n 2;;
  84 let tm3 n = ox n 3;;
  85 let tm4 n = ox n 4;;
  86
  87 let numcases = List.length Ineqdata3q1h.records;;
  88
  89 let ox_conj n = end_itlist (curry mk_conj) [tm0 n;tm1 n;tm2 n;tm3 n;tm4 n];;
  90 let ox3q1h_term() =
  91   end_itlist (curry mk_conj) (map ox_conj (0--(numcases-1)));;
  92 let ox3q1h() =  new_definition (mk_eq (`ox3q1h:bool`,ox3q1h_term()));;
  93 let ox3q1h_mp = MP_TAC(ox3q1h());;
  94
  95 (* GENERATE PACKING CHAPTER NONLINEAR INEQS *)
  96 (* get ids, make 1 def, extract *)
  97
  98 let filter_flypaper tl =
  99   List.flatten (map (function
 100             | Flypaper s -> s
 101             | _ -> []) tl);;
 102
 103 let has_flypaper_tag sl ind =
 104   let tl = ind.tags in
 105     List.length (intersect (filter_flypaper tl) sl) > 0;;
 106
 107 let is_ox3q1h ind =
 108   let oxl = "OXLZLEZ 6346351218" in
 109   let s = ind.idv in
 110     ( (String.length oxl <= String.length s) &&
 111                              (String.sub s 0 (String.length oxl) = oxl));;
 112
 113 let packing_ineq_data =
 114   filter (fun ind ->
 115             has_flypaper_tag ["UKBRPFE";"BIEFJHU";"OXLZLEZ";"TSKAJXY"] ind &&
 116          not(is_ox3q1h ind)) (!Ineq.ineqs);;
 117
 118 let mk_pack_nonlinear =
 119   let ineql = map (fun idv -> idv.ineq) packing_ineq_data in
 120   let packing_ineq_conj = end_itlist (curry mk_conj) ineql in
 121   let _ = new_definition (mk_eq (`pack_nonlinear_non_ox3q1h:bool`,packing_ineq_conj)) in
 122     ();;
 123
 124 let get_pack_nonlinear_non_ox3q1h =
 125   let ineql = map (fun ind -> ind.ineq) packing_ineq_data in
 126   let sl = map (fun ind -> ind.idv) packing_ineq_data in
 127   let packing_ineq_conj = end_itlist (curry mk_conj) ineql in
 128   let th = new_definition (mk_eq (`pack_nonlinear_non_ox3q1h:bool`,packing_ineq_conj)) in
 129   let th1 = UNDISCH (MATCH_MP (TAUT `(a <=> b) ==> (a ==> b)`) th) in
 130   let co1 thm = if (is_conj (concl thm)) then CONJUNCT1 thm else thm in
 131     fun s ->
 132       let i = index s sl in
 133       let th2 = funpow i CONJUNCT2 th1 in
 134         co1 th2;;
 135
 136 let example1 =  (get_pack_nonlinear_non_ox3q1h "BIXPCGW 6652007036 a2");;
 137
 138
 139 let [yv;a12;a23;a34;a14;b12;b23;b34;b14;c1;c2;c3;c4] =
 140   map (fun t -> mk_var(t,`:real`))
 141     (Str.split (Str.regexp " ")
 142        "y a12 a23 a34 a14 b12 b23 b34 b14 c1 c2 c3 c4");;
 143
 144 let y12 = `(a12 + b12)/ &2`;;
 145 let y23 = `(a23 + b23)/ &2`;;
 146 let y34 = `(a34 + b34)/ &2`;;
 147 let y41 = `(a14 + b14)/ &2`;;
 148
 149 let specl x = concl o (SPECL x) o ASSUME;;
 150 let spec1 = specl[yv;a12;a14;c1;b14;b12];;
 151 let spec2 = specl[yv;a23;a12;c2;b12;b23];;
 152 let spec3 = specl[yv;a34;a23;c3;b23;b34];;
 153 let spec4 = specl[yv;a14;a34;c4;b34;b14];;
 154 (* let spec4 = specl[yv;a14;a34;c4;b14;b34];;  (* bug b14<->b34 fixed, feb 13, 2013 tchales *) *)
 155
 156 let spec0 = specl[yv;y12;y23;y34;y41];;
 157 let in1 n  = spec1 (tm1 n);;
 158 let in2 n = spec2 (tm2 n);;
 159 let in3 n = spec3 (tm3 n);;
 160 let in4 n = spec4  (tm4 n);;
 161 let in0 n = spec0  (tm0 n);;
 162
 163 (* labels: y=spine, aij lower edge shared between i & j. bij = top edge.
 164    ci = edge opp spine on simplex i *)
 165 prioritize_real();;
 166
 167 (*
 168 let getinstantiation =
 169   let concl1 = ` (gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun / w +
 170                     cb * beta_bump_force_y y1 y2 y3 y4 y5 y6 +
 171         cd * dih_y y1 y2 y3 y4 y5 y6 +
 172         cy * y1 +
 173         cab * (y2 + y3 + y5 + y6) +
 174         cc >
 175         &0)` in
 176   fun in2 ->
 177     let u =  hd(tl(snd (strip_comb in2))) in
 178       (term_match [] (concl1)) u;;
 179 *)
 180
 181 let combinator_lemma =
 182   prove_by_refinement(`!cd cy1 cy2 cy3 cy4 cab1 cab2 cab3 cab4 cc1 cc2 cc3 cc4.
 183    ((dih_y y a12 a14 c1 b14 b12 +
 184       dih_y y a23 a12 c2 b12 b23 +
 185       dih_y y a34 a23 c3 b23 b34 +
 186 // bug2/14/2013:      dih_y y a14 a34 c4 b14 b34 =
 187       dih_y y a14 a34 c4 b34 b14 =
 188       &2 * pi) /\ (&2 * pi * cd +
 189  (cy1 + cy2 + cy3 + cy4) * y +
 190  &2 * (cab1 + cab2) * (a12 + b12) / &2 +
 191  &2 * (cab2 + cab3) * (a23 + b23) / &2 +
 192  &2 * (cab3 + cab4) * (a34 + b34) / &2 +
 193  &2 * (cab4 + cab1) * (a14 + b14) / &2 +
 194  cc1 +
 195  cc2 +
 196  cc3 +
 197  cc4 <
 198  &0) /\ ( gamma4fgcy y a12 a14 c1 b14 b12 lmfun / &2 +
 199      &1 * beta_bump_force_y y a12 a14 c1 b14 b12 +
 200      cd * dih_y y a12 a14 c1 b14 b12 +
 201      cy1 * y +
 202      cab1 * (a12 + a14 + b14 + b12) +
 203      cc1 >
 204      &0) /\
 205    (gamma4fgcy y a23 a12 c2 b12 b23 lmfun / &1 +
 206      &0 * beta_bump_force_y y a23 a12 c2 b12 b23 +
 207      cd * dih_y y a23 a12 c2 b12 b23 +
 208      cy2 * y +
 209      cab2 * (a23 + a12 + b12 + b23) +
 210      cc2 > &0) /\
 211    (gamma4fgcy y a34 a23 c3 b23 b34 lmfun / &1 +
 212      &0 * beta_bump_force_y y a34 a23 c3 b23 b34 +
 213      cd * dih_y y a34 a23 c3 b23 b34 +
 214      cy3 * y +
 215      cab3 * (a34 + a23 + b23 + b34) +
 216      cc3 >
 217      &0) /\
 218 //    (gamma4fgcy y a14 a34 c4 b14 b34 lmfun / &1 +
 219 //     &0 * beta_bump_force_y y a14 a34 c4 b14 b34 +
 220 //     cd * dih_y y a14 a34 c4 b14 b34 +
 221     (gamma4fgcy y a14 a34 c4 b34 b14 lmfun / &1 +
 222      &0 * beta_bump_force_y y a14 a34 c4 b34 b14 +
 223      cd * dih_y y a14 a34 c4 b34 b14 +
 224      cy4 * y +
 225      cab4 * (a14 + a34 + b34 + b14) +
 226      cc4 >
 227      &0) ==>
 228     (  gamma4fgcy y a12 a14 c1 b14 b12 lmfun / &2 +
 229      beta_bump_force_y y a12 a14 c1 b14 b12 +
 230      gamma4fgcy y a23 a12 c2 b12 b23 lmfun +
 231      gamma4fgcy y a34 a23 c3 b23 b34 lmfun +
 232 //     gamma4fgcy y a14 a34 c4 b14 b34 lmfun >
 233      gamma4fgcy y a14 a34 c4 b34 b14 lmfun >
 234      &0
 235      ))`,
 236   (* {{{ proof *)
 237   [
 238   REPEAT WEAK_STRIP_TAC;
 239   REPEAT(FIRST_X_ASSUM_ST `gamma4fgcy` MP_TAC);
 240   MATCH_MP_TAC (arith `(a + b+c+d - e < &0)   ==> ((a > &0) ==> (b > &0) ==> (c > &0) ==> (d > &0) ==> (e> &0))`);
 241   FIRST_X_ASSUM MP_TAC;
 242   MATCH_MP_TAC (arith `(t = e) ==> ((t< &0) ==> (e < &0))`);
 243   REWRITE_TAC[arith `&2 * pi * cd = (&2 * pi) * cd`];
 244   FIRST_X_ASSUM (SUBST1_TAC o (SYM));
 245   BY(REAL_ARITH_TAC)
 246   ]);;
 247   (* }}} *)
 248
 249
 250 let template_OX = `!in0 in1 in2 in3 in4
 251   y' y''
 252   c1' c1'' c2' c2'' c3' c3'' c4' c4''
 253   a12' a12'' a23' a23'' a34' a34'' a14' a14''
 254   b12' b12'' b23' b23'' b34' b34'' b14' b14''.
 255   (in0 /\ in1 /\ in2 /\ in3 /\ in4) ==>
 256   ineq [(y',y,y'');
 257    (c1',c1,c1'');
 258    (c2',c2,c2'');
 259    (c3',c3,c3'');
 260    (c4',c4,c4'');
 261    (a12',a12,a12'');
 262    (a23',a23,a23'');
 263    (a34',a34,a34'');
 264    (a14',a14,a14'');
 265    (b12',b12,b12'');
 266    (b23',b23,b23'');
 267    (b34',b34,b34'');
 268    (b14',b14,b14'')
 269    ]
 270   ((dih_y y a12 a14 c1 b14 b12  +
 271   dih_y y a23 a12 c2 b12 b23  +
 272   dih_y y a34 a23 c3 b23 b34  +
 273 //  dih_y y a14 a34 c4 b14 b34 = &2 * pi) ==>
 274   dih_y y a14 a34 c4 b34 b14 = &2 * pi) ==>
 275   (gamma4fgcy y a12 a14 c1 b14 b12 lmfun / &2 +
 276   beta_bump_force_y y a12 a14 c1 b14 b12 +
 277   gamma4fgcy y a23 a12 c2 b12 b23 lmfun +
 278   gamma4fgcy y a34 a23 c3 b23 b34 lmfun +
 279 //  gamma4fgcy y a14 a34 c4 b14 b34 lmfun
 280   gamma4fgcy y a14 a34 c4 b34 b14 lmfun
 281    > &0))`;;
 282
 283 let template_OX2 = `!
 284   y' y''
 285   c1' c1'' c2' c2'' c3' c3'' c4' c4''
 286   a12' a12'' a23' a23'' a34' a34'' a14' a14''
 287   b12' b12'' b23' b23'' b34' b34'' b14' b14''.
 288   ox3q1h ==>
 289   ineq [(y',y,y'');
 290    (c1',c1,c1'');
 291    (c2',c2,c2'');
 292    (c3',c3,c3'');
 293    (c4',c4,c4'');
 294    (a12',a12,a12'');
 295    (a23',a23,a23'');
 296    (a34',a34,a34'');
 297    (a14',a14,a14'');
 298    (b12',b12,b12'');
 299    (b23',b23,b23'');
 300    (b34',b34,b34'');
 301    (b14',b14,b14'')
 302    ]
 303   ((dih_y y a12 a14 c1 b14 b12  +
 304   dih_y y a23 a12 c2 b12 b23  +
 305   dih_y y a34 a23 c3 b23 b34  +
 306 //  dih_y y a14 a34 c4 b14 b34 = &2 * pi) ==>
 307   dih_y y a14 a34 c4 b34 b14 = &2 * pi) ==>
 308   (gamma4fgcy y a12 a14 c1 b14 b12 lmfun / &2 +
 309   beta_bump_force_y y a12 a14 c1 b14 b12 +
 310   gamma4fgcy y a23 a12 c2 b12 b23 lmfun +
 311   gamma4fgcy y a34 a23 c3 b23 b34 lmfun +
 312 //  gamma4fgcy y a14 a34 c4 b14 b34 lmfun
 313   gamma4fgcy y a14 a34 c4 b34 b14 lmfun
 314  > &0))`;;
 315
 316
 317 let dest_triple x =
 318   let (a,b) = dest_pair x in
 319   let (b,c) = dest_pair b in (b,(a,c));;
 320
 321 let getbounds tm =
 322   let xx1 = hd(snd(strip_comb tm)) in
 323   let xx2 = dest_list xx1 in
 324     map dest_triple xx2;;
 325
 326 let allbounds n = setify(List.flatten (map getbounds [in1 n;in2 n;in3 n;in4 n]));;
 327
 328 let goal_OX n =
 329   let g1 = specl [in0 n;in1 n;in2 n;in3 n;in4 n] template_OX in
 330   let a = C assoc (allbounds n) in
 331   let s1 v g =
 332     let (v',v'')  = a v in
 333       specl [v';v''] g in
 334     itlist s1 (List.rev [yv;c1;c2;c3;c4;a12;a23;a34;a14;b12;b23;b34;b14]) g1;;
 335
 336 let goal_OX2 n =
 337   let g1 = template_OX2 in
 338   let a = C assoc (allbounds n) in
 339   let s1 v g =
 340     let (v',v'')  = a v in
 341       specl [v';v''] g in
 342     itlist s1 (List.rev [yv;c1;c2;c3;c4;a12;a23;a34;a14;b12;b23;b34;b14]) g1;;
 343
 344
 345 let mk13ner n = prove_by_refinement(
 346   goal_OX n,
 347   (* {{{ proof *)
 348   [
 349   REWRITE_TAC[Sphere.ineq];
 350   REPEAT STRIP_TAC;
 351   REPEAT (FIRST_X_ASSUM_ST `/\` MP_TAC);
 352   ASM_REWRITE_TAC[];
 353   ASM_SIMP_TAC[arith `a <= b /\ a <= c ==> a <= (b + c)/ &2`; arith `b <= a /\ c <= a ==> (b + c)/ &2 <= a` ];
 354   FIRST_X_ASSUM_ST `dih_y` MP_TAC;
 355   REWRITE_TAC[TAUT `(a ==> b==>c ==>d==>e==>f==>g)<=>(a /\ b /\ c /\ d/\ e /\ f ==>g)`];
 356   DISCH_THEN (ASSUME_TAC o (MATCH_MP combinator_lemma));
 357   BY(ASM_REWRITE_TAC[])
 358   ]);;
 359   (* }}} *)
 360
 361 let mk_ox3q1h n = prove_by_refinement(
 362   goal_OX2 n,
 363   (* {{{ proof *)
 364   [
 365  REPEAT WEAK_STRIP_TAC;
 366   MATCH_MP_TAC (mk13ner n);
 367   BY(BY(ox3q1h_mp THEN ASM_REWRITE_TAC[] THEN REPEAT WEAK_STRIP_TAC THEN ASM_REWRITE_TAC[]))
 368   ]);;
 369   (* }}} *)
 370
 371 let ox3q1h_46() = map mk_ox3q1h (0--(numcases-1));;
 372
 373 (* now start combining inequalities from ineqdata31h.hl *)
 374
 375
 376 let ineq_APPEND = prove_by_refinement(
 377   `!v f u. ineq (APPEND u v) f = ineq u (ineq v f)`,
 378   (* {{{ proof *)
 379   [
 380   GEN_TAC;
 381   GEN_TAC;
 382   LIST_INDUCT_TAC;
 383     REWRITE_TAC[APPEND];
 384     BY(REWRITE_TAC[APPEND;Sphere.ineq]);
 385   REWRITE_TAC[APPEND;Sphere.ineq];
 386   SUBGOAL_THEN `?(a:real) (b:real) (c:real). h = (a,b,c)` MP_TAC;
 387     BY(MESON_TAC[PAIR_SURJECTIVE]);
 388   REPEAT WEAK_STRIP_TAC;
 389   ASM_REWRITE_TAC[];
 390   REWRITE_TAC[Sphere.ineq];
 391   BY(ASM_MESON_TAC[])
 392   ]);;
 393   (* }}} *)
 394
 395 let pathL_pathR = prove_by_refinement(
 396   `!c x.
 397     (FST c <= x /\ x <= SND c) <=> (
 398       (FST(pathL c) <= x /\ x <= SND(pathL c)) \/
 399       (FST(pathR c) <= x /\ x <= SND(pathR c)))
 400 `,
 401   (* {{{ proof *)
 402   [
 403   REPEAT STRIP_TAC;
 404   SUBGOAL_THEN `?(a:real) (b:real). c = (a,b)` MP_TAC;
 405     BY(REWRITE_TAC[PAIR_SURJECTIVE]);
 406   REPEAT WEAK_STRIP_TAC;
 407   ASM_REWRITE_TAC[Sphere.pathL;Sphere.pathR];
 408   BY(REAL_ARITH_TAC)
 409   ]);;
 410   (* }}} *)
 411
 412 let ineq_pathL_pathR = prove_by_refinement(
 413   `!u c x f.
 414     ineq (APPEND u (CONS (FST(pathL c),x,SND(pathL c)) v)) f /\
 415     ineq (APPEND u (CONS (FST(pathR c),x,SND(pathR c)) v)) f ==>
 416     ineq (APPEND u (CONS (FST c,x,SND c) v)) f`,
 417   (* {{{ proof *)
 418   [
 419   REWRITE_TAC[ineq_APPEND];
 420   REWRITE_TAC[Sphere.ineq];
 421   REPEAT WEAK_STRIP_TAC;
 422   ONCE_REWRITE_TAC[pathL_pathR];
 423   REPEAT (FIRST_X_ASSUM MP_TAC);
 424   BY(ASM_CASES_TAC `FST (pathL c) <= x /\ x <= SND (pathL c)` THEN ASM_CASES_TAC ` FST (pathR c) <= x /\ x <= SND (pathR c)` THEN ASM_REWRITE_TAC[] THEN REPEAT WEAK_STRIP_TAC THEN ASM_REWRITE_TAC[])
 425   ]);;
 426   (* }}} *)
 427
 428 let chop0 = prove_by_refinement(
 429   `!l. l = APPEND [] l`,
 430   (* {{{ proof *)
 431   [
 432   BY(REWRITE_TAC[APPEND])
 433   ]);;
 434   (* }}} *)
 435
 436 let chop1 = prove_by_refinement(
 437   `!l. CONS a l = APPEND [a] l`,
 438   (* {{{ proof *)
 439   [
 440   BY(REWRITE_TAC[APPEND])
 441   ]);;
 442   (* }}} *)
 443
 444 let chop2 = prove_by_refinement(
 445   `!l. CONS a1 (CONS a2 l) = APPEND [a1;a2] l`,
 446   (* {{{ proof *)
 447   [
 448   BY(REWRITE_TAC[APPEND])
 449   ]);;
 450   (* }}} *)
 451
 452 let chop3 = prove_by_refinement(
 453   `!l. CONS a1 (CONS a2 (CONS a3 l)) = APPEND [a1;a2;a3] l`,
 454   (* {{{ proof *)
 455   [
 456   BY(REWRITE_TAC[APPEND])
 457   ]);;
 458   (* }}} *)
 459
 460 let chop4 = prove_by_refinement(
 461   `!l. CONS a1 (CONS a2 (CONS a3 (CONS a4 l))) = APPEND [a1;a2;a3;a4] l`,
 462   (* {{{ proof *)
 463   [
 464   BY(REWRITE_TAC[APPEND])
 465   ]);;
 466   (* }}} *)
 467
 468 let chop5 = prove_by_refinement(
 469   `!l. CONS a1 (CONS a2 (CONS a3 (CONS a4 (CONS a5 l)))) = APPEND [a1;a2;a3;a4;a5] l`,
 470   (* {{{ proof *)
 471   [
 472   BY(REWRITE_TAC[APPEND])
 473   ]);;
 474   (* }}} *)
 475
 476 let CHOP_LIST_TAC n =
 477   let chop = List.nth [chop0;chop1;chop2;chop3;chop4;chop5] n in
 478     ONCE_REWRITE_TAC[chop];;
 479
 480 let CHOP_LIST_RULE n =
 481   let chop = List.nth [chop0;chop1;chop2;chop3;chop4;chop5] n in
 482     ONCE_REWRITE_RULE[chop];;
 483
 484 let get_cover i =
 485   let zipr = zip (0--(numcases-1)) Ineqdata3q1h.records  in
 486   let fil = filter (fun (_,t) -> t.caseno=i) zipr in
 487   let v = List.rev in
 488       map
 489         (fun (k,t) ->
 490            (k,(v t.branch1,v t.branch2,v t.branch3,v t.branch4,v t.branch5)))
 491              fil;;
 492
 493 let op1 gc k =
 494   let thm = REWRITE_RULE[FST;SND] (UNDISCH (mk_ox3q1h k)) in
 495     (thm,assoc k gc);;
 496
 497 let prep n =
 498   let gc = get_cover n in
 499   let vs = map fst gc in
 500     map (op1 gc) vs;;
 501
 502 let merge_match (th1,r1) (th2,r2) =
 503   let ((bx,nx),r3) = Ineqdata3q1h.combine (r1,r2) in
 504   let (th1',th2') = if bx then (th1,th2) else (th2,th1) in
 505   let th3 = CHOP_LIST_RULE nx (CONJ th1' th2') in
 506   let th4 = MATCH_MP ineq_pathL_pathR th3 in
 507   let th5 = REWRITE_RULE[APPEND;FST;SND] th4 in
 508     (th5,r3);;
 509
 510 let rec combine_l = function
 511     [] -> []
 512   | [a] -> [a]
 513   | a::b::cs ->
 514       try (merge_match a b)::cs
 515       with Failure _ -> a::combine_l (b::cs);;
 516
 517 let rec combine_r x =
 518   let x'= combine_l x in
 519     if (x'=x) then x else combine_r x';;
 520
 521 let combos = map (combine_r o prep) (1--4);;
 522 let partial_merge = end_itlist CONJ (map fst (List.flatten combos));;
 523
 524 let hminus_h0_hplus = prove_by_refinement(
 525   `!x. (&2 * hminus <= x /\ x <= &2 * hplus) <=> ((&2 * hminus <= x /\ x <= &2 *h0) \/ (&2 * h0 <= x /\ x <= &2 * hplus))`,
 526   (* {{{ proof *)
 527   [
 528   GEN_TAC;
 529   MP_TAC Nonlinear_lemma.hminus_lt_h0;
 530   MP_TAC Nonlinear_lemma.h0_lt_hplus;
 531   BY(REAL_ARITH_TAC)
 532   ]);;
 533   (* }}} *)
 534
 535 let ox3q1h_merge = prove_by_refinement(
 536   `ox3q1h ==>
 537    !y c1 c2 c3 c4 a12 a23 a34 a14 b12 b23 b34 b14.
 538         ineq
 539        [&2 * hminus,y,&2 * hplus; &2 * hminus,c1,&2 * hplus; &2,c2,&2 * hminus;
 540        &2,
 541        c3,
 542        &2 * hminus; &2,c4,&2 * hminus; &2,a12,&2 * hminus; &2,a23,&2 * hminus;
 543        &2,
 544        a34,
 545        &2 * hminus; &2,a14,&2 * hminus; &2,b12,&2 * hminus; &2,
 546                                                             b23,
 547                                                             &2 * hminus;
 548        &2,
 549        b34,
 550        &2 * hminus; &2,b14,&2 * hminus]
 551        (dih_y y a12 a14 c1 b14 b12 +
 552         dih_y y a23 a12 c2 b12 b23 +
 553         dih_y y a34 a23 c3 b23 b34 +
 554 //        dih_y y a14 a34 c4 b14 b34 =
 555         dih_y y a14 a34 c4 b34 b14 =
 556         &2 * pi
 557         ==> gamma4fgcy y a12 a14 c1 b14 b12 lmfun / &2 +
 558             beta_bump_force_y y a12 a14 c1 b14 b12 +
 559             gamma4fgcy y a23 a12 c2 b12 b23 lmfun +
 560             gamma4fgcy y a34 a23 c3 b23 b34 lmfun +
 561 //            gamma4fgcy y a14 a34 c4 b14 b34 lmfun >
 562             gamma4fgcy y a14 a34 c4 b34 b14 lmfun >
 563             &0)`,
 564   (* {{{ proof *)
 565   [
 566   REPEAT WEAK_STRIP_TAC;
 567   MP_TAC partial_merge;
 568   CHOP_LIST_TAC (2);
 569   REWRITE_TAC[ineq_APPEND];
 570   REPLICATE_TAC 3 (ONCE_REWRITE_TAC[Sphere.ineq]);
 571   REWRITE_TAC[hminus_h0_hplus];
 572   BY(BOOL_CASES_TAC `&2 * hminus <= y /\ y <= &2 * h0` THEN BOOL_CASES_TAC `&2 * h0 <= y /\ y <= &2 * hplus` THEN BOOL_CASES_TAC `&2 * hminus <= c1 /\ c1 <= &2 * h0` THEN BOOL_CASES_TAC `&2 * h0 <= c1 /\ c1 <= &2 * hplus` THEN REWRITE_TAC[] THEN ASM_MESON_TAC[])
 573   ]);;
 574   (* }}} *)
 575
 576 (* ========================================================================== *)
 577 (* Prove Ineq.TSKAJXY_DERIVED.ineq from the nonlinear inequalities            *)
 578 (* ========================================================================== *)
 579
 580
 581 let atn2_0 = REWRITE_RULE[ATN_0;arith `&0 <= &0`;arith `~(&0 < &0)`;arith `x - &0 = x`;arith `&0/x = &0`] (SPEC `&0` Trigonometry1.ATN2_BREAKDOWN);;
 582
 583 let matan_pos = prove_by_refinement(
 584   `!x. (&0 < x ==> matan x = atn (sqrt x) / sqrt x)`,
 585   (* {{{ proof *)
 586   [
 587   BY(ASM_MESON_TAC[Sphere.matan;arith `&0 < x ==> ~(x = &0) /\ (&0 < x <=> x > &0)`])
 588   ]);;
 589   (* }}} *)
 590
 591 let pi2_sub_atn2 = prove_by_refinement(
 592   `!x y. (&0 < x /\ &0 < y) ==> pi/ &2 - atn2(x,y) = atn2(y,x)`,
 593   (* {{{ proof *)
 594   [
 595     ASM_MESON_TAC[Trigonometry1.ATN2_BREAKDOWN]
 596   ]);;
 597   (* }}} *)
 598
 599 let ATN2_LE_PI2 = prove_by_refinement(
 600   `!x y. &0 < x ==> atn2(x,y) < pi/ &2`,
 601   (* {{{ proof *)
 602   [
 603   REWRITE_TAC[Sphere.atn2];
 604   REPEAT WEAKER_STRIP_TAC;
 605   INTRO_TAC ATN_BOUNDS [];
 606   ASSUME_TAC PI_POS;
 607   DISCH_TAC;
 608   COND_CASES_TAC;
 609     BY(ASM_MESON_TAC[]);
 610   COND_CASES_TAC;
 611     REWRITE_TAC[ATN_POS_LT;arith `p - x < p <=> &0 < x`];
 612     GMATCH_SIMP_TAC REAL_LT_DIV;
 613     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
 614   COND_CASES_TAC;
 615     REWRITE_TAC[arith `-- (x/ &2) - y < x / &2 <=> -- x < y`];
 616     MATCH_MP_TAC (arith `&0 < pi /\ -- ( pi / &2) < u ==> --pi < u`);
 617     BY(ASM_REWRITE_TAC[ATN_BOUNDS]);
 618   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
 619   ]);;
 620   (* }}} *)
 621
 622 let ATN2_POS = prove_by_refinement(
 623   `!x y. &0 < x ==> (&0 < atn2(x,y) <=> &0 < y)`,
 624   (* {{{ proof *)
 625   [
 626   REWRITE_TAC[Sphere.atn2];
 627   REPEAT WEAKER_STRIP_TAC;
 628   ASSUME_TAC PI_POS;
 629   COND_CASES_TAC;
 630     REWRITE_TAC[ATN_POS_LT];
 631     BY(ASM_SIMP_TAC[Collect_geom.REAL_LT_RDIV_0]);
 632   COND_CASES_TAC;
 633     INTRO_TAC ATN_BOUNDS [`x / y`];
 634     BY(REAL_ARITH_TAC);
 635   COND_CASES_TAC;
 636     INTRO_TAC ATN_BOUNDS [`x / y`];
 637     BY(REAL_ARITH_TAC);
 638   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
 639   ]);;
 640   (* }}} *)
 641
 642  let TRI_UPS_X_STRICT_POS = prove
 643    (`!a b c. (&0 < a) /\ (&0 < b) /\ (&0 <= c) /\ (c < a + b) /\ (a < b + c) /\ (b < c + a) ==>
 644      &0 < ups_x (a * a) (b * b) (c * c)`,
 645     REPEAT STRIP_TAC THEN
 646       REWRITE_TAC [Trigonometry1.UPS_X_SQUARES] THEN
 647       BY(REPEAT (MATCH_MP_TAC REAL_LT_MUL ORELSE CONJ_TAC ORELSE
 648                 ASM_REAL_ARITH_TAC)));;
 649
 650  let ups_x_pos24 = prove_by_refinement(
 651   `!a b c. &2 <= a /\ a < &4 /\ &2 <= b /\ b < &4 /\ &2 <= c /\ c < &4 ==> &0 < ups_x (a pow 2) (b pow 2) (c pow 2)`,
 652   (* {{{ proof *)
 653   [
 654   REPEAT STRIP_TAC;
 655   REWRITE_TAC[arith `a pow 2 = a * a`];
 656   MATCH_MP_TAC TRI_UPS_X_STRICT_POS;
 657   REPEAT (FIRST_X_ASSUM MP_TAC);
 658   (BY(ASM_REAL_ARITH_TAC))
 659   ]);;
 660   (* }}} *)
 661
 662 let sqrtpow2 = prove_by_refinement(
 663   `!x. &0 <= x ==> sqrt x * sqrt x = x`,
 664   (* {{{ proof *)
 665   [
 666   REPEAT WEAK_STRIP_TAC;
 667   MATCH_MP_TAC (ISPEC `&0` Nonlinear_lemma.sq_pow2);
 668   BY(FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC)
 669   ]);;
 670   (* }}} *)
 671
 672
 673 (*
 674 let FROZEN_ONCE_REWRITE_TAC ths =
 675      let th = end_itlist CONJ ths in
 676       FREEZE_THEN (fun t -> ONCE_REWRITE_TAC[t]) th;;
 677 *)
 678
 679 let COLLECT_MONOM t =  (Optimize.FROZEN_REWRITE_TAC [
 680   (SPEC t (REAL_ARITH `!t  u v w. (((u * v)* w = u * v*w) /\ (t * (u * v)) = (u * (t * v)) /\  (t * t = t pow 2) /\ (t * t * u = (t pow 2 * u)))`))]);;
 681
 682
 683 let loc_dot = prove_by_refinement(
 684   `!v0 (v1:real^3). (v1 - v0) dot (v1 - v0) = -- &2 * v0 dot v1 + v0 dot v0 + v1 dot v1`,
 685   (* {{{ proof *)
 686   [
 687   REPEAT WEAK_STRIP_TAC;
 688   REWRITE_TAC[VECTOR_ARITH `((v1:real^3) - v0) dot (v1 - v0) = v1 dot v1 - &2 * v0 dot v1 + v0 dot v0`];
 689   BY(REAL_ARITH_TAC)
 690   ]);;
 691   (* }}} *)
 692
 693 let vector_of_simplex_dot = prove_by_refinement(
 694   `!(v0:real^3) v1 v2 v3 x1 x2 x3 x4 x5 x6.
 695     ((v0 = vec 0) /\
 696         (v1 dot v1 = x1) /\
 697         (v2 dot v2 = x2) /\
 698         (v3 dot v3 = x3) /\
 699         (v1 dot v2 = (x1 + x2 - x6)/ &2) /\
 700             (v1 dot v3 = (x1 + x3 - x5)/ &2) /\
 701                 (v2 dot v3 = (x2 + x3 - x4)/ &2 )) ==>
 702               ((x1 = dist(v0,v1) pow 2) /\
 703       (x2 = dist(v0,v2) pow 2) /\
 704       (x3 = dist(v0,v3) pow 2) /\
 705       (x4 = dist(v2,v3) pow 2) /\
 706       (x5 = dist(v1,v3) pow 2) /\
 707      (x6 = dist(v1,v2) pow 2))`,
 708   (* {{{ proof *)
 709   [
 710   REWRITE_TAC[Collect_geom.DIST_POW2_DOT;loc_dot];
 711   REPEAT WEAK_STRIP_TAC;
 712   ASM_REWRITE_TAC[VECTOR_ARITH `vec 0 dot u = &0 /\ u dot vec 0 = &0`];
 713   ONCE_REWRITE_TAC[VECTOR_ARITH `v3 dot v2 = v2 dot v3`];
 714   ASM_REWRITE_TAC[];
 715   BY(REAL_ARITH_TAC)
 716   ]);;
 717   (* }}} *)
 718
 719 let vector_of_simplex_edge_lemma = prove_by_refinement(
 720   `!x1 x2 x3 x4 x5 x6 y1 u1 d1 p. ~(y1= &0)  /\ ~(u1 = &0) /\
 721    &0 <= delta_x x1 x2 x3 x4 x5 x6 /\ y1 pow 2 = x1 /\ u1 pow 2 = ups_x x1 x2 x6 /\
 722        d1 pow 2 = delta_x x1 x2 x3 x4 x5 x6 /\ p = (x1*x1 - x1*x2 - x1*x3 + x2*x3 + &2*x1*x4 - x1*x5 - x2*x5 - x1*x6 - x3*x6 + x5*x6)
 723    ==>
 724     (let (v0:real^3) = vec 0 in
 725     let v1 = vector [y1; &0; &0] in
 726     let v2 = vector [(x1+x2 - x6)/(&2 * y1); u1/(&2 * y1); &0] in
 727     let v3 = vector [(x1+x3-x5)/(&2 * y1);
 728     -- p/(&2*y1 *u1);d1/u1]   in
 729       ((x1 = dist(v0,v1) pow 2) /\
 730       (x2 = dist(v0,v2) pow 2) /\
 731       (x3 = dist(v0,v3) pow 2) /\
 732       (x4 = dist(v2,v3) pow 2) /\
 733       (x5 = dist(v1,v3) pow 2) /\
 734      (x6 = dist(v1,v2) pow 2)))`,
 735   (* {{{ proof *)
 736   [
 737   REPEAT WEAK_STRIP_TAC;
 738   REWRITE_TAC[LET_DEF;LET_END_DEF];
 739   MATCH_MP_TAC vector_of_simplex_dot;
 740   REWRITE_TAC[Collect_geom.DIST_POW2_DOT;vector_norm;DOT_3;VECTOR_SUB_COMPONENT;VECTOR_3];
 741   BY(REPEAT CONJ_TAC THEN CALC_ID_TAC THEN ASM_REWRITE_TAC[arith `(-- x)*y = -- (x *y) /\ x*(--y) = -- (x * y) /\  (-- (x + y) = --x + --y) /\ (x +y)+z = x + y+z /\ (-- (-- x) = x) /\ (x - y = x + (-- y)) /\ x * &0 = &0 /\ &0 * x = &0 /\ (x + y)*z = x*z + y*z /\ z*(x+y) = z*x + z*y`;arith `(a * b) *c = a * b* c`;] THEN REPEAT (FIRST_X_ASSUM MP_TAC) THEN REWRITE_TAC[arith `~(&2= &0)`] THEN REPLICATE_TAC 3 DISCH_TAC THEN (COLLECT_MONOM `y1:real`) THEN (COLLECT_MONOM `u1:real`) THEN (COLLECT_MONOM `d1:real`) THEN REPEAT WEAK_STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[Sphere.ups_x;Sphere.delta_x] THEN REAL_ARITH_TAC)
 742   ]);;
 743   (* }}} *)
 744
 745 let simplex_exists = prove_by_refinement(
 746   `!x1 x2 x3 x4 x5 x6. (&0 < x1 /\ &0 < ups_x x1 x2 x6 /\ &0 <=
 747    delta_x x1 x2 x3 x4 x5 x6) ==> (?(v0:real^3) v1 v2 v3.
 748     (   x1 = dist(v0,v1) pow 2 /\
 749       x2 = dist (v0,v2) pow 2 /\
 750       x3 = dist (v0,v3) pow 2 /\
 751       x4 = dist (v2,v3) pow 2 /\
 752       x5 = dist (v1,v3) pow 2 /\
 753       x6 = dist (v1,v2) pow 2))`,
 754   (* {{{ proof *)
 755   [
 756   REPEAT WEAK_STRIP_TAC;
 757   MP_TAC (ISPECL [`x1:real`;`x2:real`;`x3:real`;`x4:real`;`x5:real`;`x6:real`;`sqrt x1`;`sqrt(ups_x x1 x2 x6)`;`sqrt(delta_x x1 x2 x3 x4 x5 x6)`;`(x1*x1 - x1*x2 - x1*x3 + x2*x3 + &2*x1*x4 - x1*x5 - x2*x5 - x1*x6 - x3*x6 + x5*x6)`] vector_of_simplex_edge_lemma);
 758   ASM_REWRITE_TAC[];
 759   ANTS_TAC;
 760     REWRITE_TAC[SQRT_POW2];
 761     GMATCH_SIMP_TAC SQRT_EQ_0;
 762     GMATCH_SIMP_TAC SQRT_EQ_0;
 763     REPEAT (FIRST_X_ASSUM (MP_TAC));
 764     BY(REAL_ARITH_TAC);
 765   LET_TAC;
 766   REPEAT LET_TAC;
 767   BY(MESON_TAC[])
 768   ]);;
 769   (* }}} *)
 770
 771 let DELTA_X_AND_DELTA_X4 = prove(`!x1 x2 x3 x4 x5 x6.
 772                                  (let d4 = delta_x4 x1 x2 x3 x4 x5 x6 in
 773                                  let d = delta_x x1 x2 x3 x4 x5 x6 in
 774                                  let v1 = ups_x x1 x2 x6 in
 775                                  let v2 = ups_x x1 x3 x5 in
 776                                  &4 * x1 * d = v1 * v2 - d4 * d4)`,
 777   REPEAT GEN_TAC THEN
 778     REPEAT (CONV_TAC let_CONV) THEN
 779     REWRITE_TAC[Sphere.delta_x4; Sphere.delta_x; Sphere.ups_x] THEN
 780     REAL_ARITH_TAC);;
 781
 782 (* dihV = dih_y *)
 783 let DIHV_EQ_DIH_Y = prove(`!v0:real^3 v1 v2 v3. ~collinear {v0, v1, v2} /\ ~collinear {v0, v1, v3}
 784                             ==> (let v01 = dist (v0, v1) in
 785                                  let v02 = dist (v0, v2) in
 786                                  let v03 = dist (v0, v3) in
 787                                  let v12 = dist (v1, v2) in
 788                                  let v13 = dist (v1, v3) in
 789                                  let v23 = dist (v2, v3) in
 790                                    dihV v0 v1 v2 v3 = dih_y v01 v02 v03 v23 v13 v12)`,
 791   REPEAT GEN_TAC THEN
 792     DISCH_TAC THEN
 793     FIRST_ASSUM (MP_TAC o (fun th -> CONJUNCT2 (MATCH_MP (let_RULE Trigonometry.OJEKOJF) th))) THEN
 794     DISCH_THEN (unlist REWRITE_TAC) THEN
 795     REPEAT (CONV_TAC let_CONV) THEN
 796     MAP_EVERY ABBREV_TAC [`v01 = dist(v0:real^3,v1)`; `v02 = dist(v0:real^3,v2)`;
 797                           `v03 = dist(v0:real^3,v3)`; `v12 = dist(v1:real^3,v2)`;
 798                           `v13 = dist(v1:real^3,v3)`; `v23 = dist(v2:real^3,v3)`;
 799                           `d = delta_x (v01 pow 2) (v02 pow 2) (v03 pow 2) (v23 pow 2) (v13 pow 2) (v12 pow 2)`;
 800                           `d4 = delta_x4 (v01 pow 2) (v02 pow 2) (v03 pow 2) (v23 pow 2) (v13 pow 2) (v12 pow 2)`] THEN
 801     REWRITE_TAC[let_RULE Sphere.dih_y; let_RULE Sphere.dih_x; GSYM REAL_POW_2] THEN
 802     ASM_REWRITE_TAC[REAL_ARITH `a - b = a + c <=> c = --b`] THEN
 803     MATCH_MP_TAC Trigonometry1.ATN2_RNEG THEN
 804     DISJ_CASES_TAC (TAUT `~(d4 = &0) \/ d4 = &0`) THEN ASM_REWRITE_TAC[] THEN
 805     MATCH_MP_TAC SQRT_POS_LT THEN
 806     MP_TAC (let_RULE (SPECL [`v01 pow 2`; `v02 pow 2`; `v03 pow 2`; `v23 pow 2`; `v13 pow 2`; `v12 pow 2`] DELTA_X_AND_DELTA_X4)) THEN
 807     ASM_REWRITE_TAC[] THEN
 808     DISCH_THEN (fun th -> REWRITE_TAC[th; REAL_ARITH `a - &0 * &0 = a`]) THEN
 809     MP_TAC (let_RULE Trigonometry2.NOT_COLLINEAR_IMP_UPS_LT) THEN
 810     ASM_REWRITE_TAC[] THEN
 811     MP_TAC (INST [`v3:real^3`,`v2:real^3`] (let_RULE Trigonometry2.NOT_COLLINEAR_IMP_UPS_LT)) THEN
 812     ASM_REWRITE_TAC[] THEN
 813     REPEAT DISCH_TAC THEN
 814     MATCH_MP_TAC REAL_LT_MUL THEN
 815     ASM_REWRITE_TAC[]);;
 816
 817 let DIHV_DIH_X = prove_by_refinement(
 818   `!(v0:real^3) v1 v2 v3.
 819     (let x01 = dist (v0,v1) pow 2 in
 820                  let x02 = dist (v0,v2) pow 2 in
 821                  let x03 = dist (v0,v3) pow 2 in
 822                  let x12 = dist (v1,v2) pow 2 in
 823                  let x13 = dist (v1,v3) pow 2 in
 824                  let x23 = dist (v2,v3) pow 2 in
 825         &0 < ups_x x01 x02 x12 /\ &0 < ups_x x01 x03 x13 ==>  ( dihV v0 v1 v2 v3 = dih_x x01 x02 x03 x23 x13 x12))
 826     `,
 827   (* {{{ proof *)
 828   [
 829   REPEAT WEAK_STRIP_TAC;
 830   MP_TAC(ISPECL [`v0:real^3`;`v1:real^3`;`v2:real^3`;`v3:real^3`] DIHV_EQ_DIH_Y);
 831   REWRITE_TAC[LET_DEF;LET_END_DEF];
 832   REPEAT WEAK_STRIP_TAC;
 833   FIRST_X_ASSUM_ST `collinear` MP_TAC;
 834   ANTS_TAC;
 835     BY(ASM_REWRITE_TAC[Collect_geom2.NOT_COL_EQ_UPS_X_POS]);
 836   DISCH_THEN SUBST1_TAC;
 837   REWRITE_TAC[Sphere.dih_y];
 838   BY(REWRITE_TAC[arith `x * x = x pow 2`;LET_DEF;LET_END_DEF])
 839   ]);;
 840   (* }}} *)
 841
 842 let sol_x_sol_euler_x = prove_by_refinement(
 843   `!x1 x2 x3 x4 x5 x6. &0 < x1 /\ &0 < ups_x x1 x2 x6 /\ &0 < ups_x x2 x3 x4 /\
 844    &0 < ups_x x1 x3 x5 /\ &0 < eulerA_x x1 x2 x3 x4 x5 x6 /\
 845     &0 < delta_x x1 x2 x3 x4 x5 x6 ==>
 846     sol_x x1 x2 x3 x4 x5 x6 = sol_euler_x x1 x2 x3 x4 x5 x6`,
 847   (* {{{ proof *)
 848   [
 849   REPEAT WEAK_STRIP_TAC;
 850   MP_TAC (ISPECL [`x1:real`;`x2:real`;`x3:real`;`x4:real`;`x5:real`;`x6:real`] simplex_exists);
 851   ASM_REWRITE_TAC[];
 852   ANTS_TAC;
 853     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
 854   REPEAT WEAK_STRIP_TAC;
 855   MP_TAC (ISPECL [`v0:real^3`;`v1:real^3`;`v2:real^3`;`v3:real^3`] Euler_main_theorem.EULER_TRIANGLE);
 856   REWRITE_TAC[Sphere.euler_p;Sphere.xlist;Sphere.ylist];
 857   REWRITE_TAC[Sphere.sol_x;Sphere.sol_euler_x];
 858   REWRITE_TAC[ LET_DEF;LET_END_DEF];
 859   REPEAT WEAK_STRIP_TAC;
 860   FIRST_X_ASSUM MP_TAC;
 861   ANTS_TAC;
 862     BY(ASM_MESON_TAC[]);
 863   REPEAT (GMATCH_SIMP_TAC (REWRITE_RULE[LET_DEF;LET_END_DEF] DIHV_DIH_X));
 864   REPEAT ( FIRST_X_ASSUM_ST `pow` ((MP_TAC o (SYM ))));
 865   REPEAT WEAK_STRIP_TAC;
 866   ASM_REWRITE_TAC[];
 867   ONCE_REWRITE_TAC[DIST_SYM];
 868   ASM_REWRITE_TAC[];
 869   REPEAT WEAK_STRIP_TAC;
 870   CONJ_TAC;
 871     BY(ASM_MESON_TAC[Collect_geom.UPS_X_SYM]);
 872   CONJ_TAC;
 873     BY(ASM_MESON_TAC[Collect_geom.UPS_X_SYM]);
 874   DISCH_THEN SUBST1_TAC;
 875   REWRITE_TAC[arith `pi - &2 * x = &2*(pi/ &2 - x)`];
 876   GMATCH_SIMP_TAC pi2_sub_atn2;
 877   REWRITE_TAC[GSYM CONJ_ASSOC];
 878   CONJ_TAC;
 879     BY(ASM_SIMP_TAC [SQRT_POS_LT]);
 880   SUBGOAL_THEN `(dist ((v1:real^3),v0) * dist (v2,v0) * dist (v3,v0) +   dist (v1,v0) * ((v2 - v0) dot (v3 - v0)) +   dist (v2,v0) * ((v3 - v0) dot (v1 - v0)) +   dist (v3,v0) * ((v1 - v0) dot (v2 - v0))) = eulerA_x x1 x2 x3 x4 x5 x6` SUBST1_TAC;
 881     REWRITE_TAC[Sphere.eulerA_x];
 882     BINOP_TAC;
 883       BY(REPEAT BINOP_TAC THEN ASM_MESON_TAC[POW_2_SQRT;DIST_POS_LE;DIST_SYM]);
 884     BINOP_TAC;
 885       BINOP_TAC;
 886         BY(ASM_MESON_TAC[POW_2_SQRT;DIST_POS_LE;DIST_SYM]);
 887       EXPAND_TAC"x2";
 888       EXPAND_TAC "x3";
 889       EXPAND_TAC "x4";
 890       REWRITE_TAC[Collect_geom.DIST_POW2_DOT];
 891       REWRITE_TAC[DOT_LSUB;DOT_RSUB];
 892       REWRITE_TAC[DOT_SYM];
 893       BY(REAL_ARITH_TAC);
 894     BINOP_TAC;
 895       BINOP_TAC;
 896         BY(ASM_MESON_TAC[POW_2_SQRT;DIST_POS_LE;DIST_SYM]);
 897       EXPAND_TAC"x1";
 898       EXPAND_TAC "x3";
 899       EXPAND_TAC "x5";
 900       REWRITE_TAC[Collect_geom.DIST_POW2_DOT];
 901       REWRITE_TAC[DOT_LSUB;DOT_RSUB;DOT_SYM];
 902       BY(REAL_ARITH_TAC);
 903     BINOP_TAC;
 904       BY(ASM_MESON_TAC[POW_2_SQRT;DIST_POS_LE;DIST_SYM]);
 905     EXPAND_TAC"x1";
 906     EXPAND_TAC "x2";
 907     EXPAND_TAC "x6";
 908     REWRITE_TAC[Collect_geom.DIST_POW2_DOT];
 909     REWRITE_TAC[DOT_LSUB;DOT_RSUB;DOT_SYM];
 910     BY(REAL_ARITH_TAC);
 911   CONJ_TAC;
 912     FIRST_X_ASSUM_ST `eulerA_x` MP_TAC;
 913     BY(REAL_ARITH_TAC);
 914   REPEAT (AP_THM_TAC ORELSE AP_TERM_TAC);
 915   REWRITE_TAC[Sphere.eulerA_x];
 916   MATCH_MP_TAC (arith `(a = a') ==> (a + b = a' + b)`);
 917   GMATCH_SIMP_TAC SQRT_MUL;
 918   GMATCH_SIMP_TAC SQRT_MUL;
 919   GMATCH_SIMP_TAC Real_ext.REAL_PROP_NN_MUL2;
 920   BY(ASM_MESON_TAC[REAL_LE_POW_2])
 921   ]);;
 922   (* }}} *)
 923
 924 let dih_x_dih_x_div_sqrtdelta_posbranch = prove_by_refinement(
 925   `!x1 x2 x3 x4 x5 x6.
 926     &0 < x1 /\ &0 < delta_x x1 x2 x3 x4 x5 x6 /\
 927   &0 < delta_x4 x1 x2 x3 x4 x5 x6 ==>
 928     dih_x x1 x2 x3 x4 x5 x6 = sqrt(delta_x x1 x2 x3 x4 x5 x6) *
 929         dih_x_div_sqrtdelta_posbranch x1 x2 x3 x4 x5 x6`,
 930   (* {{{ proof *)
 931   [
 932   REWRITE_TAC[Sphere.dih_x;Nonlin_def.dih_x_div_sqrtdelta_posbranch;LET_DEF;LET_END_DEF];
 933   REPEAT WEAK_STRIP_TAC;
 934   GMATCH_SIMP_TAC matan_pos;
 935   SUBCONJ_TAC;
 936     REWRITE_TAC[Calc_derivative.invert_den_lt;GSYM REAL_MUL_ASSOC;arith `x pow 2 = x * x`];
 937     BY(ASM_MESON_TAC[REAL_LT_MUL;arith `&0 < &4`]);
 938   DISCH_TAC;
 939   ABBREV_TAC `d = delta_x x1 x2 x3 x4 x5 x6`;
 940   ABBREV_TAC `d4 = delta_x4 x1 x2 x3 x4 x5 x6`;
 941   GMATCH_SIMP_TAC Trigonometry1.ATN2_RNEG;
 942   CONJ_TAC;
 943     DISJ1_TAC;
 944     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
 945   REWRITE_TAC[arith `x + -- y  = x - y`];
 946   GMATCH_SIMP_TAC pi2_sub_atn2;
 947   ASM_REWRITE_TAC[];
 948   CONJ_TAC;
 949     MATCH_MP_TAC SQRT_POS_LT;
 950     BY(ASM_MESON_TAC[REAL_LT_MUL;arith `&0 < &4`]);
 951   GMATCH_SIMP_TAC (MESON[Trigonometry1.ATN2_BREAKDOWN] `&0 < x ==> (atn2(x,y) = atn(y/x))`);
 952   ASM_REWRITE_TAC[];
 953   SUBGOAL_THEN `sqrt((&4 * x1 * d) / d4 pow 2) = sqrt(&4 * x1 * d)/d4` SUBST1_TAC;
 954     BY(ASM_MESON_TAC[Trigonometry1.SQRT_DIV_R;REAL_LT_MUL;arith `&0 < x ==> &0 <= x`;arith `&0 < &4`]);
 955   REWRITE_TAC[arith `a * b /c * e/f = e * ((a * b/c)/f)`];
 956   MATCH_MP_TAC (arith `x  = &1 ==> u = u * x`);
 957   GMATCH_SIMP_TAC REAL_EQ_LDIV_EQ;
 958   REWRITE_TAC[arith `&4 * x1 * d = d * (&4 * x1)`];
 959   GMATCH_SIMP_TAC SQRT_MUL;
 960   REWRITE_TAC[Calc_derivative.invert_den_lt];
 961   REPEAT CONJ_TAC;
 962         BY(ASM_MESON_TAC[arith `&0 < d ==> &0 <= d`]);
 963       BY(ASM_MESON_TAC[REAL_LT_MUL;arith `&0 < &4`;arith `&0 < d ==> &0 <= d`]);
 964     GMATCH_SIMP_TAC SQRT_MUL;
 965     BY(ASM_MESON_TAC[REAL_LT_MUL;arith `&0 < &4`;arith `&0 < d ==> &0 <= d`;SQRT_POS_LT]);
 966   BY(REAL_ARITH_TAC)
 967   ]);;
 968   (* }}} *)
 969
 970 let dih_x_dih_x_div_sqrtdelta_negbranch = prove_by_refinement(
 971   `!x1 x2 x3 x4 x5 x6.
 972     &0 < x1 /\ &0 < delta_x x1 x2 x3 x4 x5 x6 /\
 973   delta_x4 x1 x2 x3 x4 x5 x6 < &0 ==>
 974     dih_x x1 x2 x3 x4 x5 x6 = pi + sqrt(delta_x x1 x2 x3 x4 x5 x6) *
 975         dih_x_div_sqrtdelta_posbranch x1 x2 x3 x4 x5 x6`,
 976   (* {{{ proof *)
 977   [
 978   REWRITE_TAC[Sphere.dih_x;Nonlin_def.dih_x_div_sqrtdelta_posbranch;LET_DEF;LET_END_DEF;arith `x < &0 <=> &0 < -- x`];
 979   REPEAT WEAK_STRIP_TAC;
 980   GMATCH_SIMP_TAC matan_pos;
 981   SUBCONJ_TAC;
 982     REWRITE_TAC[Calc_derivative.invert_den_lt;GSYM REAL_MUL_ASSOC;arith `x pow 2 = (--x) * (-- x)`];
 983     BY(BY(ASM_MESON_TAC[REAL_LT_MUL;arith `&0 < &4`;arith `x < &0 <=> &0 < -- x`]));
 984   DISCH_TAC;
 985   ABBREV_TAC `d = delta_x x1 x2 x3 x4 x5 x6`;
 986   ONCE_REWRITE_TAC[arith `x pow 2 = (--x) pow 2`];
 987   ONCE_REWRITE_TAC[arith `a * sqrt u / v * r = a * sqrt u /(-- (-- v)) * r`];
 988   ABBREV_TAC `d4 = -- delta_x4 x1 x2 x3 x4 x5 x6`;
 989   REWRITE_TAC[arith `pi / &2 + x = pi + u <=> -- u = pi/ &2 - x`];
 990   GMATCH_SIMP_TAC pi2_sub_atn2;
 991   ASM_REWRITE_TAC[];
 992   CONJ_TAC;
 993     BY(BY(ASM_MESON_TAC[REAL_LT_MUL;SQRT_POS_LT;arith `x < &0 <=> &0 < -- x`;arith `&0 < &4`]));
 994   GMATCH_SIMP_TAC (MESON[Trigonometry1.ATN2_BREAKDOWN] `&0 < x ==> (atn2(x,y) = atn(y/x))`);
 995   ASM_REWRITE_TAC[];
 996   SUBGOAL_THEN `sqrt((&4 * x1 * d) / d4 pow 2) = sqrt(&4 * x1 * d)/d4` SUBST1_TAC;
 997     BY(BY(ASM_MESON_TAC[Trigonometry1.SQRT_DIV_R;REAL_LT_MUL;arith `&0 < x ==> &0 <= x`;arith `&0 < &4`]));
 998   REWRITE_TAC[arith `--(a * b /c * e/f) = e * ((a * (--b)/c)/f)`];
 999   MATCH_MP_TAC (arith `x  = &1 ==>  u * x = u`);
1000   GMATCH_SIMP_TAC REAL_EQ_LDIV_EQ;
1001   REWRITE_TAC[arith `&4 * x1 * d = d * (&4 * x1)`];
1002   GMATCH_SIMP_TAC SQRT_MUL;
1003   REWRITE_TAC[Calc_derivative.invert_den_lt];
1004   REPEAT CONJ_TAC;
1005         BY(BY(ASM_MESON_TAC[arith `&0 < d ==> &0 <= d`]));
1006       BY(BY(ASM_MESON_TAC[REAL_LT_MUL;arith `&0 < &4`;arith `&0 < d ==> &0 <= d`]));
1007     GMATCH_SIMP_TAC SQRT_MUL;
1008     BY(BY(ASM_MESON_TAC[REAL_LT_MUL;arith `&0 < &4`;arith `&0 < d ==> &0 <= d`;SQRT_POS_LT]));
1009   CALC_ID_TAC;
1010   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
1011   ]);;
1012   (* }}} *)
1013
1014 let tau_x_tau_residual_x = prove_by_refinement(
1015   `!x1 x2 x3 x4 x5 x6.
1016     sqrt(x1) = &2 * h0 /\
1017     &0 < x1 /\ &0 < x2 /\ &0 < x3 /\ &0 < x4 /\ &0 < x5 /\  &0 < x6 /\
1018     delta_x4 x1 x2 x3 x4 x5 x6 < &0 /\
1019     &0 < delta_x4 x2 x3 x1 x5 x6 x4  /\
1020     &0 < delta_x4 x3 x1 x2 x6 x4 x5  /\
1021     &0 <= delta_x x1 x2 x3 x4 x5 x6 ==>
1022     taum_x x1 x2 x3 x4 x5 x6 = sqrt(delta_x x1 x2 x3 x4 x5 x6) *
1023         tau_residual_x x1 x2 x3 x4 x5 x6`,
1024   (* {{{ proof *)
1025   [
1026   REPEAT WEAK_STRIP_TAC;
1027   FIRST_X_ASSUM MP_TAC;
1028   REWRITE_TAC[arith `&0 <= x <=> (&0 = x \/ &0 < x)`];
1029   DISCH_THEN DISJ_CASES_TAC;
1030     REWRITE_TAC[Sphere.taum_x;Sphere.rhazim_x;Sphere.rhazim2_x;Sphere.rhazim3_x;Sphere.rhazim;Sphere.rhazim2;Sphere.rhazim3;Sphere.node2_y;Sphere.node3_y;Sphere.dih_y;LET_DEF;LET_END_DEF;Sphere.dih_x];
1031     ASM_SIMP_TAC[arith `x * x = x pow 2`;SQRT_POW_2;arith `&0 < x ==> &0 <= x`];
1032     SUBGOAL_THEN `delta_x x2 x3 x1 x5 x6 x4 = &0` SUBST1_TAC;
1033       BY(FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[Sphere.delta_x] THEN REAL_ARITH_TAC);
1034     SUBGOAL_THEN `delta_x x3 x1 x2 x6 x4 x5 = &0` SUBST1_TAC;
1035       BY(FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[Sphere.delta_x] THEN REAL_ARITH_TAC);
1036     FIRST_X_ASSUM (SUBST1_TAC o (GSYM));
1037     REWRITE_TAC[arith `x * &0 = &0`;arith `&0 * x = &0`;SQRT_0];
1038     ASM_SIMP_TAC[atn2_0;arith `(-- y < &0 <=> &0 < y) /\ ( &0 < -- y <=> y < &0)`];
1039     REWRITE_TAC[Sphere.h0;Nonlinear_lemma.rho_alt;arith `pi/ &2 + pi/ &2 = pi /\ x + -- x = &0 /\ x * &0 = &0`];
1040     BY(REAL_ARITH_TAC);
1041   REWRITE_TAC[Sphere.taum_x;Sphere.rhazim_x;Sphere.rhazim2_x;Sphere.rhazim3_x;Sphere.rhazim;Sphere.rhazim2;Sphere.rhazim3;Sphere.node2_y;Sphere.node3_y;Sphere.dih_y;LET_DEF;LET_END_DEF];
1042   ASM_SIMP_TAC[arith `x * x = x pow 2`;SQRT_POW_2;arith `&0 < x ==> &0 <= x`];
1043   REWRITE_TAC[Nonlin_def.tau_residual_x];
1044   REWRITE_TAC[Nonlin_def.tau_residual_x;Nonlin_def.rhazim_x_div_sqrtdelta_posbranch;Nonlin_def.rhazim2_x_div_sqrtdelta_posbranch;Nonlin_def.rhazim3_x_div_sqrtdelta_posbranch;Sphere.rotate2;Sphere.rotate3];
1045   ASM_REWRITE_TAC[];
1046   REWRITE_TAC[arith `a + b + c - d = (a - d) + b + c`];
1047   REWRITE_TAC[arith `a * (b + c) = a * b + a * c`];
1048   BINOP_TAC;
1049     ASM_SIMP_TAC[dih_x_dih_x_div_sqrtdelta_negbranch];
1050     REWRITE_TAC[Sphere.h0;Nonlinear_lemma.rho_alt;];
1051     BY(REAL_ARITH_TAC);
1052   BINOP_TAC;
1053     ONCE_REWRITE_TAC[arith `a * b * c = b * (a * c)`];
1054     AP_TERM_TAC;
1055     GMATCH_SIMP_TAC dih_x_dih_x_div_sqrtdelta_posbranch;
1056     ASM_REWRITE_TAC[];
1057     SUBGOAL_THEN `delta_x x2 x3 x1 x5 x6 x4 = delta_x x1 x2 x3 x4 x5 x6` SUBST1_TAC;
1058       BY(REWRITE_TAC[Sphere.delta_x] THEN REAL_ARITH_TAC);
1059     BY(ASM_REWRITE_TAC[]);
1060   ONCE_REWRITE_TAC[arith `a * b * c = b * (a * c)`];
1061   AP_TERM_TAC;
1062   GMATCH_SIMP_TAC dih_x_dih_x_div_sqrtdelta_posbranch;
1063   ASM_REWRITE_TAC[];
1064   SUBGOAL_THEN `delta_x x3 x1 x2 x6 x4 x5 = delta_x x1 x2 x3 x4 x5 x6` SUBST1_TAC;
1065     BY(REWRITE_TAC[Sphere.delta_x] THEN REAL_ARITH_TAC);
1066   BY(ASM_REWRITE_TAC[])
1067   ]);;
1068   (* }}} *)
1069
1070 let sol_x_sol_x_sqrtdelta = prove_by_refinement(
1071   `!x1 x2 x3 x4 x5 x6.  &0 < x1 /\ &0 < x2 /\ &0 < x3 /\
1072    (&0 < eulerA_x x1 x2 x3 x4 x5 x6) /\ (&0 <= delta_x x1 x2 x3 x4 x5 x6 ) ==>
1073     sol_euler_x x1 x2 x3 x4 x5 x6 = sqrt(delta_x x1 x2 x3 x4 x5 x6) *
1074       sol_euler_x_div_sqrtdelta x1 x2 x3 x4 x5 x6`,
1075   (* {{{ proof *)
1076   [
1077   REWRITE_TAC[Sphere.sol_euler_x;Nonlin_def.sol_euler_x_div_sqrtdelta];
1078   REPEAT WEAK_STRIP_TAC;
1079   FIRST_X_ASSUM (DISJ_CASES_TAC o (REWRITE_RULE[arith `&0 <= x <=> x = &0 \/ &0 < x`]));
1080     ASM_REWRITE_TAC[arith `&0 / x  = &0`;SQRT_0];
1081     LET_TAC;
1082     REWRITE_TAC[LET_DEF;LET_END_DEF];
1083     REWRITE_TAC[arith `&0 * x = &0 /\ (&2 * x = &0 <=> x = &0)`];
1084     GMATCH_SIMP_TAC (MESON [Trigonometry1.ATN2_BREAKDOWN] `&0 < x ==> atn2 (x,&0) = atn(&0/x)`);
1085     REWRITE_TAC[arith `&0 / x = &0`;ATN_0;arith `&0 < &2 * a <=> &0 < a`];
1086     SUBGOAL_THEN `a = eulerA_x x1 x2 x3 x4 x5 x6` SUBST1_TAC;
1087       EXPAND_TAC "a";
1088       REWRITE_TAC[Sphere.eulerA_x];
1089       REPEAT (GMATCH_SIMP_TAC SQRT_MUL);
1090       BY(ASM_SIMP_TAC[arith `&0 < x ==> &0 <= x`;Real_ext.REAL_PROP_NN_MUL2]);
1091     BY(ASM_REWRITE_TAC[]);
1092   LET_TAC;
1093   REWRITE_TAC[LET_DEF;LET_END_DEF];
1094   SUBGOAL_THEN `a = eulerA_x x1 x2 x3 x4 x5 x6` ASSUME_TAC;
1095     EXPAND_TAC "a";
1096     REWRITE_TAC[Sphere.eulerA_x];
1097     REPEAT (GMATCH_SIMP_TAC SQRT_MUL);
1098     BY(ASM_SIMP_TAC[arith `&0 < x ==> &0 <= x`;Real_ext.REAL_PROP_NN_MUL2]);
1099   ASM_REWRITE_TAC[];
1100   GMATCH_SIMP_TAC matan_pos;
1101   REWRITE_TAC[Calc_derivative.invert_den_lt];
1102   CONJ_TAC;
1103     REWRITE_TAC[arith `x pow 2 = x* x`];
1104     BY(BY(ASM_MESON_TAC[REAL_LT_MUL;arith `&0 < &4`]));
1105   REWRITE_TAC[arith `&4 * x pow 2 = (&2 * x ) pow 2`];
1106   GMATCH_SIMP_TAC (MESON[Trigonometry1.SQRT_DIV_R] `&0 <= x /\ &0 <= y ==> sqrt(x / y pow 2) = sqrt x / y`);
1107   GMATCH_SIMP_TAC (MESON [Trigonometry1.ATN2_BREAKDOWN] `&0 < x ==> atn2 (x,y) = atn(y/x)`);
1108   ASM_SIMP_TAC[arith `&0 < x ==> &0 <= x`;Real_ext.REAL_PROP_NN_MUL2;arith `&0 < &2`;REAL_LT_MUL];
1109   MATCH_MP_TAC (arith `&2 = a / y / z ==> &2 * x = a * x / y / z`);
1110   CALC_ID_TAC;
1111   GMATCH_SIMP_TAC SQRT_EQ_0;
1112   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
1113   ]);;
1114   (* }}} *)
1115
1116
1117 let sol_y_sol_x = prove_by_refinement(
1118   `!y1 y2 y3 y4 y5 y6. sol_y y1 y2 y3 y4 y5 y6 = sol_x (y1*y1) (y2*y2) (y3*y3) (y4*y4) (y5 * y5) (y6 * y6)`,
1119   (* {{{ proof *)
1120   [
1121   BY(REWRITE_TAC[Sphere.sol_y;Sphere.sol_x;Sphere.dih_y;LET_DEF;LET_END_DEF]);
1122   ]);;
1123   (* }}} *)
1124
1125 let sol_x_sym = prove_by_refinement(
1126   `!x1 x2 x3 x4 x5 x6. sol_x x1 x2 x3 x4 x5 x6 = sol_x x1 x3 x2 x4 x6 x5`,
1127   (* {{{ proof *)
1128   [
1129   REWRITE_TAC[Sphere.sol_x];
1130   REPEAT STRIP_TAC;
1131   MATCH_MP_TAC (arith `(a=a')/\(b=b')/\(c=c')==>((a + b + c - pi) = (a' + c'+b'-pi)) `);
1132   BY(MESON_TAC[Nonlinear_lemma.dih_x_sym;Nonlinear_lemma.dih_x_sym2])
1133   ]);;
1134   (* }}} *)
1135
1136 let sol_x_sym2 = prove_by_refinement(
1137   `!x1 x2 x3 x4 x5 x6. sol_x x1 x2 x3 x4 x5 x6 = sol_x x2 x3 x1 x5 x6 x4`,
1138   (* {{{ proof *)
1139   [
1140   REWRITE_TAC[Sphere.sol_x];
1141   REPEAT STRIP_TAC;
1142   MATCH_MP_TAC (arith `(a=a')/\(b=b')/\(c=c')==>((a + b + c - pi) = (b' + c'+a'-pi)) `);
1143   BY(BY(MESON_TAC[Nonlinear_lemma.dih_x_sym;Nonlinear_lemma.dih_x_sym2]))
1144   ]);;
1145   (* }}} *)
1146
1147 let delta_x_sym = prove_by_refinement(
1148   `!x1 x2 x3 x4 x5 x6. delta_x x1 x2 x3 x4 x5 x6 = delta_x x2 x1 x3 x5 x4 x6`,
1149   (* {{{ proof *)
1150   [
1151   REWRITE_TAC[Sphere.delta_x];
1152   BY(REAL_ARITH_TAC);
1153   ]);;
1154   (* }}} *)
1155
1156 let delta_x_sym2 = prove_by_refinement(
1157   `!x1 x2 x3 x4 x5 x6. delta_x x1 x2 x3 x4 x5 x6 = delta_x x2 x3 x1 x5 x6 x4`,
1158   (* {{{ proof *)
1159   [
1160   REWRITE_TAC[Sphere.delta_x];
1161   BY(REAL_ARITH_TAC);
1162   ]);;
1163   (* }}} *)
1164
1165 let sol_x_sol_y = prove_by_refinement(
1166   `sol_y = y_of_x sol_x`,
1167   (* {{{ proof *)
1168   [
1169   REWRITE_TAC[FUN_EQ_THM];
1170   BY(REWRITE_TAC[Sphere.sol_y;Sphere.y_of_x;Sphere.sol_x;Sphere.dih_y;LET_DEF;LET_END_DEF])
1171   ]);;
1172   (* }}} *)
1173
1174 let gamma4fgcy_div_sqrtdelta = prove_by_refinement(
1175   `!x1 x2 x3 x4 x5 x6.
1176     &0 < x1 /\ &0 < x2 /\ &0 < x3 /\ &0 < x4 /\ &0 < x5 /\ &0 < x6 /\
1177     &2 * h0 <= sqrt x1 /\ &2 * h0 <= sqrt x4 /\
1178     sqrt x2 <= &2 * h0 /\ sqrt x3 <= &2 * h0 /\ sqrt x5 <= &2 * h0 /\
1179     sqrt x6 <= &2 * h0 /\
1180     &0 < ups_x x1 x2 x6 /\ &0 < ups_x x2 x3 x4 /\ &0 < ups_x x1 x3 x5 /\
1181     &0 < ups_x x4 x5 x6 /\
1182     &0 < eulerA_x x1 x2 x3 x4 x5 x6 /\
1183     &0 < eulerA_x x4 x2 x6 x1 x5 x3 /\
1184     &0 < eulerA_x x5 x3 x4 x2 x6 x1 /\
1185     &0 < eulerA_x x6 x1 x5 x3 x4 x2 /\
1186   &0 < delta_x4 x5 x3 x4 x2 x6 x1 /\
1187   &0 < delta_x4 x3 x1 x2 x6 x4 x5 /\
1188   &0 < delta_x4 x2 x3 x1 x5 x6 x4 /\
1189   &0 < delta_x4 x6 x1 x5 x3 x4 x2 /\
1190     &0 < delta_x x1 x2 x3 x4 x5 x6 ==>
1191     (gamma4fgcy (sqrt x1) (sqrt x2) (sqrt x3) (sqrt x4)
1192     (sqrt x5) (sqrt x6) lmfun =
1193     sqrt(delta_x x1 x2 x3 x4 x5 x6) * (&1 / &12 -
1194                 (
1195                   (&2 * mm1 / pi) *
1196                     (sol_euler_x_div_sqrtdelta x1 x2 x3 x4 x5 x6 +
1197                        sol_euler345_x_div_sqrtdelta x1 x2 x3 x4 x5 x6 +
1198                        sol_euler156_x_div_sqrtdelta x1 x2 x3 x4 x5 x6 +
1199                        sol_euler246_x_div_sqrtdelta x1 x2 x3 x4 x5 x6) -
1200                     (&8 * mm2 / pi) * (
1201                       ldih2_x_div_sqrtdelta_posbranch x1 x2 x3 x4 x5 x6 +
1202                       ldih3_x_div_sqrtdelta_posbranch x1 x2 x3 x4 x5 x6 +
1203                       ldih5_x_div_sqrtdelta_posbranch x1 x2 x3 x4 x5 x6 +
1204                       ldih6_x_div_sqrtdelta_posbranch x1 x2 x3 x4 x5 x6
1205                     )
1206                 )))`,
1207   (* {{{ proof *)
1208   [
1209   REPEAT WEAK_STRIP_TAC;
1210   REWRITE_TAC[Sphere.gamma4fgcy;Sphere.gamma4f;Sphere.vol_y;Sphere.vol4f;Sphere.y_of_x;sol_x_sol_y;Sphere.dih_y;LET_DEF;LET_END_DEF];
1211   ASM_SIMP_TAC[arith `x * x = x pow 2`;SQRT_POW_2;arith `&0 < x ==> &0 <= x`];
1212   REWRITE_TAC[Nonlin_def.sol_euler345_x_div_sqrtdelta;Nonlin_def.sol_euler156_x_div_sqrtdelta;Nonlin_def.sol_euler246_x_div_sqrtdelta;Nonlin_def.ldih2_x_div_sqrtdelta_posbranch;Nonlin_def.ldih3_x_div_sqrtdelta_posbranch;Nonlin_def.ldih5_x_div_sqrtdelta_posbranch;Nonlin_def.ldih6_x_div_sqrtdelta_posbranch;Sphere.rotate2;Sphere.rotate3;Sphere.rotate5;Sphere.rotate6;Sphere.rotate4;Nonlin_def.ldih_x_div_sqrtdelta_posbranch];
1213   ASM_SIMP_TAC[Nonlinear_lemma.lmfun_lfun];
1214   ASM_SIMP_TAC[Nonlinear_lemma.lmfun0;arith `&0 * x = &0 /\ &0 + x = x`];
1215   REWRITE_TAC[arith `sqrt x * (u - v) = sqrt x * u - sqrt x * v /\ sqrt x * (u+ v) = sqrt x * u + sqrt x * v`];
1216   BINOP_TAC;
1217     REWRITE_TAC[Sphere.vol_x];
1218     BY(REAL_ARITH_TAC);
1219   BINOP_TAC;
1220     REWRITE_TAC[arith `sqrt x * y * z = y * sqrt x * z`];
1221     AP_TERM_TAC;
1222     SUBGOAL_THEN `sol_x x1 x5 x6 x4 x2 x3 = sol_x x6 x1 x5 x3 x4 x2 /\ sol_x x4 x5 x3 x1 x2 x6 = sol_x x5 x3 x4 x2 x6 x1 /\ sol_x x4 x2 x6 x1 x5 x3 = sol_x x4 x2 x6 x1 x5 x3` (unlist REWRITE_TAC);
1223       BY(MESON_TAC[sol_x_sym;sol_x_sym2]);
1224     REPEAT (GMATCH_SIMP_TAC sol_x_sol_euler_x);
1225     ASM_REWRITE_TAC[];
1226     REWRITE_TAC[ CONJ_ASSOC];
1227     MATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`);
1228     CONJ_TAC;
1229       REWRITE_TAC[arith `x * ( y + z) = x * y + x* z`];
1230       MATCH_MP_TAC (arith ` (a = a' /\ b = c' /\ c = b' /\ d = d')==>(a + b + c + d = a' + b' + c' + d')`);
1231       REPEAT (GMATCH_SIMP_TAC sol_x_sol_x_sqrtdelta);
1232       ASM_REWRITE_TAC[];
1233       REWRITE_TAC[GSYM CONJ_ASSOC];
1234       BY(REPEAT CONJ_TAC THEN REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC) THEN (REPEAT (FIRST_X_ASSUM MP_TAC)) THEN REWRITE_TAC[Sphere.delta_x;Sphere.eulerA_x] THEN REAL_ARITH_TAC);
1235     BY(REWRITE_TAC[GSYM CONJ_ASSOC] THEN REPEAT CONJ_TAC THEN (REPEAT (FIRST_X_ASSUM MP_TAC)) THEN REWRITE_TAC[Sphere.delta_x;Sphere.ups_x] THEN REAL_ARITH_TAC);
1236   REWRITE_TAC[arith `sqrt x * y * z = y * sqrt x * z`];
1237   AP_TERM_TAC;
1238   SUBGOAL_THEN `dih_x x5 x1 x6 x2 x4 x3 = dih_x x5 x3 x4 x2 x6 x1` SUBST1_TAC;
1239     BY(MESON_TAC[Nonlinear_lemma.dih_x_sym;Nonlinear_lemma.dih_x_sym2]);
1240   REWRITE_TAC[arith `a * (b + c) = a* b + a*c`];
1241   MATCH_MP_TAC (arith `a = a' /\ b = b' /\ c = c' /\ d = d' ==> a + b + c +d  = a' + b' + c' + d'`);
1242   REWRITE_TAC[arith `sqrt x * y * z = y * sqrt x * z`];
1243   REPEAT (GMATCH_SIMP_TAC (dih_x_dih_x_div_sqrtdelta_posbranch));
1244   ASM_REWRITE_TAC[];
1245   BY(REPEAT CONJ_TAC THEN REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC) THEN (REPEAT (FIRST_X_ASSUM MP_TAC)) THEN REWRITE_TAC[Sphere.delta_x] THEN TRY REAL_ARITH_TAC)
1246   ]);;
1247   (* }}} *)
1248
1249 let gamma4fgcy_sym12 = prove_by_refinement(
1250   `!y1 y2 y3 y4 y5 y6 f. gamma4fgcy y1 y2 y3 y4 y5 y6 f = gamma4fgcy y2 y1 y3 y5 y4 y6 f`,
1251   (* {{{ proof *)
1252   [
1253   REWRITE_TAC[Sphere.gamma4fgcy;Sphere.gamma4f;Sphere.vol_y;Sphere.vol4f];
1254   REPEAT WEAK_STRIP_TAC;
1255   BINOP_TAC;
1256     REWRITE_TAC[Sphere.y_of_x;Sphere.vol_x];
1257     REPLICATE_TAC 3 (AP_TERM_TAC ORELSE AP_THM_TAC);
1258     REWRITE_TAC[Sphere.delta_x];
1259     BY(REAL_ARITH_TAC);
1260   BINOP_TAC;
1261     AP_TERM_TAC;
1262     MATCH_MP_TAC (arith `a = a' /\ b = d' /\ c = c' /\ d = b' ==> a+b+c+d = a'+b' + c' + d'`);
1263     REWRITE_TAC[sol_x_sol_y;Sphere.y_of_x];
1264     BY(MESON_TAC[sol_x_sym;sol_x_sym2]);
1265   AP_TERM_TAC;
1266   MATCH_MP_TAC (arith `a = b' /\ b = a' /\ c = c' /\ d = e' /\ e = d' /\ f = f' ==> (a+b+c+d+e+f = a'+b'+c'+d'+e'+f')`);
1267   REWRITE_TAC[Sphere.dih_y];
1268   REWRITE_TAC[Sphere.dih_y;LET_DEF;LET_END_DEF];
1269   BY(ASM_MESON_TAC[Nonlinear_lemma.dih_x_sym;Nonlinear_lemma.dih_x_sym2])
1270   ]);;
1271   (* }}} *)
1272
1273 let gamma4fgcy_sym23 = prove_by_refinement(
1274   `!y1 y2 y3 y4 y5 y6 f. gamma4fgcy y1 y2 y3 y4 y5 y6 f = gamma4fgcy y1 y3 y2 y4 y6 y5 f`,
1275   (* {{{ proof *)
1276   [
1277   REWRITE_TAC[Sphere.gamma4fgcy;Sphere.gamma4f;Sphere.vol_y;Sphere.vol4f];
1278   REPEAT WEAK_STRIP_TAC;
1279   BINOP_TAC;
1280     REWRITE_TAC[Sphere.y_of_x;Sphere.vol_x];
1281     REPLICATE_TAC 3 (AP_TERM_TAC ORELSE AP_THM_TAC);
1282     REWRITE_TAC[Sphere.delta_x];
1283     BY(BY(REAL_ARITH_TAC));
1284   BINOP_TAC;
1285     AP_TERM_TAC;
1286     MATCH_MP_TAC (arith `a = a' /\ b = b' /\ c = d' /\ d = c' ==> a+b+c+d = a'+b' + c' + d'`);
1287     REWRITE_TAC[sol_x_sol_y;Sphere.y_of_x];
1288     BY(BY(MESON_TAC[sol_x_sym;sol_x_sym2]));
1289   AP_TERM_TAC;
1290   MATCH_MP_TAC (arith `a = a' /\ b = c' /\ c = b' /\ d = d' /\ e = f' /\ f = e' ==> (a+b+c+d+e+f = a'+b'+c'+d'+e'+f')`);
1291   REWRITE_TAC[Sphere.dih_y];
1292   REWRITE_TAC[Sphere.dih_y;LET_DEF;LET_END_DEF];
1293   BY(BY(ASM_MESON_TAC[Nonlinear_lemma.dih_x_sym;Nonlinear_lemma.dih_x_sym2]))
1294   ]);;
1295   (* }}} *)
1296
1297 let gamma4fgcy_sym03 = prove_by_refinement(
1298   `!y1 y2 y3 y4 y5 y6 f. gamma4fgcy y1 y2 y3 y4 y5 y6 f = gamma4fgcy y5 y4 y3 y2 y1 y6 f`,
1299   (* {{{ proof *)
1300   [
1301   REWRITE_TAC[Sphere.gamma4fgcy;Sphere.gamma4f;Sphere.vol_y;Sphere.vol4f];
1302   REPEAT WEAK_STRIP_TAC;
1303   BINOP_TAC;
1304     REWRITE_TAC[Sphere.y_of_x;Sphere.vol_x];
1305     REPLICATE_TAC 3 (AP_TERM_TAC ORELSE AP_THM_TAC);
1306     REWRITE_TAC[Sphere.delta_x];
1307     BY(BY(BY(REAL_ARITH_TAC)));
1308   BINOP_TAC;
1309     AP_TERM_TAC;
1310     MATCH_MP_TAC (arith `a = c' /\ b = b' /\ c = a' /\ d = d' ==> a+b+c+d = a'+b' + c' + d'`);
1311     REWRITE_TAC[sol_x_sol_y;Sphere.y_of_x];
1312     BY(BY(BY(MESON_TAC[sol_x_sym;sol_x_sym2])));
1313   AP_TERM_TAC;
1314   MATCH_MP_TAC (arith `a = e' /\ b = d' /\ c = c' /\ d = b' /\ e = a' /\ f = f' ==> (a+b+c+d+e+f = a'+b'+c'+d'+e'+f')`);
1315   REWRITE_TAC[Sphere.dih_y];
1316   REWRITE_TAC[Sphere.dih_y;LET_DEF;LET_END_DEF];
1317   BY(BY(BY(ASM_MESON_TAC[Nonlinear_lemma.dih_x_sym;Nonlinear_lemma.dih_x_sym2])))
1318   ]);;
1319   (* }}} *)
1320
1321 (*
1322 let rho_ij'_rho_x = prove_by_refinement(
1323   `!x1 x2 x3 x4 x5 x6. rho_ij' x1 x2 x3 x6 x5 x4 = rho_x x1 x2 x3 x4 x5 x6`,
1324   (* {{{ proof *)
1325   [
1326   REWRITE_TAC[Sphere.rho_x;Collect_geom.rho_ij'];
1327   BY(REAL_ARITH_TAC)
1328   ]);;
1329   (* }}} *)
1330 *)
1331
1332 let delta_delta_x = prove_by_refinement(
1333   `delta x1 x2 x3 x6 x5 x4 = delta_x x1 x2 x3 x4 x5 x6 `,
1334   (* {{{ proof *)
1335   [
1336   REWRITE_TAC[Collect_geom.delta;Sphere.delta_x];
1337   BY(REAL_ARITH_TAC)
1338   ]);;
1339   (* }}} *)
1340
1341 let GDRQXLGv2 = prove_by_refinement(
1342   `!(v0:real^3)  v1 v2 v3.  let s = {v0, v1, v2, v3} in
1343          let x1 = dist (v0,v1) pow 2 in
1344          let x2 = dist (v0,v2) pow 2 in
1345          let x3 = dist (v0,v3) pow 2 in
1346          let x4 = dist (v2,v3) pow 2 in
1347          let x5 = dist (v1,v3) pow 2 in
1348          let x6 = dist (v1,v2) pow 2 in
1349          CARD s = 4 /\ ~coplanar_alt s
1350          ==> (radV s) pow 2 = rad2_x x1 x2 x3 x4 x5 x6 `,
1351   (* {{{ proof *)
1352   [
1353   REWRITE_TAC[LET_DEF;LET_END_DEF;Sphere.rad2_x];
1354   REPEAT WEAK_STRIP_TAC;
1355   SUBGOAL_THEN `&0 <= rho_x (dist ((v0:real^3),(v1:real^3)) pow 2) (dist (v0,(v2:real^3)) pow 2) (dist (v0,(v3:real^3)) pow 2)  (dist (v2,v3) pow 2) (dist (v1,v3) pow 2) (dist (v1,v2) pow 2)` ASSUME_TAC;
1356     REWRITE_TAC[GSYM Collect_geom.rho_ij'_rho_x];
1357     MATCH_MP_TAC (REWRITE_RULE[LET_DEF;LET_END_DEF] Collect_geom2.SHOGYBS);
1358     BY(ASM_REWRITE_TAC[]);
1359   SUBGOAL_THEN `&0 < delta_x (dist ((v0:real^3),(v1:real^3)) pow 2) (dist (v0,(v2:real^3)) pow 2) (dist (v0,(v3:real^3)) pow 2)  (dist (v2,v3) pow 2) (dist (v1,v3) pow 2) (dist (v1,v2) pow 2)` ASSUME_TAC;
1360     REWRITE_TAC[GSYM delta_delta_x];
1361     BY(ASM_REWRITE_TAC[ Collect_geom2.POS_EQ_NOT_COPLANANR]);
1362   GMATCH_SIMP_TAC (REWRITE_RULE[LET_DEF;LET_END_DEF] Collect_geom2.GDRQXLG);
1363   ASM_REWRITE_TAC[];
1364   REWRITE_TAC[Collect_geom.rho_ij'_rho_x;delta_delta_x];
1365   ABBREV_TAC `r = rho_x (dist ((v0:real^3),(v1:real^3)) pow 2) (dist (v0,(v2:real^3)) pow 2) (dist (v0,(v3:real^3)) pow 2)    (dist (v2,v3) pow 2)   (dist (v1,v3) pow 2)  (dist (v1,v2) pow 2)`;
1366   ABBREV_TAC `d = delta_x  (dist ((v0:real^3),(v1:real^3)) pow 2) (dist (v0,(v2:real^3)) pow 2) (dist (v0,(v3:real^3)) pow 2)    (dist (v2,v3) pow 2)   (dist (v1,v3) pow 2)  (dist (v1,v2) pow 2)`;
1367   REWRITE_TAC[Trigonometry2.DIV_POW2];
1368   CALC_ID_TAC;
1369   REWRITE_TAC[GSYM CONJ_ASSOC];
1370   GMATCH_SIMP_TAC SQRT_EQ_0;
1371   REWRITE_TAC[Trigonometry2.MUL_POW2];
1372   REPEAT (GMATCH_SIMP_TAC SQRT_POW_2);
1373   REPEAT (FIRST_X_ASSUM MP_TAC);
1374   BY(REAL_ARITH_TAC)
1375   ]);;
1376   (* }}} *)
1377
1378 (* need to fix order for future compatibility of proofs
1379 let tsk_hyp =
1380   let  tsk_nonlinear = map (fun t -> t.ineq) (Ineq.getprefix "TSK") in
1381     end_itlist (curry mk_conj) tsk_nonlinear;;
1382 *)
1383
1384 let tsk_hyp =
1385   let tsks= ["TSKAJXY-GXSABWC DIV"; "TSKAJXY-IYOUOBF sharp v2";
1386              "TSKAJXY-IYOUOBF sym";
1387    "TSKAJXY-RIBCYXU sharp"; "TSKAJXY-RIBCYXU sym"; "TSKAJXY-TADIAMB";
1388    "TSKAJXY-WKGUESB sym"; "TSKAJXY-XLLIPLS"; "TSKAJXY-delta_x4";
1389    "TSKAJXY-eulerA"] in
1390   let tsk_nonlinear = map (fun t -> (hd(Ineq.getexact t)).ineq) tsks in
1391     end_itlist (curry mk_conj) tsk_nonlinear;;
1392
1393 let tsk =
1394   let tsk_concl = Ineq.TSKAJXY_DERIVED.ineq in
1395     mk_imp(tsk_hyp,tsk_concl);;
1396
1397 let tsk_lemma1 = prove_by_refinement(
1398   (mk_imp(tsk_hyp,`!y1 y2 y3 y4 y5 y6.
1399                     ineq [#2.8,y1,sqrt8;
1400                           &2,y2,#2.01;
1401                           &2,y3,#2.01;
1402                           #2.8,y4,sqrt8;
1403                           &2,y5,#2.01;
1404                           &2,y6,#2.01]
1405                     (&0 <  delta_y y1 y2 y3 y4 y5 y6 ==>
1406                     gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun >= &0)`)),
1407   (* {{{ proof *)
1408   [
1409   REPEAT WEAK_STRIP_TAC;
1410   REPEAT (FIRST_X_ASSUM_ST `delta_x4` MP_TAC);
1411   REPEAT (FIRST_X_ASSUM_ST `eulerA_x` MP_TAC);
1412   REPEAT (FIRST_X_ASSUM_ST `mm1` MP_TAC);
1413   REPEAT (FIRST_X_ASSUM (fun t -> ALL_TAC));
1414   REPEAT WEAK_STRIP_TAC;
1415   REWRITE_TAC[Sphere.ineq];
1416   REPEAT WEAK_STRIP_TAC;
1417   SUBGOAL_THEN `y1 = sqrt (y1 * y1) /\ y2 = sqrt(y2 * y2) /\ y3 = sqrt(y3 * y3) /\ y4 = sqrt (y4 * y4) /\ y5 = sqrt(y5 *y5) /\ y6 = sqrt(y6 * y6)` (unlist ONCE_REWRITE_TAC);
1418     REPEAT (GMATCH_SIMP_TAC Nonlinear_lemma.sqrtxx);
1419     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
1420   GMATCH_SIMP_TAC gamma4fgcy_div_sqrtdelta;
1421   REPEAT (GMATCH_SIMP_TAC Nonlinear_lemma.sqrtxx);
1422   REWRITE_TAC[Collect_geom2.REAL_POSSQ];
1423   REWRITE_TAC[GSYM CONJ_ASSOC];
1424   REPLICATE_TAC 18 (CONJ_TAC THENL [(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REWRITE_TAC[Sphere.h0] THEN MP_TAC Flyspeck_constants.bounds THEN REAL_ARITH_TAC);ALL_TAC]);
1425   REPEAT (GMATCH_SIMP_TAC (REWRITE_RULE[arith `y1 pow 2 = y1 * y1`] ups_x_pos24));
1426   REPLICATE_TAC 4 (CONJ_TAC THENL [(REPEAT (FIRST_X_ASSUM MP_TAC) THEN MP_TAC Flyspeck_constants.bounds THEN REAL_ARITH_TAC);ALL_TAC]);
1427   REPEAT (FIRST_X_ASSUM MP_TAC);
1428   REPLICATE_TAC 3 DISCH_TAC;
1429   REWRITE_TAC[TAUT `(a <= y ==> y <= b ==> c) <=> (a <= y /\ y <= b) ==> c`];
1430   REWRITE_TAC[GSYM Nonlinear_lemma.ineq_expand6];
1431   EVERY (map SPEC_TAC [(`y6:real`,`y6:real`);(`y5:real`,`y5:real`);(`y4:real`,`y4:real`);(`y3:real`,`y3:real`);(`y2:real`,`y2:real`);(`y1:real`,`y1:real`)]);
1432   MATCH_MP_TAC Nonlinear_lemma.ineq_square2;
1433   (CONJ_TAC THENL [(REPEAT (FIRST_X_ASSUM MP_TAC) THEN MP_TAC Flyspeck_constants.bounds THEN REAL_ARITH_TAC);ALL_TAC]);
1434   REWRITE_TAC[Sphere.delta_y;Sphere.ineq];
1435   REPEAT WEAK_STRIP_TAC;
1436   FIRST_X_ASSUM MP_TAC;
1437   REPEAT (GMATCH_SIMP_TAC sqrtpow2);
1438   REPLICATE_TAC 6 (CONJ_TAC THENL [(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);ALL_TAC]);
1439   SUBGOAL_THEN `delta_x4 x3 x1 x2 x6 x4 x5 = delta_x4 x3 x2 x1 x6 x5 x4 /\ delta_x4 x6 x1 x5 x3 x4 x2 = delta_x4 x6 x5 x1 x3 x2 x4` (unlist REWRITE_TAC);
1440     BY(REWRITE_TAC[Sphere.delta_x4] THEN REAL_ARITH_TAC);
1441   FIRST_X_ASSUM_ST `delta_x4` MP_TAC;
1442   REWRITE_TAC[Sphere.ineq];
1443   DISCH_THEN (REPEAT o (GMATCH_SIMP_TAC));
1444   ASM_REWRITE_TAC[];
1445   REPLICATE_TAC 12 (FIRST_X_ASSUM MP_TAC);
1446   REWRITE_TAC[REWRITE_RULE[arith `x * x = x pow 2`] Nonlinear_lemma.sqrt8_2];
1447   REWRITE_TAC[arith `#8.0 = &8 /\ &2 pow 2 = &4`];
1448   REPLICATE_TAC 12 (DISCH_TAC);
1449   ASM_REWRITE_TAC[];
1450   FIRST_X_ASSUM_ST `eulerA_x` MP_TAC;
1451   REWRITE_TAC[Sphere.ineq];
1452   SUBGOAL_THEN `eulerA_x x5 x3 x4 x2 x6 x1 = eulerA_x x4 x3 x5 x1 x6 x2 /\ eulerA_x x6 x1 x5 x3 x4 x2 = eulerA_x x1 x5 x6 x4 x2 x3` (unlist REWRITE_TAC);
1453     REWRITE_TAC[Sphere.eulerA_x];
1454     BY(REAL_ARITH_TAC);
1455   DISCH_THEN (REPEAT o (GMATCH_SIMP_TAC));
1456   ASM_REWRITE_TAC[];
1457   DISCH_TAC;
1458   ASM_REWRITE_TAC[];
1459   REWRITE_TAC[arith `a >= b <=> b <= a`];
1460   MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2;
1461   CONJ_TAC;
1462     MATCH_MP_TAC SQRT_POS_LE;
1463     BY((FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
1464   REWRITE_TAC[arith `b <= a <=> a >= b`];
1465   FIRST_X_ASSUM MP_TAC;
1466   MATCH_MP_TAC (arith `(f >= &0 \/ d < &0) ==> (&0 < d ==> f >= &0)`);
1467   FIRST_X_ASSUM_ST `mm1` MP_TAC;
1468   REWRITE_TAC[Sphere.ineq];
1469   DISCH_THEN (GMATCH_SIMP_TAC);
1470   BY(ASM_REWRITE_TAC[])
1471   ]);;
1472   (* }}} *)
1473
1474
1475 let specl x = concl o (SPECL x) o ASSUME;;
1476
1477 (* THIS APPROACH TO PROVING REAL_WLOG_SIMPLEX CRASHES OCAML ---
1478 let real_ty = `:real`;;
1479 let mk_y i = mk_var("y"^string_of_int i,real_ty);;
1480
1481 let [y1;y2;y3;y4;y5;y6] = map mk_y (1--6);;
1482
1483 let simplex_orders =
1484   [[y1;y2;y3;y4;y5;y6];[y1;y3;y2;y4;y6;y5];[y1;y5;y6;y4;y2;y3];[y1;y6;y5;y4;y3;y2];
1485    [y2;y1;y3;y5;y4;y6];[y2;y3;y1;y5;y6;y4];[y2;y4;y6;y5;y1;y3];[y2;y6;y4;y5;y3;y1];
1486    [y3;y1;y2;y6;y4;y5];[y3;y2;y1;y6;y5;y4];[y3;y4;y5;y6;y1;y2];[y3;y5;y4;y6;y2;y1];
1487    [y4;y2;y6;y1;y5;y3];[y4;y3;y5;y1;y6;y2];[y4;y5;y3;y1;y2;y6];[y4;y6;y2;y1;y3;y5];
1488    [y5;y1;y6;y2;y4;y3];[y5;y3;y4;y2;y6;y1];[y5;y4;y3;y2;y1;y6];[y5;y6;y1;y2;y3;y4];
1489    [y6;y1;y5;y3;y4;y2];[y6;y2;y4;y3;y5;y1];[y6;y4;y2;y3;y1;y5];[y6;y5;y1;y3;y2;y4]];;
1490
1491 let symtt =
1492   let symt = `!y1 y2 y3 y4 y5 y6. (y6 <= y1) /\ (y5 <= y1) /\ (y4 <= y1) /\
1493        (y3 <= y1) /\ (y2 <= y1) /\ (y6 <= y2) /\ (y5 <= y2) /\ (y3 <= y2)` in
1494   let cs = map (fun t -> specl t symt) simplex_orders in
1495     end_itlist (curry  mk_disj) cs;;
1496
1497 let SYM_CASES = time REAL_ARITH symtt;;  (* THIS IS THE KILLER LINE *)
1498 *)
1499
1500
1501
1502 let (* Packing3 *) REAL_FINITE_MAX_EXISTS =
1503 prove(`!S:real->bool. FINITE S /\ ~(S = {}) ==> ?m. m IN S /\ (!x. x IN S ==> x <= m)`,
1504                 MESON_TAC[SUP_FINITE]);;
1505
1506
1507 let REAL_WLOG_SIMPLEX_LEMMA = prove_by_refinement(
1508   `!P. (!y1 y2 y3 y4 y5 y6. P y1 y2 y3 y4 y5 y6 = P y2 y1 y3 y5 y4 y6 /\
1509      P y1 y2 y3 y4 y5 y6 = P y1 y3 y2 y4 y6 y5 /\
1510       P y1 y2 y3 y4 y5 y6 = P y5 y4 y3 y2 y1 y6) /\
1511     (!y1 y2 y3 y4 y5 y6. (y6 <= y1) /\ (y5 <= y1) /\ (y4 <= y1) /\
1512        (y3 <= y1) /\ (y2 <= y1)  ==>
1513        P y1 y2 y3 y4 y5 y6) ==>
1514     (!y1 y2 y3 y4 y5 y6. P y1 y2 y3 y4 y5 y6)`,
1515   (* {{{ proof *)
1516   [
1517   REPEAT WEAK_STRIP_TAC;
1518   SUBGOAL_THEN `?a.  a IN {y1,y2,y3,y4,y5,y6} /\ (!x. x IN {y1,y2,y3,y4,y5,y6} ==> x <= a)` MP_TAC;
1519     MATCH_MP_TAC REAL_FINITE_MAX_EXISTS;
1520     BY(REWRITE_TAC[ FINITE_INSERT ; FINITE_EMPTY;NOT_INSERT_EMPTY]);
1521   REPEAT WEAK_STRIP_TAC;
1522   REPEAT (FIRST_X_ASSUM_ST `IN` MP_TAC);
1523   REWRITE_TAC[IN_INSERT;NOT_IN_EMPTY];
1524   REWRITE_TAC[MESON[] `(!x. x = y1 \/ x = y2 \/ x = y3 \/ x = y4 \/ x = y5 \/ x = y6 ==> x <= a) = (y1 <= a /\ y2 <= a /\ y3 <= a /\ y4 <= a /\ y5 <= a /\ y6 <= a)`];
1525   BY(DISCH_THEN STRIP_ASSUME_TAC THEN ASM_MESON_TAC[])
1526   ]);;
1527   (* }}} *)
1528
1529 let REAL_WLOG_SIMPLEX_SYM = prove_by_refinement(
1530   `!P. (!y1 y2 y3 y4 y5 y6. P y1 y2 y3 y4 y5 y6 = P y2 y1 y3 y5 y4 y6 /\
1531      P y1 y2 y3 y4 y5 y6 = P y1 y3 y2 y4 y6 y5 /\
1532       P y1 y2 y3 y4 y5 y6 = P y5 y4 y3 y2 y1 y6) ==>
1533     ((!y1 y2 y3 y4 y5 y6.  P y1 y2 y3 y4 y5 y6 = P y1 y3 y2 y4 y6 y5) /\
1534     (!y1 y2 y3 y4 y5 y6.  P y1 y2 y3 y4 y5 y6 = P y1 y6 y5 y4 y3 y2))`,
1535   (* {{{ proof *)
1536   [
1537   BY(MESON_TAC[])
1538   ]);;
1539   (* }}} *)
1540
1541 let REAL_WLOG_SIMPLEX_LEMMA2 = prove_by_refinement(
1542   `!P (y1:real) (y4:real).
1543     ((!y1 y2 y3 y4 y5 y6.  P y1 y2 y3 y4 y5 y6 = P y1 y3 y2 y4 y6 y5) /\
1544     (!y1 y2 y3 y4 y5 y6.  P y1 y2 y3 y4 y5 y6 = P y1 y6 y5 y4 y3 y2))
1545     /\
1546     (! y2 y3  y5 y6. (y3 <= y2) /\ (y5 <= y2) /\ (y6 <= y2) ==>
1547        P y1 y2 y3 y4 y5 y6) ==>
1548     (!y2 y3  y5 y6. P y1 y2 y3 y4 y5 y6)`,
1549   (* {{{ proof *)
1550   [
1551   REPEAT WEAK_STRIP_TAC;
1552   SUBGOAL_THEN `?a.  a IN {y2,y3,y5,y6} /\ (!x. x IN {y2,y3,y5,y6} ==> x <= a)` MP_TAC;
1553     MATCH_MP_TAC REAL_FINITE_MAX_EXISTS;
1554     BY(BY(BY(REWRITE_TAC[ FINITE_INSERT ; FINITE_EMPTY;NOT_INSERT_EMPTY])));
1555   REPEAT WEAK_STRIP_TAC;
1556   REPEAT (FIRST_X_ASSUM_ST `IN` MP_TAC);
1557   REWRITE_TAC[IN_INSERT;NOT_IN_EMPTY];
1558   REWRITE_TAC[MESON[] `(!x. x = y1 \/ x = y2 \/ x = y3 \/ x = y4 \/ x = y5 \/ x = y6 ==> x <= a) = (y1 <= a /\ y2 <= a /\ y3 <= a /\ y4 <= a /\ y5 <= a /\ y6 <= a)`];
1559   BY(BY(BY(DISCH_THEN STRIP_ASSUME_TAC THEN ASM_MESON_TAC[])))
1560   ]);;
1561   (* }}} *)
1562
1563 let REAL_WLOG_SIMPLEX = prove_by_refinement(
1564   `!P. (!y1 y2 y3 y4 y5 y6. P y1 y2 y3 y4 y5 y6 = P y2 y1 y3 y5 y4 y6 /\
1565      P y1 y2 y3 y4 y5 y6 = P y1 y3 y2 y4 y6 y5 /\
1566       P y1 y2 y3 y4 y5 y6 = P y5 y4 y3 y2 y1 y6) /\
1567     (!y1 y2 y3 y4 y5 y6. (y6 <= y1) /\ (y5 <= y1) /\ (y4 <= y1) /\
1568        (y3 <= y1) /\ (y2 <= y1) /\ (y3 <= y2) /\ (y5 <= y2) /\ (y6 <= y2)  ==>
1569        P y1 y2 y3 y4 y5 y6) ==>
1570     (!y1 y2 y3 y4 y5 y6. P y1 y2 y3 y4 y5 y6)`,
1571   (* {{{ proof *)
1572   [
1573   GEN_TAC;
1574   DISCH_TAC;
1575   MATCH_MP_TAC REAL_WLOG_SIMPLEX_LEMMA;
1576   ASM_REWRITE_TAC[];
1577   REPEAT GEN_TAC;
1578   SUBGOAL_THEN `(y6 <= y1 /\ y5 <= y1 /\ y4 <= y1 /\ y3 <= y1 /\ y2 <= y1  ==> P y1 y2 y3 y4 y5 y6) = (\y1 y2 y3 y4 y5 y6. y6 <= y1 /\ y5 <= y1 /\ y4 <= y1 /\ y3 <= y1 /\ y2 <= y1  ==> P y1 y2 y3 y4 y5 y6) y1 y2 y3 y4 y5 y6` SUBST1_TAC;
1579     BY(MESON_TAC[]);
1580   EVERY (map SPEC_TAC [(`y6:real`,`y6:real`);(`y5:real`,`y5:real`);(`y3:real`,`y3:real`);(`y2:real`,`y2:real`)]);
1581   ABBREV_TAC `Q = (\y1 y2 y3 y4 y5 y6.          y6 <= y1 /\ y5 <= y1 /\ y4 <= y1 /\ y3 <= y1 /\ y2 <= y1          ==> P y1 y2 y3 y4 y5 y6)`;
1582   MATCH_MP_TAC REAL_WLOG_SIMPLEX_LEMMA2;
1583   CONJ_TAC;
1584     REPEAT (FIRST_X_ASSUM MP_TAC);
1585     REPEAT WEAK_STRIP_TAC;
1586     FIRST_X_ASSUM (ASSUME_TAC o (MATCH_MP REAL_WLOG_SIMPLEX_SYM));
1587     EXPAND_TAC "Q";
1588     BY(ASM_MESON_TAC[]);
1589   EXPAND_TAC "Q";
1590   BY(ASM_MESON_TAC[])
1591   ]);;
1592   (* }}} *)
1593
1594
1595 let rad2_x_sym = prove_by_refinement(
1596   `!x1 x2 x3 x4 x5 x6.
1597     rad2_x x1 x2 x3 x4 x5 x6 = rad2_x x2 x1 x3 x5 x4 x6 /\
1598     rad2_x x1 x2 x3 x4 x5 x6 = rad2_x x1 x3 x2 x4 x6 x5 /\
1599     rad2_x x1 x2 x3 x4 x5 x6 = rad2_x x5 x4 x3 x2 x1 x6`,
1600   (* {{{ proof *)
1601   [
1602   REWRITE_TAC[Sphere.rad2_x];
1603   REPEAT WEAK_STRIP_TAC;
1604   BY(REPEAT CONJ_TAC THEN BINOP_TAC THEN REWRITE_TAC[Sphere.rho_x;Sphere.delta_x] THEN REAL_ARITH_TAC)
1605   ]);;
1606   (* }}} *)
1607
1608 let rad2_y_sym = prove_by_refinement(
1609   `!x1 x2 x3 x4 x5 x6.
1610     rad2_y x1 x2 x3 x4 x5 x6 = rad2_y x2 x1 x3 x5 x4 x6 /\
1611     rad2_y x1 x2 x3 x4 x5 x6 = rad2_y x1 x3 x2 x4 x6 x5 /\
1612     rad2_y x1 x2 x3 x4 x5 x6 = rad2_y x5 x4 x3 x2 x1 x6`,
1613   (* {{{ proof *)
1614   [
1615   REWRITE_TAC[Sphere.rad2_y;Sphere.y_of_x];
1616   BY(MESON_TAC[rad2_x_sym])
1617   ]);;
1618   (* }}} *)
1619
1620 let delta_x_sym = prove_by_refinement(
1621   `!x1 x2 x3 x4 x5 x6.
1622     delta_x x1 x2 x3 x4 x5 x6 = delta_x x2 x1 x3 x5 x4 x6 /\
1623     delta_x x1 x2 x3 x4 x5 x6 = delta_x x1 x3 x2 x4 x6 x5 /\
1624     delta_x x1 x2 x3 x4 x5 x6 = delta_x x5 x4 x3 x2 x1 x6`,
1625   (* {{{ proof *)
1626   [
1627   REWRITE_TAC[Sphere.delta_x];
1628   BY(REAL_ARITH_TAC)
1629   ]);;
1630   (* }}} *)
1631
1632 let delta_y_sym = prove_by_refinement(
1633   `!x1 x2 x3 x4 x5 x6.
1634     delta_y x1 x2 x3 x4 x5 x6 = delta_y x2 x1 x3 x5 x4 x6 /\
1635     delta_y x1 x2 x3 x4 x5 x6 = delta_y x1 x3 x2 x4 x6 x5 /\
1636     delta_y x1 x2 x3 x4 x5 x6 = delta_y x5 x4 x3 x2 x1 x6`,
1637   (* {{{ proof *)
1638   [
1639   REWRITE_TAC[Sphere.delta_y;Sphere.delta_x];
1640   BY(REAL_ARITH_TAC)
1641   ]);;
1642   (* }}} *)
1643
1644
1645 let ineq_critical_edge = prove_by_refinement(
1646   `!u v y f.
1647     ~critical_edge_y y /\
1648     ineq (APPEND u (CONS (&2,y,&2 * hminus) v)) f /\
1649     ineq (APPEND u (CONS (&2 * hplus,y,sqrt8) v)) f ==>
1650     ineq (APPEND u (CONS (&2,y,sqrt8) v)) f`,
1651   (* {{{ proof *)
1652   [
1653   REWRITE_TAC[ineq_APPEND;critical_edge_y];
1654   REWRITE_TAC[Sphere.ineq];
1655   REPEAT WEAK_STRIP_TAC;
1656   SUBGOAL_THEN `&2 <= y /\ y <= sqrt8 ==> y <= &2 * hminus \/ &2 * hplus <= y` ASSUME_TAC;
1657     FIRST_X_ASSUM_ST `~` MP_TAC;
1658     REWRITE_TAC[Sphere.hplus];
1659     MP_TAC Nonlinear_lemma.hminus_prop;
1660     BY(REAL_ARITH_TAC);
1661   REPEAT (FIRST_X_ASSUM MP_TAC);
1662   BY(ASM_CASES_TAC `&2 <= y` THEN ASM_CASES_TAC `y <= sqrt8` THEN ASM_CASES_TAC `y <= &2 * hminus` THEN ASM_CASES_TAC `&2 * hplus <= y` THEN ASM_REWRITE_TAC[] THEN TRY (ASM_MESON_TAC[]))
1663   ]);;
1664   (* }}} *)
1665
1666 let ineq_branch_edge = prove_by_refinement(
1667   `!c a b u v y f.
1668      ineq (APPEND u (CONS (a,y,c) v)) f /\
1669     ineq (APPEND u (CONS (c,y,b) v)) f ==>
1670     ineq (APPEND u (CONS (a,y,b) v)) f`,
1671   (* {{{ proof *)
1672   [
1673   REWRITE_TAC[ineq_APPEND];
1674   REWRITE_TAC[Sphere.ineq];
1675   REPEAT WEAK_STRIP_TAC;
1676   ASSUME_TAC (arith  `y <= c \/ c <= y`);
1677   REPEAT (FIRST_X_ASSUM MP_TAC);
1678   BY(ASM_CASES_TAC `a <= y` THEN ASM_CASES_TAC `y <= b` THEN ASM_CASES_TAC `y <= c` THEN ASM_CASES_TAC `c <= y` THEN ASM_REWRITE_TAC[] THEN TRY (ASM_MESON_TAC[]))
1679   ]);;
1680   (* }}} *)
1681
1682 let BRANCH_TAC n c =
1683   CHOP_LIST_TAC n THEN
1684     MATCH_MP_TAC (SPEC c ineq_branch_edge)
1685     THEN REWRITE_TAC[APPEND];;
1686
1687 let CRIT_TAC n  =
1688   CHOP_LIST_TAC n THEN
1689     MATCH_MP_TAC ( ineq_critical_edge)
1690     THEN ASM_REWRITE_TAC[APPEND];;
1691
1692 let hminus_lt_hplus = prove_by_refinement(
1693   `&2 * hminus < &2 * hplus`,
1694   (* {{{ proof *)
1695   [
1696   ASM_MESON_TAC[arith `x < h0 /\ h0 < y ==> &2 * x < &2 * y` ; Nonlinear_lemma.hminus_lt_h0;Nonlinear_lemma.h0_lt_hplus;]
1697   ]);;
1698   (* }}} *)
1699
1700 let y1y2_lt = prove_by_refinement(
1701   `!y1 y2. y1 <= &2 * hminus /\ &2 * hplus <= y2 ==> ~(y2 <= y1)`,
1702   (* {{{ proof *)
1703   [
1704   MP_TAC hminus_lt_hplus THEN REAL_ARITH_TAC
1705   ]);;
1706   (* }}} *)
1707
1708 let real_ty = `:real`;;
1709 let mk_y i = mk_var("y"^string_of_int i,real_ty);;
1710 let ys = map mk_y (1--6);;
1711 let [y1;y2;y3;y4;y5;y6] = ys;;
1712
1713 let TSKAJXY_DERIVED4 = prove_by_refinement(
1714    tsk,
1715   (* {{{ proof *)
1716   [
1717   REPEAT DISCH_TAC;
1718   MP_TAC tsk_lemma1;
1719   ASM_REWRITE_TAC[];
1720   DISCH_TAC;
1721   MATCH_MP_TAC REAL_WLOG_SIMPLEX;
1722   REPEAT STRIP_TAC;
1723         REWRITE_TAC[Sphere.ineq];
1724         BY(MESON_TAC[delta_y_sym;rad2_y_sym;gamma4fgcy_sym12]);
1725       REWRITE_TAC[Sphere.ineq];
1726       BY(MESON_TAC[delta_y_sym;rad2_y_sym;gamma4fgcy_sym23]);
1727     REWRITE_TAC[Sphere.ineq];
1728     BY(MESON_TAC[delta_y_sym;rad2_y_sym;gamma4fgcy_sym03]);
1729   REWRITE_TAC[Sphere.ineq];
1730   REPLICATE_TAC 6 DISCH_TAC;
1731   REPEAT WEAK_STRIP_TAC;
1732   REPLICATE_TAC 6 (FIRST_X_ASSUM_ST `/\` MP_TAC);
1733   REWRITE_TAC[GSYM Nonlinear_lemma.ineq_expand6];
1734   PROOF_BY_CONTR_TAC;
1735   FIRST_X_ASSUM (BURY_TAC);
1736   FIRST_X_ASSUM_ST `ineq` (BURY_TAC);
1737   FIRST_X_ASSUM_ST `ineq` MP_TAC;
1738   REPEAT WEAK_STRIP_TAC;
1739   FIRST_X_ASSUM_ST `rad2_x` MP_TAC;
1740   REWRITE_TAC[GSYM Sphere.rad2_y];
1741   DISCH_THEN BURY_TAC;
1742   FIRST_X_ASSUM_ST `mm1` (K ALL_TAC);
1743   FIRST_X_ASSUM_ST `~ineq a b` MP_TAC;
1744   REWRITE_TAC[];
1745   REPEAT (FIRST_X_ASSUM MP_TAC);
1746   REWRITE_TAC[arith `#2.0 = &2`];
1747   REPEAT WEAK_STRIP_TAC;
1748   CRIT_TAC 0;
1749   CONJ_TAC;
1750     CRIT_TAC 1;
1751     ONCE_REWRITE_TAC[ (CONJ_SYM)];
1752     CONJ_TAC;
1753       REWRITE_TAC[Sphere.ineq];
1754       BY(ASM_MESON_TAC[y1y2_lt]);
1755     CRIT_TAC 2;
1756     ONCE_REWRITE_TAC[CONJ_SYM];
1757     CONJ_TAC;
1758       BY(REWRITE_TAC[Sphere.ineq] THEN ASM_MESON_TAC[y1y2_lt]);
1759     CRIT_TAC 4;
1760     ONCE_REWRITE_TAC[CONJ_SYM];
1761     CONJ_TAC;
1762       BY(REWRITE_TAC[Sphere.ineq] THEN ASM_MESON_TAC[y1y2_lt]);
1763     CRIT_TAC 5;
1764     ONCE_REWRITE_TAC[CONJ_SYM];
1765     CONJ_TAC;
1766       BY(REWRITE_TAC[Sphere.ineq] THEN ASM_MESON_TAC[y1y2_lt]);
1767     BRANCH_TAC 0 `#2.001`;
1768     ONCE_REWRITE_TAC[CONJ_SYM];
1769     CONJ_TAC;
1770       FIRST_X_ASSUM_ST `(#2.001,y,t)` (fun t -> MP_TAC (ISPECL ys t));
1771       ASM_SIMP_TAC[arith `b <= a ==> ~(a < b)`];
1772       REWRITE_TAC[Sphere.ineq];
1773       REPEAT (FIRST_X_ASSUM_ST `y <= x` MP_TAC);
1774       BY(REAL_ARITH_TAC);
1775     FIRST_X_ASSUM_ST `(&2,y,#2.001)` (fun t -> MP_TAC(ISPECL ys t));
1776     REWRITE_TAC[Sphere.ineq];
1777     REPEAT (FIRST_X_ASSUM_ST `y <= x` MP_TAC);
1778     BY(REAL_ARITH_TAC);
1779   CRIT_TAC 1;
1780   ONCE_REWRITE_TAC[CONJ_SYM];
1781   CONJ_TAC;
1782     REPEAT (FIRST_X_ASSUM_ST `rad2_y` MP_TAC);
1783     REWRITE_TAC[Sphere.ineq];
1784     DISCH_THEN (fun t -> MP_TAC (ISPECL ys t));
1785     BY(REAL_ARITH_TAC);
1786   CRIT_TAC 2;
1787   ONCE_REWRITE_TAC[CONJ_SYM];
1788   CONJ_TAC;
1789     REPEAT (FIRST_X_ASSUM_ST `rad2_y` MP_TAC);
1790     REWRITE_TAC[Sphere.ineq];
1791     DISCH_THEN (fun t -> MP_TAC (ISPECL [y1;y3;y2;y4;y6;y5] t));
1792     SUBGOAL_THEN `rad2_y y1 y3 y2 y4 y6 y5 = rad2_y y1 y2 y3 y4 y5 y6` SUBST1_TAC;
1793       BY(MESON_TAC[rad2_y_sym]);
1794     REPEAT (FIRST_X_ASSUM_ST `y <= x` MP_TAC);
1795     BY(REAL_ARITH_TAC);
1796   CRIT_TAC 4;
1797   ONCE_REWRITE_TAC[CONJ_SYM];
1798   CONJ_TAC;
1799     REPEAT (FIRST_X_ASSUM_ST `rad2_y` MP_TAC);
1800     REWRITE_TAC[Sphere.ineq];
1801     DISCH_THEN (fun t -> MP_TAC (ISPECL [y1;y5;y6;y4;y2;y3] t));
1802     SUBGOAL_THEN `rad2_y y1 y5 y6 y4 y2 y3 = rad2_y y1 y2 y3 y4 y5 y6` SUBST1_TAC;
1803       BY(MESON_TAC[rad2_y_sym]);
1804     REPEAT (FIRST_X_ASSUM_ST `y <= x` MP_TAC);
1805     BY(REAL_ARITH_TAC);
1806   CRIT_TAC 5;
1807   ONCE_REWRITE_TAC[CONJ_SYM];
1808   CONJ_TAC;
1809     REPEAT (FIRST_X_ASSUM_ST `rad2_y` MP_TAC);
1810     REWRITE_TAC[Sphere.ineq];
1811     DISCH_THEN (fun t -> MP_TAC (ISPECL [y1;y6;y5;y4;y3;y2] t));
1812     SUBGOAL_THEN `rad2_y y1 y6 y5 y4 y3 y2 = rad2_y y1 y2 y3 y4 y5 y6` SUBST1_TAC;
1813       BY(MESON_TAC[rad2_y_sym]);
1814     REPEAT (FIRST_X_ASSUM_ST `y <= x` MP_TAC);
1815     BY(REAL_ARITH_TAC);
1816   CRIT_TAC 3;
1817   FIRST_X_ASSUM_ST `ineq (CONS (&2,y,#2.001) v) u` (K ALL_TAC);
1818   FIRST_X_ASSUM_ST `ineq (CONS (#2.001,y1,&2*hminus) v) u` (K ALL_TAC);
1819   CONJ_TAC;
1820     BRANCH_TAC 1 `#2.001`;
1821     ONCE_REWRITE_TAC[CONJ_SYM];
1822     CONJ_TAC;
1823       FIRST_X_ASSUM_ST `#2.001` (fun t -> MP_TAC ( ISPECL ys t));
1824       BY(ASM_SIMP_TAC[arith `b <= a ==> ~(a < b)`]);
1825     FIRST_X_ASSUM_ST `(a,b,#2.001)` (MP_TAC o (ISPECL ys));
1826     REWRITE_TAC[Sphere.ineq];
1827     REPEAT (FIRST_X_ASSUM_ST `y <= x` MP_TAC);
1828     BY(REAL_ARITH_TAC);
1829   REPEAT (FIRST_X_ASSUM_ST `#2.001` (K ALL_TAC));
1830   BRANCH_TAC 1 `#2.01`;
1831   ONCE_REWRITE_TAC[CONJ_SYM];
1832   CONJ_TAC;
1833     FIRST_X_ASSUM_ST `(#2.01,a,b)` (MP_TAC o (ISPECL ys));
1834     ASM_SIMP_TAC[arith `b <= a ==> ~(a < b)`];
1835     REWRITE_TAC[Sphere.ineq];
1836     BY(REAL_ARITH_TAC);
1837   BRANCH_TAC 3 `#2.8`;
1838   CONJ_TAC;
1839     FIRST_X_ASSUM_ST `(a,b,#2.8)` (MP_TAC o (ISPECL ys));
1840     REWRITE_TAC[Sphere.ineq];
1841     REPEAT (FIRST_X_ASSUM_ST `y <= x` MP_TAC);
1842     BY(REAL_ARITH_TAC);
1843   FIRST_X_ASSUM_ST `(#2.8,a,b)` (MP_TAC o (ISPECL ys));
1844   ASM_REWRITE_TAC[];
1845   REPEAT (FIRST_X_ASSUM_ST `y <= x` MP_TAC);
1846   REWRITE_TAC[Sphere.ineq];
1847   BY(REAL_ARITH_TAC)
1848   ]);;
1849   (* }}} *)
1850
1851 (* ========================================================================== *)
1852 (* Merge "ZTGIJCF4" inequalities. The main result is ztg4.   *)
1853 (* ========================================================================== *)
1854
1855 let REAL_FINITE_MIN_EXISTS =
1856 prove(`!S:real->bool. FINITE S /\ ~(S = {}) ==> ?m. m IN S /\ (!x. x IN S ==> m <= x)`,
1857                 MESON_TAC[INF_FINITE]);;
1858
1859
1860 let REAL_WLOG_SIMPLEX_LEMMA2_LE = prove_by_refinement(
1861   `!P .
1862     ((!y1 y2 y3 y4 y5 y6.  P y1 y2 y3 y4 y5 y6 = P y1 y3 y2 y4 y6 y5) /\
1863     (!y1 y2 y3 y4 y5 y6.  P y1 y2 y3 y4 y5 y6 = P y1 y6 y5 y4 y3 y2))
1864     /\
1865     (!y1 y2 y3 y4 y5 y6. (y2 <= y3) /\ (y2 <= y5 ) /\ (y2 <= y6 ) ==>
1866        P y1 y2 y3 y4 y5 y6) ==>
1867     (!y1 y2 y3 y4 y5 y6. P y1 y2 y3 y4 y5 y6)`,
1868   (* {{{ proof *)
1869   [
1870   REPEAT WEAK_STRIP_TAC;
1871   SUBGOAL_THEN `?a.  a IN {y2,y3,y5,y6} /\ (!x. x IN {y2,y3,y5,y6} ==> a <= x)` MP_TAC;
1872     MATCH_MP_TAC REAL_FINITE_MIN_EXISTS;
1873     BY(BY(BY(REWRITE_TAC[ FINITE_INSERT ; FINITE_EMPTY;NOT_INSERT_EMPTY])));
1874   REPEAT WEAK_STRIP_TAC;
1875   REPEAT (FIRST_X_ASSUM_ST `IN` MP_TAC);
1876   REWRITE_TAC[IN_INSERT;NOT_IN_EMPTY];
1877   REWRITE_TAC[MESON[] `(!x. x = y1 \/ x = y2 \/ x = y3 \/ x = y4 \/ x = y5 \/ x = y6 ==> a <= x) = (a <= y1 /\ a <= y2 /\ a <= y3 /\ a <= y4 /\ a <= y5 /\ a <= y6)`];
1878   BY(BY(BY(DISCH_THEN STRIP_ASSUME_TAC THEN ASM_MESON_TAC[])))
1879   ]);;
1880   (* }}} *)
1881
1882 let beta_ub = prove_by_refinement(
1883   `!h. bump h <= #0.005`,
1884   (* {{{ proof *)
1885   [
1886   REWRITE_TAC[Sphere.bump];
1887   GEN_TAC;
1888   REWRITE_TAC[arith `a * (&1 - c) <= a <=> &0 <= a * c`];
1889   MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2;
1890   REWRITE_TAC[Calc_derivative.invert_den_le];
1891   GMATCH_SIMP_TAC Real_ext.REAL_PROP_NN_MUL2;
1892   REWRITE_TAC[REAL_LE_POW_2];
1893   BY(REAL_ARITH_TAC)
1894   ]);;
1895   (* }}} *)
1896
1897 let beta_lb = prove_by_refinement(
1898   `!h. hminus <= h /\ h <= hplus ==> &0 <= bump h`,
1899   (* {{{ proof *)
1900   [
1901   REWRITE_TAC[Sphere.bump];
1902   REPEAT WEAK_STRIP_TAC;
1903   MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2;
1904   CONJ_TAC;
1905     BY(REAL_ARITH_TAC);
1906   MATCH_MP_TAC (arith `x <= y ==> &0 <= y - x`);
1907   REWRITE_TAC[GSYM Trigonometry2.DIV_POW2];
1908   REWRITE_TAC[ABS_SQUARE_LE_1;Sphere.h0];
1909   REPEAT( FIRST_X_ASSUM MP_TAC);
1910   REWRITE_TAC[Sphere.hplus];
1911   MP_TAC Nonlinear_lemma.hminus_prop;
1912   BY(REAL_ARITH_TAC)
1913   ]);;
1914   (* }}} *)
1915
1916 (*
1917 let beta_bump_y_lb = prove_by_refinement(
1918   `!y1 y2 y3 y4 y5 y6.
1919     -- #0.005 <= beta_bump_y y1 y2 y3 y4 y5 y6`,
1920   (* {{{ proof *)
1921   [
1922   REWRITE_TAC[Sphere.beta_bump_y];
1923   REPEAT WEAK_STRIP_TAC;
1924   ASM_CASES_TAC `critical_edge_y y6` THEN ASM_CASES_TAC `critical_edge_y y4` THEN ASM_REWRITE_TAC[arith `&0 * x = &0 /\ x * &0 = &0`;arith `-- #0.005 <= &0`];
1925   ASM_CASES_TAC `critical_edge_y y2` THEN ASM_CASES_TAC `critical_edge_y y3` THEN ASM_REWRITE_TAC[arith `&0 * x = &0 /\ x * &0 = &0`;arith `-- #0.005 <= &0`];
1926   ASM_CASES_TAC `critical_edge_y y5` THEN ASM_CASES_TAC `critical_edge_y y1` THEN ASM_REWRITE_TAC[arith `&0 * x = &0 /\ x * &0 = &0`;arith `-- #0.005 <= &0`];
1927   REWRITE_TAC[arith `&1 * x = x`];
1928   MATCH_MP_TAC (arith `&0 <= x /\ y <= #0.005 ==> -- #0.005 <= x - y`);
1929   GMATCH_SIMP_TAC beta_lb;
1930   REWRITE_TAC[beta_ub];
1931   FIRST_X_ASSUM MP_TAC;
1932   REWRITE_TAC[Sphere.critical_edge_y];
1933   BY(REAL_ARITH_TAC)
1934   ]);;
1935   (* }}} *)
1936 *)
1937
1938 let beta_sub = prove_by_refinement(
1939   `!y1 y4. critical_edge_y y1 /\ critical_edge_y y4 ==> -- #0.005 <= bump (y1 / &2) - bump( y4 / &2)`,
1940   (* {{{ proof *)
1941   [
1942  REWRITE_TAC[Sphere.critical_edge_y];
1943   REPEAT WEAK_STRIP_TAC;
1944   ENOUGH_TO_SHOW_TAC `&0 <= bump (y1 / &2) /\ bump (y4 / &2) <= #0.005`;
1945     BY(REAL_ARITH_TAC);
1946   CONJ_TAC;
1947     MATCH_MP_TAC beta_lb;
1948     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
1949   BY(REWRITE_TAC[beta_ub])
1950   ]);;
1951   (* }}} *)
1952
1953
1954 let beta_bumpA_y_lb = prove_by_refinement(
1955   `!y1 y2 y3 y4 y5 y6.
1956     -- #0.005 <= beta_bumpA_y y1 y2 y3 y4 y5 y6`,
1957   (* {{{ proof *)
1958   [
1959   REWRITE_TAC[Sphere.beta_bumpA_y];
1960   REPEAT WEAK_STRIP_TAC;
1961   REPEAT (COND_CASES_TAC) THEN (TRY (REAL_ARITH_TAC));
1962   REWRITE_TAC[arith `&1 * x = x`];
1963   MATCH_MP_TAC beta_sub;
1964   BY(ASM_REWRITE_TAC[])
1965   ]);;
1966   (* }}} *)
1967
1968
1969 let hmin22 = prove_by_refinement(
1970   `&2 <= &2 * hminus`,
1971   (* {{{ proof *)
1972   [
1973   MP_TAC Nonlinear_lemma.hminus_gt THEN REAL_ARITH_TAC
1974   ]);;
1975   (* }}} *)
1976
1977
1978 let ineq_branch_2hmin = prove_by_refinement(
1979   `! a b u v y f.
1980     (a <= &2 * hminus) /\
1981      ((~critical_edge_y y) ==> ineq (APPEND u (CONS (a,y, &2 * hminus) v)) f) /\
1982     ineq (APPEND u (CONS (&2 * hminus,y,b) v)) f ==>
1983     ineq (APPEND u (CONS (a,y,b) v)) f`,
1984   (* {{{ proof *)
1985   [
1986   REWRITE_TAC[ineq_APPEND;Sphere.critical_edge_y];
1987   REWRITE_TAC[Sphere.ineq];
1988   REPEAT WEAK_STRIP_TAC;
1989   DISJ_CASES_TAC (arith `y < &2 * hminus \/ &2 * hminus <= y`);
1990     FIRST_X_ASSUM_ST `hplus` MP_TAC;
1991     ANTS_TAC;
1992       BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
1993     SUBGOAL_THEN `y <= &2 * hminus` ASSUME_TAC;
1994       BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
1995     REPEAT (FIRST_X_ASSUM_ST `ineq` MP_TAC);
1996     BY((ASM_CASES_TAC `a <= y` THEN ASM_CASES_TAC `y <= b` THEN ASM_REWRITE_TAC[] THEN TRY (ASM_MESON_TAC[])));
1997   REPEAT (FIRST_X_ASSUM_ST `ineq` MP_TAC);
1998   (ASM_CASES_TAC `a <= y` THEN ASM_CASES_TAC `y <= b` THEN ASM_REWRITE_TAC[] THEN TRY (ASM_MESON_TAC[]));
1999   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
2000   ]);;
2001   (* }}} *)
2002
2003 let ineq_T = prove_by_refinement(
2004   `!a. ineq a T`,
2005   (* {{{ proof *)
2006   [LIST_INDUCT_TAC;
2007     BY(REWRITE_TAC[Sphere.ineq]);
2008   SUBGOAL_THEN `?(a:real) (x:real) (b:real). h = (a,x,b)` MP_TAC;
2009     BY(BY(MESON_TAC[PAIR_SURJECTIVE]));
2010   WEAK_STRIP_TAC;
2011   BY(ASM_REWRITE_TAC[Sphere.ineq])
2012   ]);;
2013   (* }}} *)
2014
2015 let ineq_MP = prove_by_refinement(
2016   `! b c a. ineq a (b==>c) ==> ineq a b ==> ineq a c`,
2017   (* {{{ proof *)
2018   [
2019   REPLICATE_TAC 2 GEN_TAC;
2020   LIST_INDUCT_TAC;
2021     BY(REWRITE_TAC[Sphere.ineq]);
2022   SUBGOAL_THEN `?(a:real) (x:real) (b:real). h = (a,x,b)` MP_TAC;
2023     BY(BY(BY(MESON_TAC[PAIR_SURJECTIVE])));
2024   WEAK_STRIP_TAC;
2025   (ASM_REWRITE_TAC[Sphere.ineq]);
2026   BY(ASM_MESON_TAC[])
2027   ]);;
2028   (* }}} *)
2029
2030 let ineq_CONJ = prove_by_refinement(
2031   `!b c a. ineq a b /\ ineq a c ==> ineq a (b /\ c)`,
2032   (* {{{ proof *)
2033   [
2034   REPLICATE_TAC 2 GEN_TAC;
2035   LIST_INDUCT_TAC;
2036     BY(BY(REWRITE_TAC[Sphere.ineq]));
2037   SUBGOAL_THEN `?(a:real) (x:real) (b:real). h = (a,x,b)` MP_TAC;
2038     BY(BY(BY(BY(MESON_TAC[PAIR_SURJECTIVE]))));
2039   WEAK_STRIP_TAC;
2040   (ASM_REWRITE_TAC[Sphere.ineq]);
2041   BY(BY(ASM_MESON_TAC[]))
2042   ]);;
2043   (* }}} *)
2044
2045
2046 let ineq_af = prove_by_refinement(
2047   `!f a. f ==> ineq a f`,
2048   (* {{{ proof *)
2049   [
2050   GEN_TAC;
2051   LIST_INDUCT_TAC;
2052     BY(BY(REWRITE_TAC[Sphere.ineq]));
2053   SUBGOAL_THEN `?(a:real) (x:real) (b:real). h = (a,x,b)` MP_TAC;
2054     BY(BY(BY(BY(MESON_TAC[PAIR_SURJECTIVE]))));
2055   WEAK_STRIP_TAC;
2056   (ASM_REWRITE_TAC[Sphere.ineq]);
2057   BY(BY(ASM_MESON_TAC[]))
2058   ]);;
2059   (* }}} *)
2060
2061
2062 let ineq_monotone = prove_by_refinement(
2063   `! f f' a. (f ==> f') ==> (ineq a f ==> ineq a f')`,
2064   (* {{{ proof *)
2065   [
2066   GEN_TAC;
2067   GEN_TAC;
2068   LIST_INDUCT_TAC;
2069     BY(REWRITE_TAC[Sphere.ineq]);
2070   REWRITE_TAC[Sphere.ineq];
2071   SUBGOAL_THEN `?(a:real) (x:real) (b:real). h = (a,x,b)` MP_TAC;
2072     BY(MESON_TAC[PAIR_SURJECTIVE]);
2073   WEAK_STRIP_TAC;
2074   ASM_REWRITE_TAC[Sphere.ineq];
2075   BY(ASM_MESON_TAC[])
2076   ]);;
2077   (* }}} *)
2078
2079
2080 (*
2081 let ineq_approx_ztg4 = prove_by_refinement(
2082   `!w' m a y1 y2 y3 y4 y5 y6.
2083      gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun / &w' <=
2084     gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun/ &(wtcount6_y y1 y2 y3 y4 y5 y6) /\
2085       &m * beta_bump_lb <= beta_bump_y y1 y2 y3 y4 y5 y6 /\
2086       ineq a ((gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun / &w' + &m * beta_bump_lb >
2087                 a_spine5 + b_spine5 * dih_y y1 y2 y3 y4 y5 y6) \/
2088               (
2089     (y_of_x rad2_x y1 y2 y3 y4 y5 y6 > &2))) ==>
2090       ineq a ( (rad2_y y1 y2 y3 y4 y5 y6 < &2) ==>
2091                  (gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun /
2092             &(wtcount6_y y1 y2 y3 y4 y5 y6) +
2093             beta_bump_y y1 y2 y3 y4 y5 y6 >
2094             a_spine5 + b_spine5 * dih_y y1 y2 y3 y4 y5 y6))`,
2095   (* {{{ proof *)
2096   [
2097   REPEAT WEAK_STRIP_TAC;
2098   FIRST_X_ASSUM MP_TAC;
2099   MATCH_MP_TAC ineq_monotone;
2100   REWRITE_TAC[GSYM Sphere.rad2_y];
2101   MATCH_MP_TAC (TAUT `(b ==> a ==> c) ==> (a ==> b ==> c)`);
2102   DISCH_TAC;
2103   ASM_SIMP_TAC[ (arith `x < &2 ==> ~(x > &2)`)];
2104   MATCH_MP_TAC (arith `a' <= a /\ b' <= b ==> (a'+b' > c ==> a + b > c)`);
2105   BY(ASM_REWRITE_TAC[])
2106   ]);;
2107   (* }}} *)
2108 *)
2109
2110 (*
2111 let ineq_approx_ztg4 = prove_by_refinement(
2112   `!w' m a y1 y2 y3 y4 y5 y6.
2113     ineq a (gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun / &w' <=
2114     gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun/ &(wtcount6_y y1 y2 y3 y4 y5 y6) /\
2115       &m * beta_bump_lb <= beta_bump_y y1 y2 y3 y4 y5 y6 /\
2116      rad2_y y1 y2 y3 y4 y5 y6 < &2)
2117     ==>
2118       (ineq a ((gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun / &w' + &m * beta_bump_lb >
2119                 a_spine5 + b_spine5 * dih_y y1 y2 y3 y4 y5 y6) \/
2120           rad2_y y1 y2 y3 y4 y5 y6 > &2   ) ==>
2121       ineq a (
2122                  (gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun /
2123             &(wtcount6_y y1 y2 y3 y4 y5 y6) +
2124             beta_bump_y y1 y2 y3 y4 y5 y6 >
2125             a_spine5 + b_spine5 * dih_y y1 y2 y3 y4 y5 y6)))`,
2126   (* {{{ proof *)
2127   [
2128   REPEAT GEN_TAC;
2129   DISCH_TAC;
2130   MATCH_MP_TAC ineq_MP;
2131   FIRST_X_ASSUM MP_TAC;
2132   MATCH_MP_TAC ineq_MP;
2133   ASM_SIMP_TAC[arith `x < &2 ==> ~(x > &2)`];
2134   MATCH_MP_TAC ineq_af;
2135   DISCH_TAC;
2136   MATCH_MP_TAC (arith `a' <= a /\ b' <= b ==> (a'+b' > c ==> a + b > c)`);
2137   BY(BY(BY(ASM_REWRITE_TAC[])))
2138   ]);;
2139   (* }}} *)
2140 *)
2141
2142 let ineq_approxA_ztg4 = prove_by_refinement(
2143   `!w' m a y1 y2 y3 y4 y5 y6.
2144     ineq a (gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun / &w' <=
2145     gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun/ &(wtcount6_y y1 y2 y3 y4 y5 y6) /\
2146       &m * beta_bump_lb <= beta_bumpA_y y1 y2 y3 y4 y5 y6 /\
2147      rad2_y y1 y2 y3 y4 y5 y6 < &2)
2148     ==>
2149       (ineq a ((gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun / &w' + &m * beta_bump_lb >
2150                 a_spine5 + b_spine5 * dih_y y1 y2 y3 y4 y5 y6) \/
2151           rad2_y y1 y2 y3 y4 y5 y6 > &2   ) ==>
2152       ineq a (
2153                  (gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun /
2154             &(wtcount6_y y1 y2 y3 y4 y5 y6) +
2155             beta_bumpA_y y1 y2 y3 y4 y5 y6 >
2156             a_spine5 + b_spine5 * dih_y y1 y2 y3 y4 y5 y6)))`,
2157   (* {{{ proof *)
2158   [
2159   REPEAT GEN_TAC;
2160   DISCH_TAC;
2161   MATCH_MP_TAC ineq_MP;
2162   FIRST_X_ASSUM MP_TAC;
2163   MATCH_MP_TAC ineq_MP;
2164   ASM_SIMP_TAC[arith `x < &2 ==> ~(x > &2)`];
2165   MATCH_MP_TAC ineq_af;
2166   DISCH_TAC;
2167   MATCH_MP_TAC (arith `a' <= a /\ b' <= b ==> (a'+b' > c ==> a + b > c)`);
2168   BY(BY(BY(ASM_REWRITE_TAC[])))
2169   ]);;
2170   (* }}} *)
2171
2172
2173 (*
2174 let beta_bump_lb1 = prove_by_refinement(
2175   `!y1 y2 y3 y4 y5 y6. &1 * beta_bump_lb <= beta_bump_y y1 y2 y3 y4 y5 y6`,
2176   (* {{{ proof *)
2177   [
2178   BY(REWRITE_TAC[beta_bump_y_lb;Sphere.beta_bump_lb;arith `&1 * x = x`])
2179   ]);;
2180   (* }}} *)
2181 *)
2182
2183 let beta_bumpA_lb1 = prove_by_refinement(
2184   `!y1 y2 y3 y4 y5 y6. &1 * beta_bump_lb <= beta_bumpA_y y1 y2 y3 y4 y5 y6`,
2185   (* {{{ proof *)
2186   [
2187   BY(REWRITE_TAC[beta_bumpA_y_lb;Sphere.beta_bump_lb;arith `&1 * x = x`])
2188   ]);;
2189   (* }}} *)
2190
2191 (*
2192 let beta_bump_lb0 = prove_by_refinement(
2193   `!y1 y2 y3 y4 y5 y6.
2194   (~critical_edge_y y1 \/ critical_edge_y y2 \/ critical_edge_y y3 \/ critical_edge_y y5 \/ critical_edge_y y6 \/ ~critical_edge_y y4)
2195   ==> &0 * beta_bump_lb <= beta_bump_y y1 y2 y3 y4 y5 y6`,
2196   (* {{{ proof *)
2197   [
2198   REWRITE_TAC[Sphere.beta_bump_y;arith `&0 * x = &0`];
2199   REPEAT GEN_TAC;
2200   DISCH_TAC;
2201   ASM_CASES_TAC `critical_edge_y y6` THEN ASM_CASES_TAC `critical_edge_y y4` THEN ASM_REWRITE_TAC[arith `&0 * x = &0 /\ x * &0 = &0`;arith `&0 <= &0`];
2202   ASM_CASES_TAC `critical_edge_y y2` THEN ASM_CASES_TAC `critical_edge_y y3` THEN ASM_REWRITE_TAC[arith `&0 * x = &0 /\ x * &0 = &0`;arith `&0 <= &0`];
2203   ASM_CASES_TAC `critical_edge_y y5` THEN ASM_CASES_TAC `critical_edge_y y1` THEN ASM_REWRITE_TAC[arith `&0 * x = &0 /\ x * &0 = &0`;arith `&0 <= &0`];
2204   FIRST_X_ASSUM_ST `\/` MP_TAC;
2205   BY(ASM_REWRITE_TAC[])
2206   ]);;
2207   (* }}} *)
2208 *)
2209
2210 let beta_bumpA_lb0 = prove_by_refinement(
2211   `!y1 y2 y3 y4 y5 y6.
2212   (~critical_edge_y y1 \/ critical_edge_y y2 \/ critical_edge_y y3 \/ critical_edge_y y5 \/ critical_edge_y y6 \/ ~critical_edge_y y4)
2213   ==> &0 * beta_bump_lb <= beta_bumpA_y y1 y2 y3 y4 y5 y6`,
2214   (* {{{ proof *)
2215   [
2216   REWRITE_TAC[Sphere.beta_bumpA_y;arith `&0 * x = &0`];
2217   REPEAT GEN_TAC;
2218   SUBGOAL_THEN `!y. critical_edge_y y ==> ~(y < &2 * hminus)` MP_TAC;
2219     REWRITE_TAC[Sphere.critical_edge_y];
2220     BY(REAL_ARITH_TAC);
2221   DISCH_TAC;
2222   DISCH_TAC;
2223   ASM_CASES_TAC `critical_edge_y y6` THEN ASM_CASES_TAC `critical_edge_y y4` THEN ASM_SIMP_TAC[arith `&0 * x = &0 /\ x * &0 = &0`;arith `&0 <= &0`];
2224   ASM_CASES_TAC `critical_edge_y y2` THEN ASM_CASES_TAC `critical_edge_y y3` THEN ASM_SIMP_TAC[arith `&0 * x = &0 /\ x * &0 = &0`;arith `&0 <= &0`];
2225   ASM_CASES_TAC `critical_edge_y y5` THEN ASM_CASES_TAC `critical_edge_y y1` THEN ASM_SIMP_TAC[arith `&0 * x = &0 /\ x * &0 = &0`;arith `&0 <= &0`];
2226   FIRST_X_ASSUM_ST `\/` MP_TAC;
2227   BY(ASM_REWRITE_TAC[])
2228   ]);;
2229   (* }}} *)
2230
2231
2232 let quarter_lemma  = prove_by_refinement(
2233   `!x u a.   x <= u ==> x <= a pow 2 + u`,
2234   (* {{{ proof *)
2235   [
2236   REPEAT GEN_TAC;
2237   MP_TAC (ISPEC `a:real` REAL_LE_POW_2);
2238   BY(REAL_ARITH_TAC)
2239   ]);;
2240   (* }}} *)
2241
2242 let quarter_lemma2 = prove_by_refinement(
2243   `!x u a. x - a pow 2 <= u ==>    x <= a pow 2 + u`,
2244   (* {{{ proof *)
2245   [
2246   BY(REAL_ARITH_TAC)
2247   ]);;
2248   (* }}} *)
2249
2250 let quarter_lemma3 = prove_by_refinement(
2251   `!x  a .   abs(x) <= abs(y) ==>         x pow 2 - y pow 2 <= a pow 2`,
2252   (* {{{ proof *)
2253   [
2254   REPEAT GEN_TAC;
2255   REWRITE_TAC[REAL_LE_SQUARE_ABS];
2256   MP_TAC (ISPEC `a:real` REAL_LE_POW_2);
2257   BY(BY(REAL_ARITH_TAC))
2258   ]);;
2259   (* }}} *)
2260
2261 let quarter_norm2hh = prove_by_refinement(
2262   `!y1 y2 y3 y4 y5 y6. (norm2hh y1 y2 y3 y4 y5 y6 <  (hplus- hminus) pow 2) ==>
2263     critical_edge_y y1 /\ (y2 < &2 * hminus) /\ (y3 < &2*hminus) /\
2264     (y4 < &2 * hminus) /\ (y5 < &2 * hminus) /\ (y6 < &2*hminus)`,
2265   (* {{{ proof *)
2266   [
2267   REWRITE_TAC[Sphere.critical_edge_y;Sphere.norm2hh];
2268   REPEAT GEN_TAC;
2269   REWRITE_TAC[GSYM CONJ_ASSOC];
2270   MATCH_MP_TAC (TAUT `((~b) ==> ~a) ==> (a ==> b)`);
2271   REWRITE_TAC[DE_MORGAN_THM;arith `(~(a < b) <=> (b <= a)) /\ (~(a <= b) <=> (b < a))`];
2272   REPEAT STRIP_TAC;
2273               MATCH_MP_TAC quarter_lemma2;
2274               REPEAT (MATCH_MP_TAC quarter_lemma);
2275               MATCH_MP_TAC quarter_lemma3;
2276               BY(FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[Sphere.hplus;] THEN MP_TAC Nonlinear_lemma.hminus_prop THEN REAL_ARITH_TAC);
2277             MATCH_MP_TAC quarter_lemma2;
2278             REPEAT (MATCH_MP_TAC quarter_lemma);
2279             MATCH_MP_TAC quarter_lemma3;
2280             BY(FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[Sphere.hplus;] THEN MP_TAC Nonlinear_lemma.hminus_prop THEN REAL_ARITH_TAC);
2281           MATCH_MP_TAC quarter_lemma;
2282           MATCH_MP_TAC quarter_lemma2;
2283           REPEAT (MATCH_MP_TAC quarter_lemma);
2284           MATCH_MP_TAC quarter_lemma3;
2285           BY(FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[Sphere.hplus;] THEN MP_TAC Nonlinear_lemma.hminus_prop THEN REAL_ARITH_TAC);
2286         REPLICATE_TAC 2 (MATCH_MP_TAC quarter_lemma);
2287         MATCH_MP_TAC quarter_lemma2;
2288         REPEAT (MATCH_MP_TAC quarter_lemma);
2289         MATCH_MP_TAC quarter_lemma3;
2290         BY(FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[Sphere.hplus;] THEN MP_TAC Nonlinear_lemma.hminus_prop THEN REAL_ARITH_TAC);
2291       REPLICATE_TAC 3 (MATCH_MP_TAC quarter_lemma);
2292       MATCH_MP_TAC quarter_lemma2;
2293       REPEAT (MATCH_MP_TAC quarter_lemma);
2294       MATCH_MP_TAC quarter_lemma3;
2295       BY(FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[Sphere.hplus;] THEN MP_TAC Nonlinear_lemma.hminus_prop THEN REAL_ARITH_TAC);
2296     REPLICATE_TAC 4 (MATCH_MP_TAC quarter_lemma);
2297     MATCH_MP_TAC quarter_lemma2;
2298     REPEAT (MATCH_MP_TAC quarter_lemma);
2299     MATCH_MP_TAC quarter_lemma3;
2300     BY(FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[Sphere.hplus;] THEN MP_TAC Nonlinear_lemma.hminus_prop THEN REAL_ARITH_TAC);
2301   REPLICATE_TAC 5 (MATCH_MP_TAC quarter_lemma);
2302   ONCE_REWRITE_TAC[arith `x <= y <=> x <= y + &0 pow 2`];
2303   MATCH_MP_TAC quarter_lemma2;
2304   MATCH_MP_TAC quarter_lemma3;
2305   BY(FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[Sphere.hplus;] THEN MP_TAC Nonlinear_lemma.hminus_prop THEN REAL_ARITH_TAC)
2306   ]);;
2307   (* }}} *)
2308
2309 let gamma_wte = prove_by_refinement(
2310   `!w' y1 y2 y3 y4 y5 y6.
2311     (w' = wtcount6_y y1 y2 y3 y4 y5 y6) ==>
2312     (gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun/ &w' <=
2313         gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun / &(wtcount6_y y1 y2 y3 y4 y5 y6))`,
2314   (* {{{ proof *)
2315   [
2316   REPEAT GEN_TAC;
2317     DISCH_THEN SUBST1_TAC;
2318       REWRITE_TAC[REAL_ARITH `x <= x`]
2319   ]);;
2320   (* }}} *)
2321
2322 let critical_y_range = prove_by_refinement(
2323   `!y. &2 * hminus <= y /\ y <= &2 * hplus ==> critical_edge_y y`,
2324   (* {{{ proof *)
2325   [
2326   REWRITE_TAC[critical_edge_y]
2327   ]);;
2328   (* }}} *)
2329
2330
2331 let gamma_wt = prove_by_refinement(
2332   `!w' y1 y2 y3 y4 y5 y6.
2333     (0 < wtcount6_y y1 y2 y3 y4 y5 y6 /\
2334         (gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun > &0) /\
2335        wtcount6_y y1 y2 y3 y4 y5 y6 <= w'
2336       ) ==>
2337        gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun / &w' <= gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun/ &(wtcount6_y y1 y2 y3 y4 y5 y6)`,
2338   (* {{{ proof *)
2339   [
2340   REPEAT WEAK_STRIP_TAC;
2341   REWRITE_TAC[arith `a / b <= a /c <=>  &0 <= a * (&1/c - &1/b)`];
2342   MATCH_MP_TAC Real_ext.REAL_PROP_NN_MUL2;
2343   ASM_SIMP_TAC[arith `x > &0 ==> &0 <= x`];
2344   REWRITE_TAC[arith `&0 <= x - y <=> y <= x`;real_div;arith `&1 * x = x`];
2345   MATCH_MP_TAC REAL_LE_INV2;
2346   BY(ASM_REWRITE_TAC[REAL_OF_NUM_LT;REAL_OF_NUM_LE])
2347   ]);;
2348   (* }}} *)
2349
2350 let critical_edge_bound = prove_by_refinement(
2351   `!y. 0 <= (if critical_edge_y y then 1 else 0) /\ (if critical_edge_y y then 1 else 0) <= 1`,
2352   (* {{{ proof *)
2353   [
2354   REWRITE_TAC[Sphere.critical_edge_y];
2355     MESON_TAC[ARITH_RULE `0 <= 0 /\ 0 <= 1 /\ 1 <= 1`]
2356   ]);;
2357   (* }}} *)
2358
2359 (*
2360 let ztg4_concl =
2361   Sphere.all_forall `ineq
2362     [&2 * hminus,y1,&2 * hplus;
2363      (&2,y2,sqrt8);
2364      (&2,y3,sqrt8);
2365      (&2,y4,sqrt8);
2366      (&2,y5,sqrt8);
2367      (&2,y6,sqrt8)]
2368     (rad2_y y1 y2 y3 y4 y5 y6 < &2 ==>
2369     (gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun / &(wtcount6_y y1 y2 y3 y4 y5 y6) +
2370     beta_bump_y y1 y2 y3 y4 y5 y6 >
2371     a_spine5 + b_spine5 * dih_y y1 y2 y3 y4 y5 y6))`;;
2372 *)
2373
2374
2375 let ztg4_concl =
2376   Sphere.all_forall `ineq
2377     [&2 * hminus,y1,&2 * hplus;
2378      (&2,y2,sqrt8);
2379      (&2,y3,sqrt8);
2380      (&2,y4,sqrt8);
2381      (&2,y5,sqrt8);
2382      (&2,y6,sqrt8)]
2383     (rad2_y y1 y2 y3 y4 y5 y6 < &2 ==>
2384     (gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun / &(wtcount6_y y1 y2 y3 y4 y5 y6) +
2385     beta_bumpA_y y1 y2 y3 y4 y5 y6 >
2386     a_spine5 + b_spine5 * dih_y y1 y2 y3 y4 y5 y6))`;;
2387
2388
2389 (* need to include beta ge betalb,
2390    Uses gamma >= 0, when not a quarter, so throw that in, and that uses rad  *)
2391
2392 (*
2393 let ztg4_hyp =
2394   let ztgs =
2395     ["GLFVCVK4 2477216213";"MKFKQWU halfwt";"MKFKQWU";
2396      "ZTGIJCF4 1 1 1 1 1821661595"; "ZTGIJCF4 1 1 1 0 1821661595";
2397    "ZTGIJCF4 1 1 0 1 1821661595"; "ZTGIJCF4 1 1 0 0 1821661595";
2398    "ZTGIJCF4 1 0 1 1 1821661595"; "ZTGIJCF4 1 0 1 0 1821661595";
2399    "ZTGIJCF4 1 0 0 1 1821661595"; "ZTGIJCF4 1 0 0 0 1821661595";
2400    "ZTGIJCF4 0 1 1 1 1821661595"; "ZTGIJCF4 0 1 1 0 1821661595";
2401    "ZTGIJCF4 0 1 0 1 1821661595"; "ZTGIJCF4 0 1 0 0 1821661595";
2402    "ZTGIJCF4 0 0 1 1 1821661595"; "ZTGIJCF4 0 0 1 0 1821661595";
2403    "ZTGIJCF4 0 0 0 1 1821661595"; "ZTGIJCF4 0 0 0 0 1821661595"] in
2404   let ztg_nonlinear = map (fun t -> (hd(Ineq.getexact t)).ineq) ztgs in
2405     end_itlist (curry mk_conj) ztg_nonlinear;;
2406 *)
2407
2408 (*
2409 let ztg4_concl' =
2410     mk_imp(ztg4_hyp,ztg4_concl);;
2411 *)
2412
2413 let ztg4_ineqs = ["GLFVCVK4 2477216213";"MKFKQWU halfwt";"MKFKQWU";
2414      "ZTGIJCF4 1 1 1 1 1821661595"; "ZTGIJCF4 1 1 1 0 1821661595";
2415    "ZTGIJCF4 1 1 0 1 1821661595"; "ZTGIJCF4 1 1 0 0 1821661595";
2416    "ZTGIJCF4 1 0 1 1 1821661595"; "ZTGIJCF4 1 0 1 0 1821661595";
2417    "ZTGIJCF4 1 0 0 1 1821661595"; "ZTGIJCF4 1 0 0 0 1821661595";
2418    "ZTGIJCF4 0 1 1 1 1821661595"; "ZTGIJCF4 0 1 1 0 1821661595";
2419    "ZTGIJCF4 0 1 0 1 1821661595"; "ZTGIJCF4 0 1 0 0 1821661595";
2420    "ZTGIJCF4 0 0 1 1 1821661595"; "ZTGIJCF4 0 0 1 0 1821661595";
2421    "ZTGIJCF4 0 0 0 1 1821661595"; "ZTGIJCF4 0 0 0 0 1821661595"];;
2422
2423 let ztg4_concl' =
2424   add_hyp ztg4_ineqs ztg4_concl;;
2425
2426 (* let skip_prove_by_refinement(a,b) = ASSUME a;; *)
2427
2428 let ztg4 = prove_by_refinement(
2429   ztg4_concl',
2430   (* {{{ proof *)
2431   [
2432   DISCH_TAC;
2433   MATCH_MP_TAC REAL_WLOG_SIMPLEX_LEMMA2_LE;
2434   CONJ_TAC;
2435     CONJ_TAC;
2436       REPEAT GEN_TAC;
2437       SUBGOAL_THEN `rad2_y y1 y3 y2 y4 y6 y5 = rad2_y y1 y2 y3 y4 y5 y6` SUBST1_TAC;
2438         BY(BY(MESON_TAC[rad2_y_sym]));
2439       SUBGOAL_THEN `beta_bumpA_y y1 y3 y2 y4 y6 y5 = beta_bumpA_y y1 y2 y3 y4 y5 y6` SUBST1_TAC;
2440         BY(BY(REWRITE_TAC[Sphere.beta_bumpA_y;REAL_MUL_AC]));
2441       SUBGOAL_THEN `wtcount6_y y1 y3 y2 y4 y6 y5 = wtcount6_y y1 y2 y3 y4 y5 y6` SUBST1_TAC;
2442         REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
2443         BY(BY(REWRITE_TAC[ADD_AC]));
2444       SUBGOAL_THEN `dih_y y1 y3 y2 y4 y6 y5 = dih_y y1 y2 y3 y4 y5 y6` SUBST1_TAC;
2445         REWRITE_TAC[Sphere.dih_y;LET_DEF;LET_END_DEF];
2446         BY(BY(ASM_MESON_TAC[Nonlinear_lemma.dih_x_sym;Nonlinear_lemma.dih_x_sym2]));
2447       SUBGOAL_THEN `gamma4fgcy y1 y3 y2 y4 y6 y5 lmfun = gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun` SUBST1_TAC;
2448         BY(BY(MESON_TAC[gamma4fgcy_sym12;gamma4fgcy_sym23;gamma4fgcy_sym03;]));
2449       REWRITE_TAC[Sphere.ineq];
2450       BY(BY(MESON_TAC[]));
2451     REPEAT GEN_TAC;
2452     SUBGOAL_THEN `rad2_y y1 y6 y5 y4 y3 y2 = rad2_y y1 y2 y3 y4 y5 y6` SUBST1_TAC;
2453       BY(BY(MESON_TAC[rad2_y_sym]));
2454     SUBGOAL_THEN `beta_bumpA_y y1 y6 y5 y4 y3 y2 = beta_bumpA_y y1 y2 y3 y4 y5 y6` SUBST1_TAC;
2455       BY(BY(REWRITE_TAC[Sphere.beta_bumpA_y;REAL_MUL_AC]));
2456     SUBGOAL_THEN `wtcount6_y y1 y6 y5 y4 y3 y2 = wtcount6_y y1 y2 y3 y4 y5 y6` SUBST1_TAC;
2457       REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
2458       BY(BY(REWRITE_TAC[ADD_AC]));
2459     SUBGOAL_THEN `dih_y y1 y6 y5 y4 y3 y2 = dih_y y1 y2 y3 y4 y5 y6` SUBST1_TAC;
2460       REWRITE_TAC[Sphere.dih_y;LET_DEF;LET_END_DEF];
2461       BY(BY(ASM_MESON_TAC[Nonlinear_lemma.dih_x_sym;Nonlinear_lemma.dih_x_sym2]));
2462     SUBGOAL_THEN `gamma4fgcy y1 y6 y5 y4 y3 y2 lmfun = gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun` SUBST1_TAC;
2463       BY(BY(MESON_TAC[gamma4fgcy_sym12;gamma4fgcy_sym23;gamma4fgcy_sym03;]));
2464     REWRITE_TAC[Sphere.ineq];
2465     BY(BY(MESON_TAC[]));
2466   FIRST_X_ASSUM MP_TAC;
2467   REWRITE_TAC[GSYM Sphere.rad2_y];
2468   REPEAT WEAK_STRIP_TAC;
2469   REWRITE_TAC[Sphere.ineq];
2470   REPEAT DISCH_TAC;
2471   REPEAT (FIRST_X_ASSUM_ST `/\` MP_TAC);
2472   REWRITE_TAC[GSYM Nonlinear_lemma.ineq_expand6];
2473   REWRITE_TAC[Sphere.ineq];
2474   REPEAT DISCH_TAC;
2475   SUBGOAL_THEN `critical_edge_y y1` ASSUME_TAC;
2476     BY(ASM_SIMP_TAC[critical_y_range]);
2477   REPLICATE_TAC 6 (FIRST_X_ASSUM_ST `/\` MP_TAC);
2478   REWRITE_TAC[GSYM Nonlinear_lemma.ineq_expand6];
2479   FIRST_X_ASSUM_ST `gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun > &0` (MP_TAC o (ISPECL ys));
2480   ASM_REWRITE_TAC[];
2481   DISCH_TAC;
2482   REWRITE_TAC[Sphere.ineq];
2483   REPLICATE_TAC 6 (DISCH_THEN (COMBINE_TAC BURY_TAC ASSUME_TAC));
2484   REPLICATE_TAC 6 (FIRST_X_ASSUM MP_TAC);
2485   REWRITE_TAC[GSYM Nonlinear_lemma.ineq_expand6];
2486   PROOF_BY_CONTR_TAC;
2487   FIRST_X_ASSUM_ST `rad2_y` MP_TAC;
2488   ASM_REWRITE_TAC[Sphere.ineq];
2489   ASM_SIMP_TAC[arith `x < &2 ==> ~(x > &2)`];
2490   DISCH_TAC;
2491   SUBGOAL_THEN `(&2*hminus <= y3 \/ &2 * hminus <= y4 \/ &2 * hminus <= y5 \/ &2*hminus <= y6 ==> gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun > &0)` ASSUME_TAC;
2492     FIRST_X_ASSUM MP_TAC;
2493     BY(MESON_TAC[quarter_norm2hh;arith `x <= y <=> ~(y < x)`]);
2494   FIRST_X_ASSUM_ST `~` MP_TAC;
2495   REWRITE_TAC[];
2496   CHOP_LIST_TAC 1;
2497   MATCH_MP_TAC ineq_branch_2hmin;
2498   REWRITE_TAC[APPEND;hmin22];
2499   ONCE_REWRITE_TAC[CONJ_SYM];
2500   CONJ_TAC;
2501     FIRST_X_ASSUM_ST `rad2_y` MP_TAC;
2502     FIRST_X_ASSUM_ST `ineq a (rad2_y y1 y2 y3 y4 y5 y6 > &2)` (fun t -> MP_TAC (ISPECL ys t ));
2503     REPEAT (FIRST_X_ASSUM_ST `a <= b` MP_TAC);
2504     REWRITE_TAC[Sphere.ineq];
2505     BY(REAL_ARITH_TAC);
2506   DISCH_TAC;
2507   SUBGOAL_THEN `~(rad2_y y1 y2 y3 y4 y5 y6 > &2)` ASSUME_TAC;
2508     FIRST_X_ASSUM_ST `rad2_y` MP_TAC;
2509     BY(REAL_ARITH_TAC);
2510   COMMENT" start on branch with y4 ";
2511   CHOP_LIST_TAC 3;
2512   MATCH_MP_TAC ineq_branch_2hmin;
2513   REWRITE_TAC[hmin22;APPEND];
2514   ONCE_REWRITE_TAC[CONJ_SYM];
2515   CONJ_TAC;
2516     REWRITE_TAC[Sphere.ineq];
2517     REPLICATE_TAC 3 DISCH_TAC;
2518     DISCH_THEN (COMBINE_TAC BURY_TAC ASSUME_TAC);
2519     REPLICATE_TAC 4 (FIRST_X_ASSUM MP_TAC);
2520     REWRITE_TAC[GSYM Nonlinear_lemma.ineq_expand6];
2521     SUBGOAL_THEN `(y3 <= &2 * hplus /\ y5 <= &2 * hplus /\ y6 <= &2 * hplus)` MP_TAC THEN REPEAT WEAK_STRIP_TAC;
2522       FIRST_X_ASSUM_ST `ineq a (rad2_y y1 y2 y3 y4 y5 y6 > &2)` BURY_TAC;
2523       CONJ_TAC;
2524         MATCH_MP_TAC (arith `~(x <= y3) ==> (y3 <= x)`);
2525         DISCH_TAC;
2526         FIRST_X_ASSUM_ST `ineq a (rad2_y y1 y2 y3 y4 y5 y6 > &2)` (fun t -> MP_TAC (ISPECL [y1;y3;y2;y4;y6;y5] t));
2527         REWRITE_TAC[Sphere.ineq];
2528         ASM_REWRITE_TAC[];
2529         SUBGOAL_THEN `rad2_y y1 y3 y2 y4 y6 y5 = rad2_y y1 y2 y3 y4 y5 y6` SUBST1_TAC;
2530           BY(MESON_TAC[rad2_y_sym]);
2531         BY(ASM_REWRITE_TAC[]);
2532       CONJ_TAC;
2533         MATCH_MP_TAC (arith `~(x <= y3) ==> (y3 <= x)`);
2534         DISCH_TAC;
2535         FIRST_X_ASSUM_ST `ineq a (rad2_y y1 y2 y3 y4 y5 y6 > &2)` (fun t -> MP_TAC (ISPECL [y1;y5;y6;y4;y2;y3] t));
2536         REWRITE_TAC[Sphere.ineq];
2537         ASM_REWRITE_TAC[];
2538         SUBGOAL_THEN `rad2_y y1 y5 y6 y4 y2 y3 = rad2_y y1 y2 y3 y4 y5 y6` SUBST1_TAC;
2539           BY(MESON_TAC[rad2_y_sym]);
2540         BY(ASM_REWRITE_TAC[]);
2541       MATCH_MP_TAC (arith `~(x <= y3) ==> (y3 <= x)`);
2542       DISCH_TAC;
2543       FIRST_X_ASSUM_ST `ineq a (rad2_y y1 y2 y3 y4 y5 y6 > &2)` (fun t -> MP_TAC (ISPECL [y1;y6;y5;y4;y3;y2] t));
2544       REWRITE_TAC[Sphere.ineq];
2545       ASM_REWRITE_TAC[];
2546       SUBGOAL_THEN `rad2_y y1 y6 y5 y4 y3 y2 = rad2_y y1 y2 y3 y4 y5 y6` SUBST1_TAC;
2547         BY(MESON_TAC[rad2_y_sym]);
2548       BY(ASM_REWRITE_TAC[]);
2549     COMMENT "2nd rad ineq here";
2550     CHOP_LIST_TAC 2 THEN MATCH_MP_TAC ineq_branch_2hmin THEN REWRITE_TAC[hmin22;APPEND] THEN CONJ_TAC THEN TRY DISCH_TAC THEN CHOP_LIST_TAC 4 THEN MATCH_MP_TAC ineq_branch_2hmin THEN REWRITE_TAC[hmin22;APPEND] THEN CONJ_TAC THEN TRY DISCH_TAC THEN CHOP_LIST_TAC 5 THEN MATCH_MP_TAC ineq_branch_2hmin THEN REWRITE_TAC[hmin22;APPEND] THEN CONJ_TAC THEN TRY DISCH_TAC THEN FIRST_X_ASSUM (fun t -> (MP_TAC (SPECL ys t) THEN MATCH_MP_TAC ineq_approxA_ztg4));
2551                   COMMENT " 1st case ";
2552                   ASM_REWRITE_TAC[Sphere.ineq;beta_bumpA_lb1];
2553                   REPEAT WEAK_STRIP_TAC;
2554                   MATCH_MP_TAC gamma_wt;
2555                   ASM_SIMP_TAC[];
2556                   ASM_REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
2557                   MP_TAC (ISPEC `y4:real` critical_edge_bound);
2558                   BY(ARITH_TAC);
2559                 COMMENT " 2nd case ";
2560                 ASM_REWRITE_TAC[];
2561                 MATCH_MP_TAC ineq_CONJ;
2562                 CONJ_TAC;
2563                   REWRITE_TAC[Sphere.ineq];
2564                   REPEAT WEAK_STRIP_TAC;
2565                   MATCH_MP_TAC gamma_wt;
2566                   ASM_SIMP_TAC[];
2567                   ASM_REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
2568                   MP_TAC (ISPEC y4 critical_edge_bound);
2569                   MP_TAC (ISPEC y6 critical_edge_bound);
2570                   BY(ARITH_TAC);
2571                 REWRITE_TAC[Sphere.ineq];
2572                 REPEAT WEAK_STRIP_TAC;
2573                 MATCH_MP_TAC beta_bumpA_lb0;
2574                 BY(ASM_SIMP_TAC[critical_y_range]);
2575               COMMENT " 3rd case ";
2576               ASM_REWRITE_TAC[];
2577               MATCH_MP_TAC ineq_CONJ;
2578               CONJ_TAC;
2579                 REWRITE_TAC[Sphere.ineq];
2580                 REPEAT WEAK_STRIP_TAC;
2581                 MATCH_MP_TAC gamma_wt;
2582                 ASM_SIMP_TAC[];
2583                 ASM_REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
2584                 MP_TAC (ISPEC y4 critical_edge_bound);
2585                 MP_TAC (ISPEC y5 critical_edge_bound);
2586                 BY(ARITH_TAC);
2587               REWRITE_TAC[Sphere.ineq];
2588               REPEAT WEAK_STRIP_TAC;
2589               MATCH_MP_TAC beta_bumpA_lb0;
2590               BY(ASM_SIMP_TAC[critical_y_range]);
2591             COMMENT " 4th case ";
2592             ASM_REWRITE_TAC[];
2593             MATCH_MP_TAC ineq_CONJ;
2594             CONJ_TAC;
2595               REWRITE_TAC[Sphere.ineq];
2596               REPEAT WEAK_STRIP_TAC;
2597               MATCH_MP_TAC gamma_wt;
2598               ASM_SIMP_TAC[];
2599               ASM_REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
2600               MP_TAC (ISPEC y4 critical_edge_bound);
2601               MP_TAC (ISPEC y5 critical_edge_bound);
2602               MP_TAC (ISPEC y6 critical_edge_bound);
2603               BY(ARITH_TAC);
2604             REWRITE_TAC[Sphere.ineq];
2605             REPEAT WEAK_STRIP_TAC;
2606             MATCH_MP_TAC beta_bumpA_lb0;
2607             BY(ASM_SIMP_TAC[critical_y_range]);
2608           COMMENT " 5th case ";
2609           ASM_REWRITE_TAC[];
2610           MATCH_MP_TAC ineq_CONJ;
2611           CONJ_TAC;
2612             REWRITE_TAC[Sphere.ineq];
2613             REPEAT WEAK_STRIP_TAC;
2614             MATCH_MP_TAC gamma_wt;
2615             ASM_SIMP_TAC[];
2616             ASM_REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
2617             MP_TAC (ISPEC y3 critical_edge_bound);
2618             MP_TAC (ISPEC y4 critical_edge_bound);
2619             BY(ARITH_TAC);
2620           REWRITE_TAC[Sphere.ineq];
2621           REPEAT WEAK_STRIP_TAC;
2622           MATCH_MP_TAC beta_bumpA_lb0;
2623           BY(ASM_SIMP_TAC[critical_y_range]);
2624         COMMENT "6th case";
2625         ASM_REWRITE_TAC[];
2626         MATCH_MP_TAC ineq_CONJ;
2627         CONJ_TAC;
2628           REWRITE_TAC[Sphere.ineq];
2629           REPEAT WEAK_STRIP_TAC;
2630           MATCH_MP_TAC gamma_wt;
2631           ASM_SIMP_TAC[];
2632           ASM_REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
2633           MP_TAC (ISPEC y3 critical_edge_bound);
2634           MP_TAC (ISPEC y4 critical_edge_bound);
2635           MP_TAC (ISPEC y6 critical_edge_bound);
2636           BY(ARITH_TAC);
2637         REWRITE_TAC[Sphere.ineq];
2638         REPEAT WEAK_STRIP_TAC;
2639         MATCH_MP_TAC beta_bumpA_lb0;
2640         BY(ASM_SIMP_TAC[critical_y_range]);
2641       COMMENT "7th case";
2642       ASM_REWRITE_TAC[];
2643       MATCH_MP_TAC ineq_CONJ;
2644       CONJ_TAC;
2645         REWRITE_TAC[Sphere.ineq];
2646         REPEAT WEAK_STRIP_TAC;
2647         MATCH_MP_TAC gamma_wt;
2648         ASM_SIMP_TAC[];
2649         ASM_REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
2650         MP_TAC (ISPEC y3 critical_edge_bound);
2651         MP_TAC (ISPEC y4 critical_edge_bound);
2652         MP_TAC (ISPEC y5 critical_edge_bound);
2653         BY(ARITH_TAC);
2654       REWRITE_TAC[Sphere.ineq];
2655       REPEAT WEAK_STRIP_TAC;
2656       MATCH_MP_TAC beta_bumpA_lb0;
2657       BY(ASM_SIMP_TAC[critical_y_range]);
2658     COMMENT "8th case";
2659     ASM_REWRITE_TAC[];
2660     MATCH_MP_TAC ineq_CONJ;
2661     CONJ_TAC;
2662       REWRITE_TAC[Sphere.ineq];
2663       REPEAT WEAK_STRIP_TAC;
2664       MATCH_MP_TAC gamma_wt;
2665       ASM_SIMP_TAC[];
2666       ASM_REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
2667       MP_TAC (ISPEC y3 critical_edge_bound);
2668       MP_TAC (ISPEC y4 critical_edge_bound);
2669       MP_TAC (ISPEC y5 critical_edge_bound);
2670       MP_TAC (ISPEC y6 critical_edge_bound);
2671       BY(ARITH_TAC);
2672     REWRITE_TAC[Sphere.ineq];
2673     REPEAT WEAK_STRIP_TAC;
2674     MATCH_MP_TAC beta_bumpA_lb0;
2675     BY(ASM_SIMP_TAC[critical_y_range]);
2676   DISCH_TAC;
2677   CHOP_LIST_TAC 2 THEN MATCH_MP_TAC ineq_branch_2hmin THEN REWRITE_TAC[hmin22;APPEND] THEN CONJ_TAC THEN TRY DISCH_TAC THEN CHOP_LIST_TAC 4 THEN MATCH_MP_TAC ineq_branch_2hmin THEN REWRITE_TAC[hmin22;APPEND] THEN CONJ_TAC THEN TRY DISCH_TAC THEN CHOP_LIST_TAC 5 THEN MATCH_MP_TAC ineq_branch_2hmin THEN REWRITE_TAC[hmin22;APPEND] THEN CONJ_TAC THEN TRY DISCH_TAC THEN FIRST_X_ASSUM (fun t -> (MP_TAC (SPECL ys t) THEN MATCH_MP_TAC ineq_approxA_ztg4));
2678                 COMMENT "1st' case";
2679                 ASM_REWRITE_TAC[];
2680                 MATCH_MP_TAC ineq_CONJ;
2681                 CONJ_TAC;
2682                   REWRITE_TAC[Sphere.ineq];
2683                   REPEAT WEAK_STRIP_TAC;
2684                   MATCH_MP_TAC gamma_wte;
2685                   ASM_REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
2686                   BY(ARITH_TAC);
2687                 REWRITE_TAC[Sphere.ineq];
2688                 REPEAT WEAK_STRIP_TAC;
2689                 MATCH_MP_TAC beta_bumpA_lb0;
2690                 BY(ASM_SIMP_TAC[critical_y_range]);
2691               COMMENT "2nd' case";
2692               ASM_REWRITE_TAC[];
2693               MATCH_MP_TAC ineq_CONJ;
2694               CONJ_TAC;
2695                 REWRITE_TAC[Sphere.ineq];
2696                 REPEAT WEAK_STRIP_TAC;
2697                 MATCH_MP_TAC gamma_wt;
2698                 ASM_SIMP_TAC[];
2699                 ASM_REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
2700                 MP_TAC (ISPEC y6 critical_edge_bound);
2701                 BY(ARITH_TAC);
2702               REWRITE_TAC[Sphere.ineq];
2703               REPEAT WEAK_STRIP_TAC;
2704               MATCH_MP_TAC beta_bumpA_lb0;
2705               BY(ASM_REWRITE_TAC[]);
2706             COMMENT "3rd' case";
2707             ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ineq_CONJ THEN CONJ_TAC THEN REWRITE_TAC[Sphere.ineq] THEN REPEAT WEAK_STRIP_TAC;
2708               MATCH_MP_TAC gamma_wt THEN ASM_SIMP_TAC[] THEN ASM_REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
2709               MP_TAC (ISPEC y5 critical_edge_bound);
2710               BY(ARITH_TAC);
2711             BY(MATCH_MP_TAC beta_bumpA_lb0 THEN ASM_REWRITE_TAC[]);
2712           COMMENT "4th' case";
2713           ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ineq_CONJ THEN CONJ_TAC THEN REWRITE_TAC[Sphere.ineq] THEN REPEAT WEAK_STRIP_TAC;
2714             MATCH_MP_TAC gamma_wt THEN ASM_SIMP_TAC[] THEN ASM_REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
2715             MP_TAC (ISPEC y5 critical_edge_bound);
2716             MP_TAC (ISPEC y6 critical_edge_bound);
2717             BY(ARITH_TAC);
2718           BY(MATCH_MP_TAC beta_bumpA_lb0 THEN ASM_REWRITE_TAC[]);
2719         COMMENT "5th' case";
2720         ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ineq_CONJ THEN CONJ_TAC THEN REWRITE_TAC[Sphere.ineq] THEN REPEAT WEAK_STRIP_TAC;
2721           MATCH_MP_TAC gamma_wt THEN ASM_SIMP_TAC[] THEN ASM_REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
2722           MP_TAC (ISPEC y3 critical_edge_bound);
2723           BY(ARITH_TAC);
2724         BY(MATCH_MP_TAC beta_bumpA_lb0 THEN ASM_REWRITE_TAC[]);
2725       COMMENT "6th' case";
2726       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ineq_CONJ THEN CONJ_TAC THEN REWRITE_TAC[Sphere.ineq] THEN REPEAT WEAK_STRIP_TAC;
2727         MATCH_MP_TAC gamma_wt THEN ASM_SIMP_TAC[] THEN ASM_REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
2728         MP_TAC (ISPEC y3 critical_edge_bound);
2729         MP_TAC (ISPEC y6 critical_edge_bound);
2730         BY(ARITH_TAC);
2731       BY(MATCH_MP_TAC beta_bumpA_lb0 THEN ASM_REWRITE_TAC[]);
2732     COMMENT "7th' case";
2733     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ineq_CONJ THEN CONJ_TAC THEN REWRITE_TAC[Sphere.ineq] THEN REPEAT WEAK_STRIP_TAC;
2734       MATCH_MP_TAC gamma_wt THEN ASM_SIMP_TAC[] THEN ASM_REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
2735       MP_TAC (ISPEC y3 critical_edge_bound);
2736       MP_TAC (ISPEC y5 critical_edge_bound);
2737       BY(ARITH_TAC);
2738     BY(MATCH_MP_TAC beta_bumpA_lb0 THEN ASM_REWRITE_TAC[]);
2739   COMMENT "8th' case";
2740   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ineq_CONJ THEN CONJ_TAC THEN REWRITE_TAC[Sphere.ineq] THEN REPEAT WEAK_STRIP_TAC;
2741     MATCH_MP_TAC gamma_wt THEN ASM_SIMP_TAC[] THEN ASM_REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
2742     MP_TAC (ISPEC y3 critical_edge_bound);
2743     MP_TAC (ISPEC y5 critical_edge_bound);
2744     MP_TAC (ISPEC y6 critical_edge_bound);
2745     BY(ARITH_TAC);
2746   BY(MATCH_MP_TAC beta_bumpA_lb0 THEN ASM_REWRITE_TAC[])
2747   ]);;
2748   (* }}} *)
2749
2750 let ztg4_ALT = prove_by_refinement(
2751   `pack_nonlinear_non_ox3q1h ==>
2752 !y1 y2 y3 y4 y5 y6.
2753        ineq
2754        [&2 * hminus,y1,&2 * hplus; &2,y2,sqrt8; &2,y3,sqrt8; &2,y4,sqrt8;
2755        &2,
2756        y5,
2757        sqrt8; &2,y6,sqrt8]
2758        (rad2_y y1 y2 y3 y4 y5 y6 < &2
2759         ==> gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun /
2760             &(wtcount6_y y1 y2 y3 y4 y5 y6) +
2761             beta_bumpA_y y1 y2 y3 y4 y5 y6 >
2762             a_spine5 + b_spine5 * dih_y y1 y2 y3 y4 y5 y6)`,
2763   (* {{{ proof *)
2764   [
2765   REPEAT WEAKER_STRIP_TAC;
2766   MP_TAC ztg4;
2767   ANTS_TAC;
2768     BY(ASM_REWRITE_TAC (map get_pack_nonlinear_non_ox3q1h ztg4_ineqs));
2769   BY(DISCH_THEN (unlist REWRITE_TAC))
2770   ]);;
2771   (* }}} *)
2772
2773
2774 (* ========================================================================== *)
2775 (* lindih inequalities *)
2776 (* ========================================================================== *)
2777
2778 let lindih_lt = prove_by_refinement(
2779   `!u x1 x2 x3 x4 x5 x6. abs u < pi/ & 2 /\
2780     &0 < x1 /\
2781     &0 < delta_x4 x1 x2 x3 x4 x5 x6 ==> (dih_x x1 x2 x3 x4 x5 x6 < u <=>
2782     sqrt(&4 * x1 * delta_x x1 x2 x3 x4 x5 x6) <
2783     tan(u) * delta_x4 x1 x2 x3 x4 x5 x6)`,
2784   (* {{{ proof *)
2785   [
2786   REPEAT WEAK_STRIP_TAC;
2787   REWRITE_TAC[Sphere.dih_x;LET_DEF;LET_END_DEF];
2788   GMATCH_SIMP_TAC (MESON[Trigonometry1.ATN2_BREAKDOWN] `y < &0 ==> atn2(x,y) = --(pi/ &2) - atn(x/y)`);
2789   ASM_REWRITE_TAC[arith `-- x < &0 <=> &0 < x`;arith `pi / &2 + -- (pi/ &2) - x = -- x`];
2790   REWRITE_TAC[real_div;REAL_INV_NEG;arith `x * -- y = --(x * y)`;ATN_NEG;arith `-- (-- x) = x`];
2791   ABBREV_TAC `t = sqrt (&4 * x1 * delta_x x1 x2 x3 x4 x5 x6) <  tan u * delta_x4 x1 x2 x3 x4 x5 x6`;
2792   GMATCH_SIMP_TAC (GSYM TAN_MONO_LT_EQ);
2793   REWRITE_TAC[ATN_TAN;ATN_BOUNDS];
2794   CONJ_TAC;
2795     FIRST_X_ASSUM_ST `abs` MP_TAC;
2796     BY(REAL_ARITH_TAC);
2797   REWRITE_TAC[GSYM real_div];
2798   GMATCH_SIMP_TAC REAL_LT_LDIV_EQ;
2799   BY(ASM_REWRITE_TAC[])
2800   ]);;
2801   (* }}} *)
2802
2803 let lindih_gt = prove_by_refinement(
2804   `!u x1 x2 x3 x4 x5 x6. abs u < pi/ & 2 /\
2805     &0 < x1 /\
2806     &0 < delta_x4 x1 x2 x3 x4 x5 x6 ==> (u < dih_x x1 x2 x3 x4 x5 x6 <=>
2807      (tan(u) * delta_x4 x1 x2 x3 x4 x5 x6) < sqrt(&4 * x1 * delta_x x1 x2 x3 x4 x5 x6))   `,
2808   (* {{{ proof *)
2809   [
2810   REPEAT WEAK_STRIP_TAC;
2811   REWRITE_TAC[Sphere.dih_x;LET_DEF;LET_END_DEF];
2812   GMATCH_SIMP_TAC (MESON[Trigonometry1.ATN2_BREAKDOWN] `y < &0 ==> atn2(x,y) = --(pi/ &2) - atn(x/y)`);
2813   ASM_REWRITE_TAC[arith `-- x < &0 <=> &0 < x`;arith `pi / &2 + -- (pi/ &2) - x = -- x`];
2814   REWRITE_TAC[real_div;REAL_INV_NEG;arith `x * -- y = --(x * y)`;ATN_NEG;arith `-- (-- x) = x`];
2815   ABBREV_TAC `t =  tan u * delta_x4 x1 x2 x3 x4 x5 x6 < sqrt (&4 * x1 * delta_x x1 x2 x3 x4 x5 x6)`;
2816   GMATCH_SIMP_TAC (GSYM TAN_MONO_LT_EQ);
2817   REWRITE_TAC[ATN_TAN;ATN_BOUNDS];
2818   CONJ_TAC;
2819     FIRST_X_ASSUM_ST `abs` MP_TAC;
2820     BY(REAL_ARITH_TAC);
2821   REWRITE_TAC[GSYM real_div];
2822   GMATCH_SIMP_TAC REAL_LT_RDIV_EQ;
2823   BY(ASM_REWRITE_TAC[])
2824   ]);;
2825   (* }}} *)
2826
2827 let lindihpi_lt = prove_by_refinement(
2828   `!u x1 x2 x3 x4 x5 x6. abs u < pi/ & 2 /\
2829     &0 < x1 /\
2830      delta_x4 x1 x2 x3 x4 x5 x6 < &0 ==> (dih_x x1 x2 x3 x4 x5 x6 < pi - u <=>
2831     -- tan(u) * delta_x4 x1 x2 x3 x4 x5 x6 < sqrt(&4 * x1 * delta_x x1 x2 x3 x4 x5 x6)
2832     )`,
2833   (* {{{ proof *)
2834   [
2835   REPEAT WEAK_STRIP_TAC;
2836   REWRITE_TAC[Sphere.dih_x;LET_DEF;LET_END_DEF];
2837   GMATCH_SIMP_TAC (MESON[Trigonometry1.ATN2_BREAKDOWN] `&0 < y ==> atn2(x,y) = (pi/ &2) - atn(x/y)`);
2838   ASM_REWRITE_TAC[arith `&0 < --x <=> x < &0`;arith `pi / &2 + (pi/ &2) - x = pi - x`];
2839   ABBREV_TAC `t = --tan u * delta_x4 x1 x2 x3 x4 x5 x6 <  sqrt (&4 * x1 * delta_x x1 x2 x3 x4 x5 x6)`;
2840   REWRITE_TAC[arith `pi - t < pi - u <=> u < t`];
2841   GMATCH_SIMP_TAC (GSYM TAN_MONO_LT_EQ);
2842   REWRITE_TAC[ATN_TAN;ATN_BOUNDS];
2843   CONJ_TAC;
2844     FIRST_X_ASSUM_ST `abs` MP_TAC;
2845     BY(BY(REAL_ARITH_TAC));
2846   GMATCH_SIMP_TAC REAL_LT_RDIV_EQ;
2847   ASM_REWRITE_TAC[arith `&0 < --x <=> x < &0`];
2848   EXPAND_TAC "t";
2849   BY(REAL_ARITH_TAC)
2850   ]);;
2851   (* }}} *)
2852
2853 let lindihpi_gt = prove_by_refinement(
2854   `!u x1 x2 x3 x4 x5 x6. abs u < pi/ & 2 /\
2855     &0 < x1 /\
2856      delta_x4 x1 x2 x3 x4 x5 x6 < &0 ==> ( pi - u < dih_x x1 x2 x3 x4 x5 x6  <=>
2857     (sqrt(&4 * x1 * delta_x x1 x2 x3 x4 x5 x6)  < -- tan(u) * delta_x4 x1 x2 x3 x4 x5 x6
2858     ))`,
2859   (* {{{ proof *)
2860   [
2861   REPEAT WEAK_STRIP_TAC;
2862   REWRITE_TAC[Sphere.dih_x;LET_DEF;LET_END_DEF];
2863   GMATCH_SIMP_TAC (MESON[Trigonometry1.ATN2_BREAKDOWN] `&0 < y ==> atn2(x,y) = (pi/ &2) - atn(x/y)`);
2864   ASM_REWRITE_TAC[arith `&0 < --x <=> x < &0`;arith `pi / &2 + (pi/ &2) - x = pi - x`];
2865   ABBREV_TAC `t = sqrt (&4 * x1 * delta_x x1 x2 x3 x4 x5 x6) <  --tan u * delta_x4 x1 x2 x3 x4 x5 x6`;
2866   REWRITE_TAC[arith `pi - t < pi - u <=> u < t`];
2867   GMATCH_SIMP_TAC (GSYM TAN_MONO_LT_EQ);
2868   REWRITE_TAC[ATN_TAN;ATN_BOUNDS];
2869   CONJ_TAC;
2870     FIRST_X_ASSUM_ST `abs` MP_TAC;
2871     BY(BY(BY(REAL_ARITH_TAC)));
2872   GMATCH_SIMP_TAC REAL_LT_LDIV_EQ;
2873   ASM_REWRITE_TAC[arith `&0 < --x <=> x < &0`];
2874   EXPAND_TAC "t";
2875   BY(BY(REAL_ARITH_TAC))
2876   ]);;
2877   (* }}} *)
2878
2879 let dih_gt_pi2 = prove_by_refinement(
2880   `!x1 x2 x3 x4 x5 x6. &0 < x1 /\
2881     &0 < delta_x x1 x2 x3 x4 x5 x6 /\
2882     pi / &2 < dih_x x1 x2 x3 x4 x5 x6 ==> delta_x4 x1 x2 x3 x4 x5 x6 < &0`,
2883   (* {{{ proof *)
2884   [
2885   REWRITE_TAC[Sphere.dih_x;LET_DEF;LET_END_DEF];
2886   REWRITE_TAC[arith `x < x + y <=> &0 < y`];
2887   REPEAT WEAKER_STRIP_TAC;
2888   TYPIFY `&0 < sqrt(&4 * x1 * delta_x x1 x2 x3 x4 x5 x6)` (C SUBGOAL_THEN ASSUME_TAC);
2889     GMATCH_SIMP_TAC REAL_LT_RSQRT;
2890     REWRITE_TAC[arith `&0 pow 2 = &0`];
2891     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
2892     REWRITE_TAC[arith `&0 < &4`];
2893     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
2894     BY(ASM_REWRITE_TAC[]);
2895   FIRST_X_ASSUM_ST `atn2` MP_TAC;
2896   ASM_SIMP_TAC[ATN2_POS];
2897   BY(REAL_ARITH_TAC)
2898   ]);;
2899   (* }}} *)
2900
2901 let lindihpi_lt_y = prove_by_refinement(
2902   `!a y1 y2 y3 y4 y5 y6.
2903     &0 < y1 /\
2904     &0 < a /\
2905     &0 < delta_y y1 y2 y3 y4 y5 y6 /\
2906     delta4_y y1 y2 y3 y4 y5 y6 < &0 ==>
2907     (dih_y y1 y2 y3 y4 y5 y6 < pi - atn a <=>
2908     a pow 2 * delta4_squared_y y1 y2 y3 y4 y5 y6 <  &4 * x1_delta_y y1 y2 y3 y4 y5 y6
2909     )`,
2910   (* {{{ proof *)
2911   [
2912   REWRITE_TAC[Sphere.delta_y;Sphere.delta4_y;Sphere.dih_y;LET_DEF;LET_END_DEF;Sphere.delta4_squared_y;Sphere.x1_delta_y;Sphere.y_of_x;Sphere.delta4_squared_x;Sphere.x1_delta_x];
2913   REPEAT WEAKER_STRIP_TAC;
2914   INTRO_TAC lindihpi_lt [`atn a`;`y1 * y1`;`y2*y2`;`y3*y3`;`y4*y4`;`y5*y5`;`y6*y6`];
2915   ASM_REWRITE_TAC[ATN_BOUND];
2916   ANTS_TAC;
2917     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
2918     BY(ASM_REWRITE_TAC[]);
2919   REWRITE_TAC[ATN_TAN];
2920   DISCH_THEN SUBST1_TAC;
2921   TYPED_ABBREV_TAC `s =  (&4 *  (y1 * y1) *  delta_x (y1 * y1) (y2 * y2) (y3 * y3) (y4 * y4) (y5 * y5) (y6 * y6))` ;
2922   TYPIFY `&0 < s` (C SUBGOAL_THEN ASSUME_TAC);
2923     EXPAND_TAC "s";
2924     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
2925     REWRITE_TAC[arith `&0 < &4`];
2926     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
2927     ASM_REWRITE_TAC[];
2928     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
2929     BY(ASM_REWRITE_TAC[]);
2930   TYPIFY `!d. (d < s <=> d < sqrt s pow 2)` (C SUBGOAL_THEN (unlist REWRITE_TAC));
2931     BY(ASM_SIMP_TAC[SQRT_POW_2;arith `&0 < s ==> &0 <= s`]);
2932   REWRITE_TAC[arith `a pow 2 * d pow 2 = ( a * -- d) pow 2`];
2933   GMATCH_SIMP_TAC (GSYM Collect_geom2.LT_POW2_EQ_LT);
2934   REWRITE_TAC[arith `-- a * d = a * --d`];
2935   CONJ2_TAC;
2936     GMATCH_SIMP_TAC REAL_LT_RSQRT;
2937     BY(FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC);
2938   GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
2939   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
2940   ]);;
2941   (* }}} *)
2942
2943 let lindihpi_gt_y = prove_by_refinement(
2944   `!a y1 y2 y3 y4 y5 y6.
2945     &0 < y1 /\
2946     &0 < a /\
2947     &0 < delta_y y1 y2 y3 y4 y5 y6 /\
2948     delta4_y y1 y2 y3 y4 y5 y6 < &0 ==>
2949     (pi - atn a < dih_y y1 y2 y3 y4 y5 y6  <=>
2950      &4 * x1_delta_y y1 y2 y3 y4 y5 y6  < a pow 2 * delta4_squared_y y1 y2 y3 y4 y5 y6
2951     )`,
2952   (* {{{ proof *)
2953   [
2954   REWRITE_TAC[Sphere.delta_y;Sphere.delta4_y;Sphere.dih_y;LET_DEF;LET_END_DEF;Sphere.delta4_squared_y;Sphere.x1_delta_y;Sphere.y_of_x;Sphere.delta4_squared_x;Sphere.x1_delta_x];
2955   REPEAT WEAKER_STRIP_TAC;
2956   INTRO_TAC lindihpi_gt [`atn a`;`y1 * y1`;`y2*y2`;`y3*y3`;`y4*y4`;`y5*y5`;`y6*y6`];
2957   ASM_REWRITE_TAC[ATN_BOUND];
2958   ANTS_TAC;
2959     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
2960     BY(ASM_REWRITE_TAC[]);
2961   REWRITE_TAC[ATN_TAN];
2962   DISCH_THEN SUBST1_TAC;
2963   TYPED_ABBREV_TAC  `s =  (&4 *  (y1 * y1) *  delta_x (y1 * y1) (y2 * y2) (y3 * y3) (y4 * y4) (y5 * y5) (y6 * y6))` ;
2964   TYPIFY `&0 < s` (C SUBGOAL_THEN ASSUME_TAC);
2965     EXPAND_TAC "s";
2966     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
2967     REWRITE_TAC[arith `&0 < &4`];
2968     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
2969     ASM_REWRITE_TAC[];
2970     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
2971     BY(ASM_REWRITE_TAC[]);
2972   TYPIFY `!d. (s < d <=> sqrt s pow 2 < d)` (C SUBGOAL_THEN (unlist REWRITE_TAC));
2973     BY(ASM_SIMP_TAC[SQRT_POW_2;arith `&0 < s ==> &0 <= s`]);
2974   REWRITE_TAC[arith `a pow 2 * d pow 2 = ( a * -- d) pow 2`];
2975   GMATCH_SIMP_TAC (GSYM Collect_geom2.LT_POW2_EQ_LT);
2976   REWRITE_TAC[arith `-- a * d = a * --d`];
2977   CONJ_TAC;
2978     GMATCH_SIMP_TAC REAL_LT_RSQRT;
2979     BY(FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC);
2980   GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
2981   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
2982   ]);;
2983   (* }}} *)
2984
2985
2986 (* ========================================================================== *)
2987 (* 3-cell inequality: gamma3f is non-negative.  Also 1-cell and 2-cells       *)
2988 (* ========================================================================== *)
2989
2990
2991 let cell_3_delta_x_eta_x = prove_by_refinement(
2992   `!x4 x5 x6. (&0 < x4) /\ (&0 < x5) /\ (&0 < x6) /\ (&0 < ups_x x4 x5 x6) ==>
2993      ((&0 < delta_x (&2) (&2) (&2) x4 x5 x6) <=> ( eta_x x4 x5 x6 < sqrt2))`,
2994   (* {{{ proof *)
2995   [
2996   REPEAT WEAK_STRIP_TAC;
2997   REWRITE_TAC[delta_delta_x];
2998   REWRITE_TAC[GSYM delta_delta_x;Collect_geom.DELTA_RRR_INTERPRETE;Sphere.eta_x];
2999   REWRITE_TAC[Sphere.sqrt2];
3000   GMATCH_SIMP_TAC SQRT_MONO_LT_EQ;
3001   GMATCH_SIMP_TAC REAL_LT_LDIV_EQ;
3002   ASM_REWRITE_TAC[ arith `&0 <= &2`];
3003   CONJ2_TAC;
3004     REWRITE_TAC[Sphere.ups_x];
3005     BY(REAL_ARITH_TAC);
3006   MATCH_MP_TAC REAL_LE_DIV;
3007   ASM_SIMP_TAC[ arith `&0 < x ==> &0 <= x`];
3008   MATCH_MP_TAC (arith `&0 < x ==> &0 <= x`);
3009   BY(REPEAT (MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]))
3010   ]);;
3011   (* }}} *)
3012
3013 let lmfun_h0cut = prove_by_refinement(
3014   `!y. lmfun (y / &2) = lfun (y / &2) * h0cut y `,
3015   (* {{{ proof *)
3016   [
3017   REWRITE_TAC[Sphere.lmfun;Sphere.lfun;Sphere.h0cut];
3018   GEN_TAC;
3019   ASSUME_TAC (arith `y <= &2 * h0 <=> (y / &2 <= h0)`);
3020   COND_CASES_TAC;
3021     BY(ASM_SIMP_TAC[arith `x * &1 = x`]);
3022   BY(ASM_MESON_TAC[ arith `x * &0 = &0`])
3023   ]);;
3024   (* }}} *)
3025
3026 let ups_x_cell3 = prove_by_refinement(
3027   `!y.  &0 < y /\ y < &2 * sqrt(&2) ==> &0 < ups_x (&2) (&2) (y *y)`,
3028   (* {{{ proof *)
3029   [
3030   REPEAT WEAK_STRIP_TAC;
3031   REWRITE_TAC [ GSYM Nonlinear_lemma.sqrt2_sqrt2 ];
3032   MATCH_MP_TAC TRI_UPS_X_STRICT_POS;
3033   REWRITE_TAC[Sphere.sqrt2];
3034   ASM_SIMP_TAC[arith `x + x = &2* x`;arith `&0 < x ==> &0 <= x`];
3035   ASM_SIMP_TAC[arith `&0 < x ==> u  < x + u /\ u < u + x`];
3036   GMATCH_SIMP_TAC SQRT_POS_LT;
3037   BY(REAL_ARITH_TAC)
3038   ]);;
3039   (* }}} *)
3040
3041 let UPS_X_POS = prove_by_refinement(
3042   `!y1 y2 y3. &2 <= y1 /\ y1 < &4 /\ &2 <= y2 /\ y2 < &4 /\
3043      &2 <= y3 /\ y3 < &4 ==> &0 < ups_x (y1*y1) (y2*y2) (y3*y3)`,
3044   (* {{{ proof *)
3045   [
3046   REPEAT WEAK_STRIP_TAC;
3047   MATCH_MP_TAC TRI_UPS_X_STRICT_POS;
3048   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
3049   ]);;
3050   (* }}} *)
3051
3052 let eulerA_x_sym = prove_by_refinement(
3053   `!x1 x2 x3 x4 x5 x6.
3054     eulerA_x x1 x2 x3 x4 x5 x6 = eulerA_x x2 x3 x1 x5 x6 x4 /\
3055     eulerA_x x1 x2 x3 x4 x5 x6 = eulerA_x x1 x3 x2 x4 x6 x5
3056 `,
3057   (* {{{ proof *)
3058   [
3059   REPEAT WEAK_STRIP_TAC;
3060   REWRITE_TAC[Sphere.eulerA_x];
3061   BY(REAL_ARITH_TAC)
3062   ]);;
3063   (* }}} *)
3064
3065 let delta_xrrr_ups_x = prove_by_refinement(
3066   `!x4 x5 x6 r2. &0 < x4 /\ &0 < x5 /\ &0 < x6 /\ &0 < r2 /\
3067      &0 < delta_x r2 r2 r2 x4 x5 x6 ==> &0 < ups_x x4 x5 x6`,
3068   (* {{{ proof *)
3069   [
3070   REPEAT WEAK_STRIP_TAC;
3071   FIRST_X_ASSUM MP_TAC;
3072   REWRITE_TAC[GSYM delta_delta_x];
3073   REWRITE_TAC[Collect_geom.DELTA_RRR_INTERPRETE];
3074   DISCH_TAC;
3075   SUBGOAL_THEN `&0 < r2 * ups_x x4 x5 x6` ASSUME_TAC;
3076     MATCH_MP_TAC (REAL_LT_TRANS);
3077     EXISTS_TAC `x6 * x5 * x4`;
3078     CONJ_TAC;
3079       BY(ASM_MESON_TAC[ REAL_LT_MUL ]);
3080     FIRST_X_ASSUM MP_TAC;
3081     REWRITE_TAC[Sphere.ups_x];
3082     BY(REAL_ARITH_TAC);
3083   BY(ASM_MESON_TAC[REAL_LT_MUL_EQ])
3084   ]);;
3085   (* }}} *)
3086
3087 let eulerA_x_pos = prove_by_refinement(
3088   `!x4 x5 x6.
3089     &4 <= x4 /\ &4 <= x5 /\ x6 <= &16 ==>
3090      &0 < eulerA_x (&2) x4 x5 x6 (&2) (&2)`,
3091   (* {{{ proof *)
3092   [
3093   REPEAT WEAK_STRIP_TAC;
3094   REWRITE_TAC[Sphere.eulerA_x;arith `&2 + x - &2 = x`];
3095   MATCH_MP_TAC (arith `&0 < x /\ &0 <= y ==> &0 < x + y`);
3096   CONJ_TAC;
3097     (MATCH_MP_TAC REAL_LT_MUL);
3098     GMATCH_SIMP_TAC SQRT_POS_LT;
3099     GMATCH_SIMP_TAC REAL_LT_MUL;
3100     GMATCH_SIMP_TAC SQRT_POS_LT;
3101     GMATCH_SIMP_TAC SQRT_POS_LT;
3102     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
3103   MATCH_MP_TAC (arith `&0 <= x * y  + u * v + a * b ==> &0 <= x * y / &2 + u * v / &2 + a * b / &2`);
3104   (unlist REWRITE_TAC) (REAL_RING `a * (x4 + x5 - x6) + b * x5 + c * x4 = a * (x4 - &4) + a * (x5 - &4) + a * (&16 - x6) - a * &8 + b * (x5 - &4) + c * (x4 - &4) + &4 * (b + c)`);
3105   MATCH_MP_TAC (arith `&0 <= a /\ &0 <= b /\ &0 <= c /\  &0 <= e /\ &0 <= f /\ &0 <= -- d + q ==> &0 <= a + b + c - d + e + f + q`);
3106   SUBGOAL_THEN `&0 <= sqrt (&2)` ASSUME_TAC;
3107     GMATCH_SIMP_TAC SQRT_POS_LE;
3108     BY(REAL_ARITH_TAC);
3109   SUBGOAL_THEN `&0 <= sqrt x4 /\ &0 <= sqrt x5` MP_TAC;
3110     GMATCH_SIMP_TAC SQRT_POS_LE;
3111     GMATCH_SIMP_TAC SQRT_POS_LE;
3112     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
3113   REPEAT WEAK_STRIP_TAC;
3114   REPLICATE_TAC 5 (CONJ_TAC THENL[MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC;ALL_TAC]);
3115   MATCH_MP_TAC (arith `a <= b /\ a <= c ==> &0 <= -- (a * &8) + &4 * (b + c)`);
3116   GMATCH_SIMP_TAC SQRT_MONO_LE_EQ;
3117   GMATCH_SIMP_TAC SQRT_MONO_LE_EQ;
3118   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
3119   ]);;
3120   (* }}} *)
3121
3122 let delta_x4_2 = prove_by_refinement(
3123   `!x4 x5 x6. delta_x4 x6 (&2) x5 (&2) x4 (&2) = x6 * (x4 + x5 - x6)`,
3124   (* {{{ proof *)
3125   [
3126   REWRITE_TAC[Sphere.delta_x4];
3127   BY(REAL_ARITH_TAC)
3128   ]);;
3129   (* }}} *)
3130
3131 let delta_x4_pos = prove_by_refinement(
3132   `!x4 x5 x6.
3133     &4 <= x4 /\ &4 <= x5 /\ &0 < x6 /\ x6 < &8 ==>
3134      &0 < delta_x4 x6 (&2) x5 (&2) x4 (&2)`,
3135   (* {{{ proof *)
3136   [
3137  REWRITE_TAC[delta_x4_2];
3138   REPEAT WEAK_STRIP_TAC;
3139   MATCH_MP_TAC REAL_LT_MUL;
3140   REPEAT (FIRST_X_ASSUM MP_TAC);
3141   BY(REAL_ARITH_TAC)
3142   ]);;
3143   (* }}} *)
3144
3145 let ups_x_sym = prove(`!a b c. ups_x a b c = ups_x b a c`,
3146    REWRITE_TAC[Sphere.ups_x] THEN REAL_ARITH_TAC);;
3147
3148
3149 let gamma3f_gamma3f_x_div_sqrtdelta_WEAK = prove_by_refinement(
3150   `!y4 y5 y6 a b c.
3151     &0 < y4 /\ &0 < y5 /\ &0 < y6 /\
3152     y4 < &2 * sqrt(&2) /\ y5 < &2 * sqrt(&2) /\ y6 < &2 * sqrt(&2) /\
3153     &0 < ups_x (y4 * y4) (y5 * y5) (y6 *y6) /\
3154     &0 < delta_x (&2) (&2) (&2) (y4*y4) (y5*y5) (y6*y6) /\
3155     &0 < eulerA_x (&2) (y4 *y4) (y5*y5) (y6*y6) (&2) (&2) /\
3156     &0 < eulerA_x (&2) (y6*y6) (y4 *y4) (y5*y5)  (&2) (&2) /\
3157     &0 < eulerA_x (&2) (y5*y5) (y6*y6)  (y4 *y4) (&2) (&2) /\
3158   &0 < delta_x4 (y6 * y6) (&2) (y5 * y5) (&2) (y4 * y4) (&2) /\
3159   &0 < delta_x4 (y5 * y5) (&2) (y4 * y4) (&2) (y6 * y6) (&2) /\
3160   &0 < delta_x4 (y4 * y4) (&2) (y6 * y6) (&2) (y5 * y5) (&2)
3161 ==>
3162     (gamma3f y4 y5 y6 sqrt2 lmfun = gamma3f_x_div_sqrtdelta (h0cut y4) (h0cut y5) (h0cut y6)
3163       a b c (y4*y4) (y5*y5) (y6*y6)   * sqrt(delta_x (&2) (&2) (&2) (y4*y4) (y5*y5) (y6*y6)))`,
3164   (* {{{ proof *)
3165   [
3166   REPEAT WEAK_STRIP_TAC;
3167   REWRITE_TAC[Sphere.gamma3f; Functional_equation.nonf_gamma3f_x_div_sqrtdelta;Sphere.vol3r;Sphere.vol3f;Sphere.vol_y;Sphere.y_of_x;Sphere.vol_x];
3168   ASM_SIMP_TAC[Nonlinear_lemma.sqrtxx ; arith `&0 < x ==> &0 <= x`;arith `y * #0.5 = y / &2`;GSYM lmfun_h0cut];
3169   REWRITE_TAC[Sphere.dih_y; sol_y_sol_x ;LET_END_DEF;LET_DEF; Nonlinear_lemma.sqrt2_sqrt2];
3170   SUBGOAL_THEN `!x y z. dih_x x y (&2) (&2) (&2) z = dih_x x (&2) z (&2) y (&2)` (unlist REWRITE_TAC);
3171     BY(MESON_TAC[Nonlinear_lemma.dih_x_sym2;Nonlinear_lemma.dih_x_sym]);
3172   SUBGOAL_THEN `!x y z. sol_x x y (&2) (&2) (&2) z = sol_x y (&2) x (&2) z (&2)` (unlist REWRITE_TAC);
3173     BY(MESON_TAC[sol_x_sym;sol_x_sym2]);
3174   REPEAT (GMATCH_SIMP_TAC sol_x_sol_euler_x);
3175   REPEAT (GMATCH_SIMP_TAC sol_x_sol_x_sqrtdelta);
3176   REPEAT (GMATCH_SIMP_TAC dih_x_dih_x_div_sqrtdelta_posbranch);
3177   SUBGOAL_THEN `!x4 x5 x6. delta_x x4 (&2) x5 (&2) x6 (&2) = delta_x (&2) (&2) (&2) x4 x5 x6` (unlist REWRITE_TAC);
3178     BY(REWRITE_TAC[Sphere.delta_x] THEN REAL_ARITH_TAC);
3179   SUBGOAL_THEN `delta_x (&2) (&2) (&2) (y5 * y5) (y4 * y4) (y6 * y6) = delta_x (&2) (&2) (&2) (y4 *y4) (y5*y5) (y6*y6) ` SUBST1_TAC;
3180     BY(MESON_TAC[delta_x_sym]);
3181   SUBGOAL_THEN `delta_x (&2) (&2) (&2) (y6 *y6) (y5 * y5) (y4 * y4)  = delta_x (&2) (&2) (&2) (y4 *y4) (y5*y5) (y6*y6) ` SUBST1_TAC;
3182     BY(MESON_TAC[delta_x_sym]);
3183   SUBGOAL_THEN `delta_x (&2) (&2) (&2) (y4 * y4) (y6 *y6) (y5 * y5)   = delta_x (&2) (&2) (&2) (y4 *y4) (y5*y5) (y6*y6) ` SUBST1_TAC;
3184     BY(MESON_TAC[delta_x_sym]);
3185   REWRITE_TAC[TAUT `a /\ b /\ c <=> (a /\ b) /\ c`];
3186   CONJ2_TAC;
3187     BY(REAL_ARITH_TAC);
3188   REWRITE_TAC[TAUT `(a /\ b) /\ c <=> a /\ b /\ c`];
3189   ASM_SIMP_TAC[ REAL_LT_MUL ; arith `&0 < &2`;arith `&0 < x ==> &0 <= x`];
3190   SUBGOAL_THEN `!x. ups_x x (&2) (&2) = ups_x (&2) (&2) x /\ ups_x (&2) x (&2) = ups_x (&2) (&2) x` (unlist REWRITE_TAC);
3191     BY(MESON_TAC[ Collect_geom.UPS_X_SYM ]);
3192   REPEAT (GMATCH_SIMP_TAC ups_x_cell3);
3193   ASM_REWRITE_TAC[];
3194   ONCE_REWRITE_TAC[ups_x_sym];
3195   ASM_REWRITE_TAC[];
3196   SUBGOAL_THEN `  &0 < ups_x (y6 * y6) (y4 * y4) (y5 * y5) ` (unlist REWRITE_TAC);
3197     BY(ASM_MESON_TAC[ Collect_geom.UPS_X_SYM]);
3198   SUBGOAL_THEN `&0 < ups_x (y5 * y5) (y6 * y6) (y4 * y4)` (unlist REWRITE_TAC);
3199     BY(ASM_MESON_TAC[Collect_geom.UPS_X_SYM]);
3200   BY(ASM_MESON_TAC[eulerA_x_sym])
3201   ]);;
3202   (* }}} *)
3203
3204 let gamma3f_gamma3f_x_div_sqrtdelta_WEAK2  = prove_by_refinement(
3205   `!y4 y5 y6 a b c.
3206     &2 <= y4 /\ &2 <= y5 /\ &2 <= y6 /\
3207     y4 < &2 * sqrt(&2) /\ y5 < &2 * sqrt(&2) /\ y6 < &2 * sqrt(&2) /\
3208     eta_x (y4*y4) (y5*y5) (y6*y6) < sqrt(&2)
3209 ==>
3210     (gamma3f y4 y5 y6 sqrt2 lmfun = gamma3f_x_div_sqrtdelta (h0cut y4) (h0cut y5) (h0cut y6)
3211       a b c (y4*y4) (y5*y5) (y6*y6)   * sqrt(delta_x (&2) (&2) (&2) (y4*y4) (y5*y5) (y6*y6)))`,
3212   (* {{{ proof *)
3213   [
3214   REPEAT WEAK_STRIP_TAC;
3215   MATCH_MP_TAC gamma3f_gamma3f_x_div_sqrtdelta_WEAK;
3216   ASM_SIMP_TAC[arith `&2 <= x ==> &0 < x`];
3217   SUBCONJ_TAC;
3218     MATCH_MP_TAC UPS_X_POS;
3219     SUBGOAL_THEN `!x. x < &2 * sqrt (&2) ==> x < &4` ASSUME_TAC;
3220       GEN_TAC;
3221       MATCH_MP_TAC (arith `b < c ==> (x < b ==> x < c)`);
3222       MP_TAC Flyspeck_constants.bounds;
3223       REWRITE_TAC[Sphere.sqrt2];
3224       BY(REAL_ARITH_TAC);
3225     BY(ASM_SIMP_TAC[]);
3226   DISCH_TAC;
3227   SUBCONJ_TAC;
3228     GMATCH_SIMP_TAC cell_3_delta_x_eta_x;
3229     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
3230     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
3231     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
3232     ASM_REWRITE_TAC[Sphere.sqrt2];
3233     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
3234   DISCH_TAC;
3235   REPEAT (GMATCH_SIMP_TAC eulerA_x_pos);
3236   REPEAT (GMATCH_SIMP_TAC delta_x4_pos);
3237   SUBGOAL_THEN `!x. &2 <= x ==> &4 <= x*x` (unlist ASM_SIMP_TAC);
3238     GEN_TAC;
3239     REWRITE_TAC[arith `&4 = &2 * &2`];
3240     DISCH_TAC;
3241     GMATCH_SIMP_TAC Misc_defs_and_lemmas.ABS_SQUARE_LE;
3242     BY(FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC);
3243   SUBGOAL_THEN `!x. &2 <= x ==> &0 < x * x` (unlist ASM_SIMP_TAC);
3244     REPEAT WEAK_STRIP_TAC;
3245     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
3246     BY(FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC);
3247   SUBGOAL_THEN `!x. &2 <= x /\ x < &2 * sqrt(&2) ==> x * x < &8` ASSUME_TAC;
3248     REPEAT WEAK_STRIP_TAC;
3249     REWRITE_TAC[arith `&8 = #8.0`;GSYM Nonlinear_lemma.sqrt8_2];
3250     GMATCH_SIMP_TAC Misc_defs_and_lemmas.ABS_SQUARE;
3251     REWRITE_TAC[Nonlinear_lemma.sqrt8_sqrt2];
3252     REWRITE_TAC[Sphere.sqrt2];
3253     BY((REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC)) THEN REAL_ARITH_TAC);
3254   ASM_SIMP_TAC[];
3255   SUBGOAL_THEN `!x. x * x < &8 ==> x * x <= &16` (unlist ASM_SIMP_TAC);
3256   BY(REAL_ARITH_TAC)
3257   ]);;
3258   (* }}} *)
3259
3260
3261
3262 let dih_x_nn = prove_by_refinement(
3263   `!x1 x2 x3 x4 x5 x6.
3264       &0 < x1 /\
3265             &0 < delta_x x1 x2 x3 x4 x5 x6  ==>
3266     &0 <= dih_x x1 x2 x3 x4 x5 x6    `,
3267   (* {{{ proof *)
3268   [
3269   REPEAT WEAK_STRIP_TAC;
3270   REWRITE_TAC[Nonlinear_lemma.dih_x_alt];
3271   SUBGOAL_THEN `&0 < sqrt(&4 * x1 * delta_x x1 x2 x3 x4 x5 x6)` ASSUME_TAC;
3272     GMATCH_SIMP_TAC SQRT_POS_LT;
3273     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
3274     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
3275     ASM_REWRITE_TAC[];
3276     BY(REAL_ARITH_TAC);
3277   ASM_SIMP_TAC[Trigonometry1.ATN2_BREAKDOWN];
3278   MATCH_MP_TAC (arith `-- a < c ==> &0 <= a + c`);
3279   BY(MESON_TAC[ATN_BOUNDS])
3280   ]);;
3281   (* }}} *)
3282
3283 let dih_x_div_sqrtdelta_pos = prove_by_refinement(
3284   `!x1 x2 x3 x4 x5 x6.
3285   &0 < x1 /\
3286             &0 < delta_x x1 x2 x3 x4 x5 x6 /\
3287             &0 < delta_x4 x1 x2 x3 x4 x5 x6 ==>
3288     &0 <= dih_x_div_sqrtdelta_posbranch x1 x2 x3 x4 x5 x6`,
3289   (* {{{ proof *)
3290   [
3291   REPEAT WEAK_STRIP_TAC;
3292   INTRO_TAC dih_x_dih_x_div_sqrtdelta_posbranch [`x1`;`x2`;`x3`;`x4`;`x5`;`x6`];
3293   ASM_REWRITE_TAC[];
3294   DISCH_TAC;
3295   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `&0 <= sqrt (delta_x x1 x2 x3 x4 x5 x6) *  dih_x_div_sqrtdelta_posbranch x1 x2 x3 x4 x5 x6` ) ASSUME_TAC));
3296     MATCH_MP_TAC REAL_LE_TRANS;
3297     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `dih_x x1 x2 x3 x4 x5 x6`)));
3298     ASM_SIMP_TAC[dih_x_nn];
3299     BY(REAL_ARITH_TAC);
3300   BY(ASM_MESON_TAC[REAL_LE_MUL_EQ;SQRT_POS_LT])
3301   ]);;
3302   (* }}} *)
3303
3304 let ETA_Y_LE_IMP_LT = prove_by_refinement(
3305   `!y4 y5 y6. &2 <= y4 /\ y4 <= sqrt8 /\ &2 <= y5 /\ y5 <= sqrt8 /\ &2 <= y6 /\ y6 <= sqrt8 /\
3306     eta_y y4 y5 y6 < sqrt2 ==> y4 < sqrt8`,
3307   (* {{{ proof *)
3308   [
3309   REWRITE_TAC[Sphere.eta_y];
3310   REWRITE_TAC[LET_DEF;LET_END_DEF];
3311   REPEAT WEAK_STRIP_TAC;
3312   INTRO_TAC UPS_X_POS [`y4`;`y5`;`y6`];
3313   ANTS_TAC;
3314     REPEAT (FIRST_X_ASSUM MP_TAC);
3315     MP_TAC Flyspeck_constants.bounds;
3316     REWRITE_TAC[Sphere.sqrt8];
3317     BY(REAL_ARITH_TAC);
3318   WEAK_STRIP_TAC;
3319   PROOF_BY_CONTR_TAC;
3320   SUBGOAL_THEN `y4 = sqrt8` ASSUME_TAC;
3321     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
3322   INTRO_TAC cell_3_delta_x_eta_x [`y4*y4`;`y5*y5`;`y6*y6`];
3323   ANTS_TAC;
3324     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
3325     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
3326     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
3327     ASM_REWRITE_TAC[];
3328     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
3329   ASM_REWRITE_TAC[];
3330   REWRITE_TAC[Nonlinear_lemma.sqrt8_2];
3331   SUBGOAL_THEN `delta_x (&2) (&2) (&2) #8.0 (y5 * y5) (y6 * y6) = -- &2 * (-- &8 + y5 * y5 + y6 * y6) pow 2` SUBST1_TAC;
3332     REWRITE_TAC[Sphere.delta_x];
3333     BY(REAL_ARITH_TAC);
3334   INTRO_TAC Real_ext.REAL_LE_POW_2 [`-- &8 + y5 * y5 + y6 * y6`];
3335   BY(REAL_ARITH_TAC)
3336   ]);;
3337   (* }}} *)
3338
3339 let ETA_Y_LE_IMP_LT_ALL = prove_by_refinement(
3340   `!y4 y5 y6. &2 <= y4 /\ y4 <= sqrt8 /\ &2 <= y5 /\ y5 <= sqrt8 /\ &2 <= y6 /\ y6 <= sqrt8 /\
3341     eta_y y4 y5 y6 < sqrt2 ==> y4 < sqrt8 /\ y5 < sqrt8 /\ y6 < sqrt8`,
3342   (* {{{ proof *)
3343   [
3344   BY(ASM_MESON_TAC [Collect_geom.ETA_Y_SYYM; ETA_Y_LE_IMP_LT])
3345   ]);;
3346   (* }}} *)
3347
3348 let ETA_Y_BOUNDS = prove_by_refinement(
3349   `!y4 y5 y6. &2 <= y4 /\ y4 <= sqrt8 /\ &2 <= y5 /\ y5 <= sqrt8 /\ &2 <= y6 /\ y6 <= sqrt8 /\
3350     eta_y y4 y5 y6 < sqrt2 ==> &0 < ups_x (y4 * y4) (y5 * y5) (y6 * y6) /\
3351      &0 < delta_x (&2) (&2) (&2) (y4 * y4) (y5*y5) (y6*y6)`,
3352   (* {{{ proof *)
3353   [
3354   REWRITE_TAC[Sphere.eta_y];
3355   REWRITE_TAC[LET_DEF;LET_END_DEF];
3356   REPEAT WEAK_STRIP_TAC;
3357   INTRO_TAC UPS_X_POS [`y4`;`y5`;`y6`];
3358   ANTS_TAC;
3359     REPEAT (FIRST_X_ASSUM MP_TAC);
3360     MP_TAC Flyspeck_constants.bounds;
3361     REWRITE_TAC[Sphere.sqrt8];
3362     BY(BY(REAL_ARITH_TAC));
3363   DISCH_TAC;
3364   ASM_REWRITE_TAC[];
3365   INTRO_TAC cell_3_delta_x_eta_x [`y4 * y4`;`y5 * y5`;`y6 * y6`];
3366   ASM_REWRITE_TAC[];
3367   GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
3368   GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
3369   GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
3370   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
3371   ]);;
3372   (* }}} *)
3373
3374 let dih_y_div_sqrtdelta_pos = prove_by_refinement(
3375 `!y4 y5 y6.
3376     &2 <= y4 /\ &2 <= y5 /\ &2 <= y6 /\
3377     y4 <= &2 * sqrt(&2) /\ y5 <= &2 * sqrt(&2) /\ y6 <= &2 * sqrt(&2) /\
3378     eta_y (y4) (y5) (y6) < sqrt(&2) ==>
3379     &0 <= y_of_x dih4_x_div_sqrtdelta_posbranch sqrt2 sqrt2 sqrt2 y4 y5 y6`,
3380   (* {{{ proof *)
3381   [
3382   REPEAT STRIP_TAC;
3383   INTRO_TAC ETA_Y_LE_IMP_LT_ALL [`y4`;`y5`;`y6`];
3384   ASM_REWRITE_TAC[];
3385   ANTS_TAC;
3386     REPEAT (FIRST_X_ASSUM MP_TAC);
3387     REWRITE_TAC[Nonlinear_lemma.sqrt8_sqrt2;Sphere.sqrt2];
3388     BY(REAL_ARITH_TAC);
3389   REPEAT WEAK_STRIP_TAC;
3390   REWRITE_TAC[Sphere.y_of_x;Nonlin_def.dih4_x_div_sqrtdelta_posbranch;Sphere.rotate4];
3391   MATCH_MP_TAC dih_x_div_sqrtdelta_pos;
3392   CONJ_TAC;
3393     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
3394     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
3395   SUBCONJ_TAC;
3396     INTRO_TAC ETA_Y_BOUNDS [`y4`;`y5`;`y6`];
3397     ASM_REWRITE_TAC[];
3398     ANTS_TAC;
3399       BY(ASM_SIMP_TAC[Sphere.sqrt2;arith `x < y ==> x <= y`]);
3400     REPEAT WEAK_STRIP_TAC;
3401     REWRITE_TAC[Nonlinear_lemma.sqrt2_sqrt2];
3402     BY(ASM_MESON_TAC[delta_x_sym]);
3403   DISCH_TAC;
3404   INTRO_TAC delta_x4_pos [`y5 * y5`;`y6 * y6`;`y4 * y4`];
3405   ANTS_TAC;
3406     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
3407     REWRITE_TAC[arith `&4 = &2 * &2`];
3408     GMATCH_SIMP_TAC Misc_defs_and_lemmas.ABS_SQUARE_LE;
3409     GMATCH_SIMP_TAC Misc_defs_and_lemmas.ABS_SQUARE_LE;
3410     REWRITE_TAC[GSYM Nonlinear_lemma.sqrt8_2;arith `&8 = #8.0`];
3411     GMATCH_SIMP_TAC Misc_defs_and_lemmas.ABS_SQUARE;
3412     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
3413   BY(REWRITE_TAC[Nonlinear_lemma.sqrt2_sqrt2])
3414   ]);;
3415   (* }}} *)
3416
3417 let gamma3f_gamma3f_x_div_sqrtdelta  = prove_by_refinement(
3418   `!a b c y4 y5 y6.
3419     &2 <= y4 /\ &2 <= y5 /\ &2 <= y6 /\
3420     y4 <= &2 * sqrt(&2) /\ y5 <= &2 * sqrt(&2) /\ y6 <= &2 * sqrt(&2) /\
3421     eta_x (y4*y4) (y5*y5) (y6*y6) < sqrt(&2)
3422 ==>
3423     (gamma3f y4 y5 y6 sqrt2 lmfun = gamma3f_x_div_sqrtdelta (h0cut y4) (h0cut y5) (h0cut y6)
3424       a b c (y4*y4) (y5*y5) (y6*y6)   * sqrt(delta_x (&2) (&2) (&2) (y4*y4) (y5*y5) (y6*y6)))`,
3425   (* {{{ proof *)
3426   [
3427   REPEAT WEAK_STRIP_TAC;
3428   MATCH_MP_TAC gamma3f_gamma3f_x_div_sqrtdelta_WEAK2;
3429   ASM_REWRITE_TAC[];
3430   INTRO_TAC ETA_Y_LE_IMP_LT_ALL [`y4`;`y5`;`y6`];
3431   ASM_REWRITE_TAC[Sphere.sqrt2; Nonlinear_lemma.sqrt8_sqrt2];
3432   DISCH_THEN MATCH_MP_TAC;
3433   BY(ASM_REWRITE_TAC[Sphere.eta_y;LET_DEF;LET_END_DEF])
3434   ]);;
3435   (* }}} *)
3436
3437 let gamma3f_x_div_sqrtdelta_quotient = prove_by_refinement(
3438   `!y4 y5 y6 a b c.
3439     &2 <= y4 /\ &2 <= y5 /\ &2 <= y6 /\
3440     y4 <= &2 * sqrt(&2) /\ y5 <= &2 * sqrt(&2) /\ y6 <= &2 * sqrt(&2) /\
3441     eta_x (y4*y4) (y5*y5) (y6*y6) < sqrt(&2) ==>
3442      gamma3f_x_div_sqrtdelta (h0cut y4) (h0cut y5) (h0cut y6) a b c (y4*y4) (y5*y5) (y6*y6) =
3443         gamma3f y4 y5 y6 sqrt2 lmfun / sqrt(delta_x (&2) (&2) (&2) (y4*y4) (y5*y5) (y6*y6))
3444 `,
3445   (* {{{ proof *)
3446   [
3447   REPEAT WEAK_STRIP_TAC;
3448   GOAL_TERM (fun w -> (ASM_SIMP_TAC[(ISPECL ( envl w [`a`;`b`;`c`]) gamma3f_gamma3f_x_div_sqrtdelta)]));
3449   Calc_derivative.CALC_ID_TAC;
3450   MATCH_MP_TAC (arith `&0 < x ==> ~(x = &0)`);
3451   GMATCH_SIMP_TAC SQRT_POS_LT;
3452   INTRO_TAC ETA_Y_BOUNDS [`y4`;`y5`;`y6`];
3453   ASM_REWRITE_TAC[Sphere.eta_y;LET_DEF;LET_END_DEF;Sphere.sqrt2;Nonlinear_lemma.sqrt8_sqrt2];
3454   BY(MESON_TAC[])
3455   ]);;
3456   (* }}} *)
3457
3458 let gamma3f_x_div_sqrtdelta_arg3 = prove_by_refinement(
3459   `!y1 y2 y3 y4 y5 y6 m4 m5 m6.
3460     gamma3f_x_div_sqrtdelta m4 m5 m6 y1 y2 y3 y4 y5 y6 =
3461     gamma3f_x_div_sqrtdelta m4 m5 m6 (&1) (&1) (&1) y4 y5 y6`,
3462   (* {{{ proof *)
3463   [
3464   BY(REWRITE_TAC[Functional_equation.nonf_gamma3f_x_div_sqrtdelta])
3465   ]);;
3466   (* }}} *)
3467
3468 let gamma3f_y_div_sqrtdelta_arg3 = prove_by_refinement(
3469   `!y1 y2 y3 y4 y5 y6 m4 m5 m6.
3470     y_of_x (gamma3f_x_div_sqrtdelta (m4 y4) (m5 y5) (m6 y6)) y1 y2 y3 y4 y5 y6 =
3471     y_of_x (gamma3f_x_div_sqrtdelta (m4 y4) (m5 y5) (m6 y6)) (&1) (&1) (&1) y4 y5 y6`,
3472   (* {{{ proof *)
3473   [
3474   BY((REWRITE_TAC[Sphere.y_of_x;Functional_equation.nonf_gamma3f_x_div_sqrtdelta]))
3475   ]);;
3476   (* }}} *)
3477
3478
3479 let gamma3f_sym = prove_by_refinement(
3480   `!y4 y5 y6.
3481     gamma3f y4 y5 y6 sqrt2 lmfun = gamma3f y4 y6 y5 sqrt2 lmfun /\
3482     gamma3f y4 y5 y6 sqrt2 lmfun = gamma3f y5 y6 y4 sqrt2 lmfun`,
3483   (* {{{ proof *)
3484   [
3485   REPEAT WEAK_STRIP_TAC;
3486   REWRITE_TAC[Sphere.gamma3f;Sphere.vol3r;Sphere.vol3f;Sphere.vol_y;Sphere.y_of_x;Sphere.vol_x;Nonlinear_lemma.sqrt2_sqrt2];
3487   MATCH_MP_TAC (arith `((a = a') /\ (a = a'')) /\ ((b = b') /\ (b =b'')) /\ ((c = c') /\ c = c'') ==> (a - (b - c) = a' - (b' - c'))/\ (a - (b - c) = a'' - (b'' - c''))`);
3488   CONJ_TAC;
3489     BY(ASM_MESON_TAC[delta_x_sym]);
3490   CONJ_TAC;
3491     REWRITE_TAC[sol_y_sol_x];
3492     CONJ_TAC;
3493       REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
3494       MATCH_MP_TAC (arith `(x = z') /\ (y = y') /\ (z = x') ==> (x+y+z = x'+y'+z')`);
3495       BY(MESON_TAC[sol_x_sym;sol_x_sym2]);
3496     BY(MESON_TAC[sol_x_sym;sol_x_sym2;arith `x + y + z = y + z + x`]);
3497   CONJ_TAC;
3498     REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
3499     MATCH_MP_TAC (arith `(x = x') /\ (y = z') /\ (z = y') ==> (x+y+z = x'+y'+z')`);
3500     BY(MESON_TAC[Nonlinear_lemma.dih_y_sym;Nonlinear_lemma.dih_y_sym2]);
3501   REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
3502   MATCH_MP_TAC (arith `(x = z') /\ (y = x') /\ (z = y') ==> (x+y+z = x'+y'+z')`);
3503   BY(MESON_TAC[Nonlinear_lemma.dih_y_sym;Nonlinear_lemma.dih_y_sym2])
3504   ]);;
3505   (* }}} *)
3506
3507 let gamma3f_x_dif_sqrtdelta_sym = prove_by_refinement(
3508   `!y4 y5 y6.
3509     &2 <= y4 /\ &2 <= y5 /\ &2 <= y6 /\
3510     y4 <= &2 * sqrt(&2) /\ y5 <= &2 * sqrt(&2) /\ y6 <= &2 * sqrt(&2) /\
3511     eta_x (y4*y4) (y5*y5) (y6*y6) < sqrt(&2) ==>
3512     y_of_x (gamma3f_x_div_sqrtdelta (h0cut y4) (h0cut y5) (h0cut y6)) (&1) (&1) (&1) y4 y5 y6 =
3513     y_of_x (gamma3f_x_div_sqrtdelta (h0cut y5) (h0cut y6) (h0cut y4)) (&1) (&1) (&1) y5 y6 y4 /\
3514     y_of_x (gamma3f_x_div_sqrtdelta (h0cut y4) (h0cut y5) (h0cut y6)) (&1) (&1) (&1) y4 y5 y6 =
3515     y_of_x (gamma3f_x_div_sqrtdelta (h0cut y5) (h0cut y4) (h0cut y6)) (&1) (&1) (&1) y5 y4 y6
3516     `,
3517   (* {{{ proof *)
3518   [
3519   REPEAT WEAK_STRIP_TAC;
3520   REWRITE_TAC[Sphere.y_of_x];
3521   ASM_SIMP_TAC[gamma3f_x_div_sqrtdelta_quotient];
3522   GMATCH_SIMP_TAC gamma3f_x_div_sqrtdelta_quotient;
3523   GMATCH_SIMP_TAC gamma3f_x_div_sqrtdelta_quotient;
3524   ASM_REWRITE_TAC[];
3525   CONJ_TAC;
3526     BY(ASM_MESON_TAC[Collect_geom.ETA_X_SYMM]);
3527   CONJ_TAC;
3528     BY(ASM_MESON_TAC[Collect_geom.ETA_X_SYMM]);
3529   BY(ASM_MESON_TAC[delta_x_sym;gamma3f_sym])
3530   ]);;
3531   (* }}} *)
3532
3533
3534 (*  do 3 -cell nonnegativity *)
3535
3536
3537 let REAL_WLOG_SIMPLEX_3d = prove_by_refinement(
3538   `!P.
3539     ((!y4 y5 y6.  P y4 y5 y6 = P y4 y6 y5) /\
3540     (!y4 y5 y6.  P y4 y5 y6 = P y5 y6 y4))
3541     /\
3542     (! y4 y5 y6. (y6 <= y5) /\ (y5 <= y4) ==> P y4 y5 y6) ==>
3543     (!y4 y5 y6. P y4 y5 y6)`,
3544   (* {{{ proof *)
3545   [
3546   REPEAT WEAK_STRIP_TAC;
3547   SUBGOAL_THEN `(y4 <= y5 /\ y5 <= y6) \/ (y4 <= y6 /\ y6 <= y5) \/ (y5 <= y4 /\ y4 <= y6) \/ (y5 <= y6 /\ y6 <= y4) \/ (y6 <= y5 /\ y5 <= y4) \/ (y6 <= y4 /\ y4 <= y5)` ASSUME_TAC;
3548     BY(REAL_ARITH_TAC);
3549   BY(REPEAT ((FIRST_X_ASSUM DISJ_CASES_TAC) THEN (ASM_MESON_TAC[])))
3550   ]);;
3551   (* }}} *)
3552
3553 let ineq_constant = prove_by_refinement(
3554   `!a y  v f.  (ineq (CONS (a,y,a) v) (f y)) <=> ((y=a)==> (ineq v (f a)))`,
3555   (* {{{ proof *)
3556   [
3557   REPEAT WEAK_STRIP_TAC;
3558   REWRITE_TAC[Sphere.ineq;arith `a <= y /\ y <= a <=> (y = a)`];
3559   BY(MESON_TAC[])
3560   ]);;
3561   (* }}} *)
3562
3563 let PPx = prove_by_refinement(
3564   `!(a:A) P. (!y. (y = a) ==> P y) ==> P a`,
3565   (* {{{ proof *)
3566   [
3567   MESON_TAC[]
3568   ]);;
3569   (* }}} *)
3570
3571 let cell3_from_ineq = `!y4 y5 y6.
3572    &2 <= y4 /\ &2 <= y5 /\ &2 <= y6 /\
3573     y4 <= &2 * sqrt(&2) /\ y5 <= &2 * sqrt(&2) /\ y6 <= &2 * sqrt(&2) /\
3574     eta_y (y4) (y5) (y6) < sqrt(&2) ==>
3575     &0 <= gamma3f y4 y5 y6 sqrt2 lmfun `;;
3576
3577 let eta_y_nn = prove_by_refinement(
3578   `!y4 y5 y6. &0 <= ups_x (y4*y4) (y5*y5) (y6*y6) ==> &0 <= eta_y y4 y5 y6`,
3579   (* {{{ proof *)
3580   [
3581   REPEAT WEAK_STRIP_TAC;
3582   REWRITE_TAC[Sphere.eta_y;LET_DEF;LET_END_DEF];
3583   REWRITE_TAC[Sphere.eta_x];
3584   GMATCH_SIMP_TAC SQRT_POS_LE;
3585   GMATCH_SIMP_TAC REAL_LE_DIV;
3586   ASM_REWRITE_TAC[];
3587   GMATCH_SIMP_TAC REAL_LE_MUL;
3588   CONJ_TAC;
3589     BY(REWRITE_TAC[REAL_LE_SQUARE]);
3590   GMATCH_SIMP_TAC REAL_LE_MUL;
3591   BY(REWRITE_TAC[REAL_LE_SQUARE])
3592   ]);;
3593   (* }}} *)
3594
3595 let ineq_branch_edge_strict = prove_by_refinement(
3596   `!c a b u v y f.
3597      ineq (APPEND u (CONS (a,y,c) v)) f /\
3598     ((c < y) ==> ineq (APPEND u (CONS (c,y,b) v)) f) ==>
3599     ineq (APPEND u (CONS (a,y,b) v)) f`,
3600   (* {{{ proof *)
3601   [
3602   REWRITE_TAC[ineq_APPEND];
3603   REWRITE_TAC[Sphere.ineq];
3604   REPEAT WEAK_STRIP_TAC;
3605   ASSUME_TAC (arith  `y <= c \/ c < y`);
3606   REPEAT (FIRST_X_ASSUM MP_TAC);
3607   (ASM_CASES_TAC `a <= y` THEN ASM_CASES_TAC `y <= b` THEN ASM_CASES_TAC `y <= c` THEN ASM_CASES_TAC `c < y` THEN ASM_SIMP_TAC[arith `c < y ==> c <= y`;ineq_T] THEN TRY (ASM_MESON_TAC[]))
3608   ]);;
3609   (* }}} *)
3610
3611 let BRANCH_TAC_STRICT n c =
3612   CHOP_LIST_TAC n THEN
3613     MATCH_MP_TAC (SPEC c ineq_branch_edge_strict)
3614     THEN REWRITE_TAC[APPEND];;
3615
3616 let cell3_hyp =
3617   let cell3= ["QZECFIC wt0";"QZECFIC wt0 corner";"QZECFIC wt0 sqrt8";
3618               "QZECFIC wt1";"QZECFIC wt2 A";"CIHTIUM";"CJFZZDW";] in
3619   let cell3_nonlinear = map (fun t -> (hd(Ineq.getexact t)).ineq) cell3 in
3620     end_itlist (curry mk_conj) cell3_nonlinear;;
3621
3622 (*
3623 let goalt =   mk_imp(cell3_hyp,cell3_from_ineq);;
3624 Print_types.print_term_types goalt;;
3625 g goalt;;
3626 *)
3627
3628
3629
3630 g (mk_imp(cell3_hyp,cell3_from_ineq));;
3631
3632 let cell3_from_ineq_thm = prove_by_refinement(
3633   (mk_imp(cell3_hyp,cell3_from_ineq)),
3634   (* {{{ proof *)
3635   [
3636   DISCH_TAC;
3637   REPEAT GEN_TAC;
3638   ABBREV_TAC `Q = (\y4 y5 y6.  &2 <= y4 /\ &2 <= y5 /\ &2 <= y6 /\     y4 <= &2 * sqrt(&2) /\ y5 <= &2 * sqrt(&2) /\ y6 <= &2 * sqrt(&2) /\    eta_y (y4) (y5) (y6) < sqrt(&2))`;
3639   DISCH_TAC;
3640   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`Q y4 y5 y6`) ASSUME_TAC));
3641     EXPAND_TAC "Q";
3642     BY(BY((ASM_REWRITE_TAC[])));
3643   REPEAT WEAK_STRIP_TAC;
3644   INTRO_TAC ETA_Y_BOUNDS [`y4`;`y5`;`y6`];
3645   ANTS_TAC;
3646     BY(BY((ASM_SIMP_TAC[Nonlinear_lemma.sqrt8_sqrt2;Sphere.sqrt2])));
3647   REPEAT WEAK_STRIP_TAC;
3648   INTRO_TAC ETA_Y_LE_IMP_LT_ALL [`y4`;`y5`;`y6`];
3649   ANTS_TAC;
3650     BY(BY((ASM_SIMP_TAC[Nonlinear_lemma.sqrt8_sqrt2;Sphere.sqrt2])));
3651   REPEAT WEAK_STRIP_TAC;
3652   COMMENT "1. remove excess variables";
3653   REPEAT (FIRST_X_ASSUM_ST `ineq` MP_TAC);
3654   REWRITE_TAC[ineq_constant];
3655   REWRITE_TAC[MESON[] `(!y1 y2 y3 y4 y5 y6. P y1 y2 y3 y4 y5 y6) <=> (!y4 y5 y6 y1 y2 y3. P y1 y2 y3 y4 y5 y6)`];
3656   REWRITE_TAC[ RIGHT_FORALL_IMP_THM];
3657   REPEAT WEAK_STRIP_TAC;
3658   REPEAT (FIRST_X_ASSUM (ASSUME_TAC o (MATCH_MP PPx)));
3659   COMMENT "2. insert Q";
3660   REPEAT (FIRST_X_ASSUM MP_TAC);
3661   REPLICATE_TAC 8 DISCH_TAC;
3662   REWRITE_TAC[arith `!x y. x > y <=> y < x`;arith `!x y. x >= y <=> y <= x`];
3663   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!P. (!y4 y5 y6. P y4 y5 y6) ==> (!y4 y5 y6. Q y4 y5 y6 ==> P y4 y5 y6)`) MP_TAC));
3664     BY(BY((MESON_TAC[])));
3665   DISCH_THEN (fun t -> (REPEAT (DISCH_THEN (ASSUME_TAC o (MATCH_MP t)))));
3666   COMMENT "3. remove eta_y";
3667   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!R f.  (!y4 y5 y6. Q y4 y5 y6 ==> ineq (R y4 y5 y6) (f y4 y5 y6 \/ &2 < eta_y y4 y5 y6 pow 2)) ==> (!y4 y5 y6. Q y4 y5 y6 ==> ineq (R y4 y5 y6) (f y4 y5 y6))`) MP_TAC));
3668     REPEAT WEAK_STRIP_TAC;
3669     GOAL_TERM (fun w -> (FIRST_X_ASSUM (MP_TAC o (ISPECL ( envl w [`y4'`;`y5'`;`y6'`])))));
3670     ASM_REWRITE_TAC[];
3671     MATCH_MP_TAC ineq_monotone;
3672     GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `~(&2 < eta_y y4' y5' y6' pow 2)`)));
3673       BY(BY((MESON_TAC[])));
3674     MATCH_MP_TAC (arith `x < &2 ==> ~(&2 < x)`);
3675     FIRST_X_ASSUM MP_TAC;
3676     EXPAND_TAC "Q";
3677     DISCH_TAC;
3678     REWRITE_TAC[GSYM Nonlinear_lemma.sqrt2_sqrt2];
3679     REWRITE_TAC[arith `x pow 2 = x * x`];
3680     GMATCH_SIMP_TAC Misc_defs_and_lemmas.ABS_SQUARE;
3681     GMATCH_SIMP_TAC (arith `&0 <= x ==> (abs x = x)`);
3682     ASM_REWRITE_TAC[Sphere.sqrt2];
3683     MATCH_MP_TAC eta_y_nn;
3684     BY(BY((ASM_MESON_TAC[ETA_Y_BOUNDS;arith `x < y ==> x <= y`;Sphere.sqrt2;Nonlinear_lemma.sqrt8_sqrt2])));
3685   DISCH_THEN (fun SUBST1_TAC -> (REPEAT (FIRST_X_ASSUM_ST `eta_y` (fun CONJUNCTS_THEN2 -> ASSUME_TAC (MATCH_MP SUBST1_TAC CONJUNCTS_THEN2)))) THEN MP_TAC SUBST1_TAC);
3686   MP_TAC (MESON[] `!y4 y5 y6. &2 < eta_y y4 y5 y6 pow 2 <=> (F \/ &2 < eta_y y4 y5 y6 pow 2)`);
3687   DISCH_THEN (fun SUBST1_TAC -> REPEAT (FIRST_X_ASSUM MP_TAC) THEN ONCE_REWRITE_TAC[SUBST1_TAC]);
3688   REPEAT WEAK_STRIP_TAC;
3689   FIRST_X_ASSUM MP_TAC;
3690   REWRITE_TAC[];
3691   (DISCH_THEN (fun SUBST1_TAC -> (REPEAT (FIRST_X_ASSUM_ST `eta_y` (fun CONJUNCTS_THEN2 -> ASSUME_TAC (MATCH_MP SUBST1_TAC CONJUNCTS_THEN2)))) THEN MP_TAC SUBST1_TAC));
3692   DISCH_THEN kill;
3693   COMMENT "4. remove dih_4";
3694   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!R f. (!y4 y5 y6. Q y4 y5 y6 ==> ineq (R y4 y5 y6) (#0.008 * y_of_x dih4_x_div_sqrtdelta_posbranch sqrt2 sqrt2 sqrt2 y4 y5 y6 < f y4 y5 y6)) ==> (!y4 y5 y6. Q y4 y5 y6 ==> ineq (R y4 y5 y6) (&0 <= f y4 y5 y6))`) MP_TAC));
3695     REPEAT WEAK_STRIP_TAC;
3696     GOAL_TERM (fun w -> (FIRST_X_ASSUM (MP_TAC o (ISPECL ( envl w [`y4'`;`y5'`;`y6'`])))));
3697     ASM_REWRITE_TAC[];
3698     MATCH_MP_TAC ineq_monotone;
3699     MATCH_MP_TAC (arith `&0 <= x ==> (x < y ==> &0 <= y)`);
3700     GMATCH_SIMP_TAC REAL_LE_MUL;
3701     CONJ_TAC;
3702       BY(BY(REAL_ARITH_TAC));
3703     MATCH_MP_TAC dih_y_div_sqrtdelta_pos;
3704     FIRST_X_ASSUM MP_TAC;
3705     EXPAND_TAC "Q";
3706     BY(BY(MESON_TAC[]));
3707   (DISCH_THEN (fun SUBST1_TAC -> (REPEAT (FIRST_X_ASSUM_ST `dih4_x_div_sqrtdelta_posbranch` (fun CONJUNCTS_THEN2 -> ASSUME_TAC (MATCH_MP SUBST1_TAC CONJUNCTS_THEN2))))));
3708   COMMENT "5. make strict ineq";
3709   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!R f. (!y4 y5 y6. Q y4 y5 y6 ==> ineq (R y4 y5 y6) (&0 < f y4 y5 y6)) ==> (!y4 y5 y6. Q y4 y5 y6 ==> ineq (R y4 y5 y6) (&0 <= f y4 y5 y6))`) MP_TAC));
3710     REPEAT WEAK_STRIP_TAC;
3711     GOAL_TERM (fun w -> (FIRST_X_ASSUM (MP_TAC o (ISPECL ( envl w [`y4'`;`y5'`;`y6'`])))));
3712     ASM_REWRITE_TAC[];
3713     MATCH_MP_TAC ineq_monotone;
3714     BY(BY(REAL_ARITH_TAC));
3715   (DISCH_THEN (fun SUBST1_TAC -> (REPEAT (FIRST_X_ASSUM_ST `ineq v (&0 < a)` (fun CONJUNCTS_THEN2 -> ASSUME_TAC (MATCH_MP SUBST1_TAC CONJUNCTS_THEN2))))));
3716   COMMENT "5. insert h0cut y4 1";
3717   SUBGOAL_THEN `#2.01 <= &2 * h0 /\ &2 * hminus <= &2 * h0` MP_TAC;
3718     MP_TAC Sphere.h0;
3719     MP_TAC Nonlinear_lemma.hminus_lt_h0;
3720     BY(BY(REAL_ARITH_TAC));
3721   REPEAT WEAK_STRIP_TAC;
3722   SUBGOAL_THEN `!a b c d e f g v. (!y4 y5 y6. Q y4 y5 y6 ==> ineq (CONS (a,y4,b) (v y5 y6)) (&0 <= y_of_x (gamma3f_x_div_sqrtdelta (&1) (c y5) (d y6)) e f g y4 y5 y6)) ==> (b <= &2 * h0) ==> ( (!y4 y5 y6. Q y4 y5 y6 ==> ineq (CONS (a,y4,b) (v y5 y6)) (&0 <= y_of_x (gamma3f_x_div_sqrtdelta (h0cut y4) (c y5) (d y6)) e f g y4 y5 y6)))` MP_TAC;
3723     REPEAT WEAK_STRIP_TAC;
3724     GOAL_TERM (fun w -> (FIRST_X_ASSUM (MP_TAC o (ISPECL ( envl w [`y4'`;`y5'`;`y6'`])))));
3725     ASM_REWRITE_TAC[];
3726     REWRITE_TAC[Sphere.ineq];
3727     REPEAT WEAK_STRIP_TAC;
3728     FIRST_X_ASSUM_ST `ineq` MP_TAC;
3729     ASM_REWRITE_TAC[];
3730     GMATCH_SIMP_TAC Optimize.h0cutA;
3731     REPLICATE_TAC 5 (FIRST_X_ASSUM MP_TAC);
3732     BY(BY(REAL_ARITH_TAC));
3733   (DISCH_THEN (fun SUBST1_TAC -> (REPEAT (FIRST_X_ASSUM_ST `gamma3f_x_div_sqrtdelta (&1)` (fun CONJUNCTS_THEN2 -> MP_TAC (MATCH_MP SUBST1_TAC CONJUNCTS_THEN2))))));
3734   ASM_REWRITE_TAC[];
3735   REPEAT DISCH_TAC;
3736   COMMENT "5 h0cut y4 0";
3737   SUBGOAL_THEN `&2 * h0 < &2 * hplus` MP_TAC;
3738     MP_TAC Nonlinear_lemma.h0_lt_hplus;
3739     BY(BY(REAL_ARITH_TAC));
3740   REPEAT WEAK_STRIP_TAC;
3741   SUBGOAL_THEN `!a b c d e f g v. (!y4 y5 y6. Q y4 y5 y6 ==> ineq (CONS (a,y4,b) (v y5 y6)) (&0 <= y_of_x (gamma3f_x_div_sqrtdelta (&0) (c y5) (d y6)) e f g y4 y5 y6)) ==> ( &2 * h0 <  a) ==> ( (!y4 y5 y6. Q y4 y5 y6 ==> ineq (CONS (a,y4,b) (v y5 y6)) (&0 <= y_of_x (gamma3f_x_div_sqrtdelta (h0cut y4) (c y5) (d y6)) e f g y4 y5 y6)))` MP_TAC;
3742     REPEAT WEAK_STRIP_TAC;
3743     GOAL_TERM (fun w -> (FIRST_X_ASSUM (MP_TAC o (ISPECL ( envl w [`y4'`;`y5'`;`y6'`])))));
3744     ASM_REWRITE_TAC[];
3745     REWRITE_TAC[Sphere.ineq];
3746     REPEAT WEAK_STRIP_TAC;
3747     FIRST_X_ASSUM_ST `ineq` MP_TAC;
3748     ASM_REWRITE_TAC[];
3749     GMATCH_SIMP_TAC Optimize.h0cutB;
3750     REPLICATE_TAC 5 (FIRST_X_ASSUM MP_TAC);
3751     BY(BY(REAL_ARITH_TAC));
3752   (DISCH_THEN (fun SUBST1_TAC -> (REPEAT (FIRST_X_ASSUM_ST `gamma3f_x_div_sqrtdelta (&0)` (fun CONJUNCTS_THEN2 -> MP_TAC (MATCH_MP SUBST1_TAC CONJUNCTS_THEN2))))));
3753   ASM_REWRITE_TAC[];
3754   DISCH_TAC; (* inserted Nov 30, 2012 *)
3755   COMMENT "5 h0cut y5 1";
3756   SUBGOAL_THEN `!a b a' b' c d e f g v. (!y4 y5 y6. Q y4 y5 y6 ==> ineq (CONS (a, y4,b) (CONS (a',y5,b') (v y6))) (&0 <= y_of_x (gamma3f_x_div_sqrtdelta (c y4) (&1) (d y6)) e f g y4 y5 y6)) ==> (b' <= &2 * h0) ==> ( (!y4 y5 y6. Q y4 y5 y6 ==> ineq (CONS (a, y4,b) (CONS (a',y5,b') (v y6))) (&0 <= y_of_x (gamma3f_x_div_sqrtdelta (c y4) (h0cut y5) (d y6)) e f g y4 y5 y6)))` MP_TAC;
3757     REPEAT WEAK_STRIP_TAC;
3758     GOAL_TERM (fun w -> (FIRST_X_ASSUM (MP_TAC o (ISPECL ( envl w [`y4'`;`y5'`;`y6'`])))));
3759     ASM_REWRITE_TAC[];
3760     REWRITE_TAC[Sphere.ineq];
3761     REPEAT WEAK_STRIP_TAC;
3762     FIRST_X_ASSUM_ST `ineq` MP_TAC;
3763     ASM_REWRITE_TAC[];
3764     GMATCH_SIMP_TAC Optimize.h0cutA;
3765     REPLICATE_TAC 6 (FIRST_X_ASSUM MP_TAC);
3766     BY(BY(REAL_ARITH_TAC));
3767   (DISCH_THEN (fun SUBST1_TAC -> (REPEAT (FIRST_X_ASSUM_ST `gamma3f_x_div_sqrtdelta (a) (&1)` (fun CONJUNCTS_THEN2 -> MP_TAC (MATCH_MP SUBST1_TAC CONJUNCTS_THEN2))))));
3768   ASM_REWRITE_TAC[];
3769   REPEAT DISCH_TAC;
3770   COMMENT "5 factor of 2";
3771   FIRST_X_ASSUM_ST `x / &2` MP_TAC;
3772   REWRITE_TAC [arith `!x. &0 <= x / &2 <=> &0 <= x`];
3773   DISCH_TAC;
3774   COMMENT "5 h0cut y6 1";
3775   SUBGOAL_THEN `!a b a' b' a'' b'' c d e f g . (!y4 y5 y6. Q y4 y5 y6 ==> ineq (CONS (a, y4,b) (CONS (a',y5,b') [a'',y6,b''])) (&0 <= y_of_x (gamma3f_x_div_sqrtdelta (c y4) (d y5) (&1)) e f g y4 y5 y6)) ==> (b'' <= &2 * h0) ==> ( (!y4 y5 y6. Q y4 y5 y6 ==> ineq (CONS (a, y4,b) (CONS (a',y5,b') [a'',y6,b''])) (&0 <= y_of_x (gamma3f_x_div_sqrtdelta (c y4) (d y5) (h0cut y6)) e f g y4 y5 y6)))` MP_TAC;
3776     REPEAT WEAK_STRIP_TAC;
3777     GOAL_TERM (fun w -> (FIRST_X_ASSUM (MP_TAC o (ISPECL ( envl w [`y4'`;`y5'`;`y6'`])))));
3778     ASM_REWRITE_TAC[];
3779     REWRITE_TAC[Sphere.ineq];
3780     REPEAT WEAK_STRIP_TAC;
3781     FIRST_X_ASSUM_ST `y_of_x` MP_TAC;
3782     ASM_REWRITE_TAC[];
3783     GMATCH_SIMP_TAC Optimize.h0cutA;
3784     REPLICATE_TAC 8 (FIRST_X_ASSUM MP_TAC);
3785     BY(BY(REAL_ARITH_TAC));
3786   (DISCH_THEN (fun SUBST1_TAC -> (REPEAT (FIRST_X_ASSUM_ST `gamma3f_x_div_sqrtdelta (a) b (&1)` (fun CONJUNCTS_THEN2 -> MP_TAC (MATCH_MP SUBST1_TAC CONJUNCTS_THEN2))))));
3787   ASM_REWRITE_TAC[];
3788   REPEAT DISCH_TAC;
3789   COMMENT "7. gamma3f";
3790   REPEAT (FIRST_X_ASSUM MP_TAC);
3791   ONCE_REWRITE_TAC[gamma3f_y_div_sqrtdelta_arg3];
3792   REPEAT WEAK_STRIP_TAC;
3793   SUBGOAL_THEN `!v. (!y4 y5 y6. Q y4 y5 y6 ==> ineq (v y4 y5 y6) (&0 <= y_of_x (gamma3f_x_div_sqrtdelta (h0cut y4) (h0cut y5) (h0cut y6)) (&1) (&1) (&1) y4 y5 y6)) ==> (!y4 y5 y6. Q y4 y5 y6 ==> ineq (v y4 y5 y6) (&0 <= gamma3f y4 y5 y6 sqrt2 lmfun))` MP_TAC;
3794     REPEAT WEAK_STRIP_TAC;
3795     GOAL_TERM (fun w -> (FIRST_X_ASSUM (MP_TAC o (ISPECL ( envl w [`y4'`;`y5'`;`y6'`])))));
3796     ASM_REWRITE_TAC[];
3797     MATCH_MP_TAC ineq_monotone;
3798     DISCH_TAC;
3799     INTRO_TAC gamma3f_gamma3f_x_div_sqrtdelta [`&1`;`&1`;`&1`];
3800     DISCH_THEN GMATCH_SIMP_TAC;
3801     REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC);
3802     EXPAND_TAC "Q";
3803     REWRITE_TAC[Sphere.eta_y;LET_DEF;LET_END_DEF];
3804     DISCH_TAC;
3805     ASM_REWRITE_TAC[];
3806     DISCH_TAC;
3807     GMATCH_SIMP_TAC REAL_LE_MUL;
3808     CONJ_TAC;
3809       FIRST_X_ASSUM MP_TAC;
3810       BY(BY(REWRITE_TAC[Sphere.y_of_x;arith `&1 * &1 = &1`]));
3811     GMATCH_SIMP_TAC SQRT_POS_LE;
3812     MATCH_MP_TAC (arith `&0 < x ==> &0 <= x`);
3813     INTRO_TAC ETA_Y_BOUNDS [`y4'`;`y5'`;`y6'`];
3814     ASM_SIMP_TAC[Nonlinear_lemma.sqrt8_sqrt2;Sphere.sqrt2];
3815     ANTS_TAC;
3816       BY(BY(ASM_REWRITE_TAC[Sphere.eta_y;LET_DEF;LET_END_DEF]));
3817     BY(BY(MESON_TAC[]));
3818   ((DISCH_THEN (fun SUBST1_TAC -> (REPEAT (FIRST_X_ASSUM_ST `gamma3f_x_div_sqrtdelta` (fun CONJUNCTS_THEN2 -> MP_TAC (MATCH_MP SUBST1_TAC CONJUNCTS_THEN2)))))));
3819   REPEAT WEAK_STRIP_TAC;
3820   COMMENT "8. symmetry reduction";
3821   ENOUGH_TO_SHOW_TAC `(!y4 y5 y6. Q y4 y5 y6 ==> ineq [(&2,y4,sqrt8);(&2,y5,sqrt8);(&2,y6,sqrt8)] (&0 <= gamma3f y4 y5 y6 sqrt2 lmfun))`;
3822     DISCH_THEN (C INTRO_TAC [`y4`;`y5`;`y6`]);
3823     BY(ASM_REWRITE_TAC[Sphere.ineq;Nonlinear_lemma.sqrt8_sqrt2;Sphere.sqrt2]);
3824   MATCH_MP_TAC REAL_WLOG_SIMPLEX_3d;
3825   REWRITE_TAC[TAUT `a /\ b /\ c <=> (a /\ b) /\ c`];
3826   CONJ_TAC;
3827     EXPAND_TAC "Q";
3828     REWRITE_TAC[Sphere.ineq];
3829     BY(MESON_TAC[gamma3f_sym;Collect_geom.ETA_Y_SYYM]);
3830   REPEAT WEAK_STRIP_TAC;
3831   BRANCH_TAC_STRICT 0 `&2 * hminus`;
3832   CONJ_TAC;
3833     BRANCH_TAC_STRICT 0 `#2.01`;
3834     SUBGOAL_THEN `#2.01 <= sqrt8` ASSUME_TAC;
3835       BY(MP_TAC (Flyspeck_constants.bounds) THEN REAL_ARITH_TAC);
3836     REPEAT (FIRST_X_ASSUM_ST `#2.01` (C INTRO_TAC [`y4'`;`y5'`;`y6'`]));
3837     ASM_REWRITE_TAC[];
3838     REPLICATE_TAC 4 (FIRST_X_ASSUM MP_TAC);
3839     BY(REWRITE_TAC[Sphere.ineq] THEN REAL_ARITH_TAC);
3840   DISCH_TAC;
3841   COMMENT "9. now 2hminus < y4";
3842   DISJ_CASES_TAC (arith `&2 * hminus < y6' \/ y6' <= &2 * hminus`);
3843     REPLICATE_TAC 2 (FIRST_X_ASSUM_ST `F` (C INTRO_TAC [`y4'`;`y5'`;`y6'`]));
3844     ASM_REWRITE_TAC[];
3845     REPLICATE_TAC 5 (FIRST_X_ASSUM MP_TAC);
3846     BY(REWRITE_TAC[Sphere.ineq] THEN REAL_ARITH_TAC);
3847   DISJ_CASES_TAC (arith `&2 * hplus < y5' \/ y5' <= &2 * hplus`);
3848     REPLICATE_TAC 2 (FIRST_X_ASSUM_ST `F` (C INTRO_TAC [`y4'`;`y5'`;`y6'`]));
3849     ASM_REWRITE_TAC[];
3850     REPLICATE_TAC 6 (FIRST_X_ASSUM MP_TAC);
3851     BY(REWRITE_TAC[Sphere.ineq] THEN REAL_ARITH_TAC);
3852   DISJ_CASES_TAC (arith `&2 * hminus < y5' \/ y5' <= &2 * hminus`);
3853     (FIRST_X_ASSUM (C INTRO_TAC [`y4'`;`y5'`;`y6'`]));
3854     ASM_REWRITE_TAC[];
3855     REPLICATE_TAC 7 (FIRST_X_ASSUM MP_TAC);
3856     BY(REWRITE_TAC[Sphere.ineq] THEN REAL_ARITH_TAC);
3857   DISJ_CASES_TAC (arith `&2 * hplus < y4' \/ y4' <= &2 * hplus`);
3858     REPEAT (FIRST_X_ASSUM_ST `#2.01` kill);
3859     REPLICATE_TAC 2 (FIRST_X_ASSUM (C INTRO_TAC [`y4'`;`y5'`;`y6'`]));
3860     ASM_REWRITE_TAC[];
3861     REPLICATE_TAC 8 (FIRST_X_ASSUM MP_TAC);
3862     BY(REWRITE_TAC[Sphere.ineq] THEN REAL_ARITH_TAC);
3863   REPEAT (FIRST_X_ASSUM_ST `#2.01` kill);
3864   REPLICATE_TAC 3 (FIRST_X_ASSUM (C INTRO_TAC [`y4'`;`y5'`;`y6'`]));
3865   ASM_REWRITE_TAC[];
3866   REPLICATE_TAC 8 (FIRST_X_ASSUM MP_TAC);
3867   BY(REWRITE_TAC[Sphere.ineq] THEN REAL_ARITH_TAC)
3868   ]);;
3869   (* }}} *)
3870
3871 let cell3_from_ineq_thm_ALT = prove_by_refinement(
3872   `pack_nonlinear_non_ox3q1h ==>     (!y4 y5 y6.
3873       &2 <= y4 /\
3874       &2 <= y5 /\
3875       &2 <= y6 /\
3876       y4 <= &2 * sqrt (&2) /\
3877       y5 <= &2 * sqrt (&2) /\
3878       y6 <= &2 * sqrt (&2) /\
3879       eta_y y4 y5 y6 < sqrt (&2)
3880       ==> &0 <= gamma3f y4 y5 y6 sqrt2 lmfun)
3881    `,
3882   (* {{{ proof *)
3883   [
3884   DISCH_TAC;
3885   INTRO_TAC cell3_from_ineq_thm [];
3886   ANTS_TAC;
3887     BY((REWRITE_TAC (map get_pack_nonlinear_non_ox3q1h ["QZECFIC wt0";"QZECFIC wt0 corner";"QZECFIC wt0 sqrt8";"QZECFIC wt1";"QZECFIC wt2 A";"CIHTIUM";"CJFZZDW";])));
3888   BY(REWRITE_TAC[])
3889   ]);;
3890   (* }}} *)
3891
3892
3893
3894
3895
3896 let HJKDESR1a_1cell = prove_by_refinement(
3897   `&0 <  &8 * pi * sqrt2 / &3  -  &8 * mm1 `,
3898   (* {{{ proof *)
3899   [
3900   REWRITE_TAC[ arith `&8 * pi * sqrt2 / &3 = (&8 / &3) * (pi * sqrt2)`];
3901   MATCH_MP_TAC (arith `&3 * mm1 < z ==> &0 < (&8/ &3) * z  - &8 * mm1`);
3902   MATCH_MP_TAC REAL_LT_TRANS;
3903   EXISTS_TAC (`&3 * #1.3`);
3904   GMATCH_SIMP_TAC REAL_LT_LMUL_EQ;
3905   GMATCH_SIMP_TAC REAL_LT_MUL2;
3906   MP_TAC Flyspeck_constants.bounds;
3907   BY(REAL_ARITH_TAC)
3908   ]);;
3909   (* }}} *)
3910
3911
3912
3913 let GRKIBMP_concl =
3914   `!y. &2 <= y /\ y <= sqrt8 ==>
3915      &0 <= gamma2_x_div_azim_v2 (h0cut y) (y* y)`;;
3916
3917 (* lmfun_h0cut relates this to the function lmfun *)
3918
3919 let GRKIBMP = prove_by_refinement(
3920   (add_hyp ["GRKIBMP A V2"; "GRKIBMP B V2"] GRKIBMP_concl),
3921   (* {{{ proof *)
3922   [
3923   REPEAT WEAK_STRIP_TAC;
3924   REPEAT (FIRST_X_ASSUM (C INTRO_TAC [`y`;`&1`;`&1`;`&1`;`&1`;`&1`]));
3925   REWRITE_TAC[Sphere.ineq;Sphere.y_of_x;arith `&1 * &1 = &1`;arith `&1 <= &1`;Functional_equation.nonf_gamma2_x1_div_a_v2];
3926   ASM_CASES_TAC `&2 * hplus <= y`;
3927     ASM_REWRITE_TAC[arith `x >= &0 <=> &0 <= x`];
3928     REPEAT WEAK_STRIP_TAC;
3929     ENOUGH_TO_SHOW_TAC `h0cut y = &0`;
3930       BY(ASM_MESON_TAC[]);
3931     MATCH_MP_TAC Optimize.h0cutB;
3932     MP_TAC Nonlinear_lemma.h0_lt_hplus;
3933     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
3934   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
3935   ]);;
3936   (* }}} *)
3937
3938
3939
3940 (* see also Nonlinear_lemma.h0_lt_gt *)
3941
3942 let y_bounds = prove_by_refinement(
3943   `!y. (y <= &2 * hminus ==> y <= sqrt8) /\
3944     (y <= sqrt8 ==> y <= &2 * sqrt(&2)) /\
3945     (y <= &2 * sqrt(&2) ==> y < &4) /\
3946     (y < &2 * hminus ==> y <= &2 * hminus) /\
3947     (y < &2 * hminus ==> y <= &2 * sqrt(&2)) /\
3948     (&2 <= y ==> &0 < y) /\
3949     (&2 * hminus <= y ==> &2 <= y) /\
3950     (&2 <= y ==> &0 <= y) /\
3951     (&2 * hminus <= y ==> &0 <= y) /\
3952     (y <= &2 * hminus ==> y <= &2 * h0) /\
3953     (y <= &2 * hplus ==> y <= &2 * sqrt(&2)) `,
3954   (* {{{ proof *)
3955   [
3956   REPEAT WEAK_STRIP_TAC;
3957   MP_TAC Flyspeck_constants.bounds;
3958   MP_TAC Nonlinear_lemma.hminus_lt_h0;
3959   REWRITE_TAC[GSYM Nonlinear_lemma.sqrt8_sqrt2;GSYM Sphere.sqrt2];
3960   MP_TAC Nonlinear_lemma.hminus_prop;
3961   REWRITE_TAC[Sphere.hplus];
3962   BY(REAL_ARITH_TAC)
3963   ]);;
3964   (* }}} *)
3965
3966 let rad2_x_eta_x = prove_by_refinement(
3967   `!x1 x2 x3 x4 x5 x6.
3968     &0 < x4 /\ &0 < x5 /\ &0 < x6 /\
3969     &0 < ups_x x4 x5 x6 /\ &0 < delta_x x1 x2 x3 x4 x5 x6 ==>
3970      eta_x x4 x5 x6 pow 2 <= rad2_x x1 x2 x3 x4 x5 x6`,
3971   (* {{{ proof *)
3972   [
3973   REPEAT WEAK_STRIP_TAC;
3974   REWRITE_TAC[Sphere.rad2_x;Sphere.eta_x;GSYM (* Merge_ineq *) Collect_geom.rho_ij'_rho_x];
3975   GMATCH_SIMP_TAC REAL_LE_RDIV_EQ;
3976   CONJ_TAC;
3977     GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
3978     ASM_REWRITE_TAC[];
3979     BY(REAL_ARITH_TAC);
3980   GMATCH_SIMP_TAC SQRT_POW_2;
3981   CONJ_TAC;
3982     GMATCH_SIMP_TAC REAL_LE_DIV;
3983     ASM_SIMP_TAC[arith `&0 < x ==> &0 <= x`];
3984     GMATCH_SIMP_TAC REAL_LE_MUL;
3985     GMATCH_SIMP_TAC REAL_LE_MUL;
3986     BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
3987   SUBGOAL_THEN `(x4 * x5 * x6) / ups_x x4 x5 x6 * delta_x x1 x2 x3 x4 x5 x6 * &4 = (&4 * delta_x x1 x2 x3 x4 x5 x6 * x4 * x5 * x6) / ups_x x4 x5 x6` SUBST1_TAC;
3988     Calc_derivative.CALC_ID_TAC;
3989     FIRST_X_ASSUM_ST `ups_x` MP_TAC;
3990     BY(REAL_ARITH_TAC);
3991   GMATCH_SIMP_TAC REAL_LE_LDIV_EQ;
3992   ASM_REWRITE_TAC[];
3993   REWRITE_TAC[Collect_geom.RHUFIIB];
3994   REWRITE_TAC[(* Merge_ineq *) delta_delta_x];
3995   MATCH_MP_TAC (arith `&0 <= x ==> y <= x + y`);
3996   BY(REWRITE_TAC[ REAL_LE_POW_2])
3997   ]);;
3998   (* }}} *)
3999
4000
4001 let rad2_eta2 = prove_by_refinement(
4002   `!y1 y2 y3 y4 y5 y6.
4003     &2 <= y1 /\ &2 <= y2 /\ &2 <= y6 /\ y1 < &4 /\ y2 < &4 /\ y6 < &4 /\
4004     rad2_y y1 y2 y3 y4 y5 y6 < &2 /\
4005     &0 < delta_y y1 y2 y3 y4 y5 y6 ==>
4006     eta_y y1 y2 y6 pow 2 < &2`,
4007   (* {{{ proof *)
4008   [
4009   REPEAT WEAK_STRIP_TAC;
4010   MATCH_MP_TAC REAL_LET_TRANS;
4011   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `rad2_y y1 y2 y3 y4 y5 y6`)));
4012   ASM_REWRITE_TAC[];
4013   REWRITE_TAC[Sphere.eta_y;Sphere.rad2_y;LET_DEF;LET_END_DEF;Sphere.y_of_x];
4014   SUBGOAL_THEN `!x1 x2 x3 x4 x5 x6. rad2_x x1 x2 x3 x4 x5 x6 = rad2_x x4 x5 x3  x1 x2 x6` (unlist ONCE_REWRITE_TAC);
4015     BY((MESON_TAC[(* Merge_ineq *) rad2_x_sym]));
4016   MATCH_MP_TAC rad2_x_eta_x;
4017   GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
4018   GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
4019   GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
4020   ASM_SIMP_TAC[y_bounds];
4021   CONJ2_TAC;
4022     FIRST_X_ASSUM MP_TAC;
4023     REWRITE_TAC[Sphere.delta_y];
4024     MATCH_MP_TAC (arith `x = y ==> (&0 < x ==> &0 < y)`);
4025     BY((MESON_TAC[(* Merge_ineq *) delta_x_sym]));
4026   MATCH_MP_TAC UPS_X_POS;
4027   BY(ASM_REWRITE_TAC[])
4028   ]);;
4029   (* }}} *)
4030
4031
4032 let g_quqya_goal =
4033   add_hyp ["FHBVYXZ a";"FHBVYXZ b";"FWGKMBZ"]
4034     (mk_imp(cell3_from_ineq,`!y1 y2 y3 y4 y5 y6.
4035         ineq
4036       [(&2 * hminus, y1, &2 * hplus );
4037        (&2,y2,&2 * hminus );
4038        (&2,y3,&2 * hminus);
4039        (&2,y4,&2 * hminus);
4040        (&2,y5,&2 * hminus );
4041        (&2,y6,&2 * hminus )
4042       ]
4043     (rad2_y y1 y2 y3 y4 y5 y6 < &2 ==>
4044     (&0 <= gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun  + gamma3f y1 y2 y6 sqrt2 lmfun))`));;
4045
4046
4047 g g_quqya_goal;;
4048
4049 let g_quqya_g_quqyb = prove_by_refinement(
4050   g_quqya_goal,
4051   (* {{{ proof *)
4052   [
4053   REPEAT WEAK_STRIP_TAC;
4054   FIRST_X_ASSUM (C INTRO_TAC [`y1`;`y2`;`y6`]);
4055   REPEAT (FIRST_X_ASSUM (C INTRO_TAC [`y1`;`y2`;`y3`;`y4`;`y5`;`y6`]));
4056   REWRITE_TAC[Sphere.ineq];
4057   REPEAT WEAK_STRIP_TAC;
4058   REPEAT (FIRST_X_ASSUM_ST `gamma4fgcy` MP_TAC);
4059   REPEAT (FIRST_X_ASSUM_ST `gamma3f` MP_TAC);
4060   REPEAT (FIRST_X_ASSUM_ST `delta_x` MP_TAC);
4061   ASM_REWRITE_TAC[];
4062   ASM_SIMP_TAC[y_bounds];
4063   REWRITE_TAC[GSYM Sphere.rad2_y];
4064   ASM_SIMP_TAC[arith `x < y ==> ~(x > y)`];
4065   DISCH_TAC;
4066   ANTS_TAC;
4067     GMATCH_SIMP_TAC REAL_LT_RSQRT;
4068     MATCH_MP_TAC rad2_eta2;
4069     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `y3`)));
4070     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `y4`)));
4071     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `y5`)));
4072     ASM_SIMP_TAC[y_bounds];
4073     FIRST_X_ASSUM MP_TAC;
4074     REWRITE_TAC[Sphere.y_of_x];
4075     REWRITE_TAC[Sphere.y_of_x;Sphere.delta_y];
4076     BY(REAL_ARITH_TAC);
4077   BY(REAL_ARITH_TAC)
4078   ]);;
4079   (* }}} *)
4080
4081 let g_quqya_g_quqyb_ALT = prove_by_refinement(
4082   `pack_nonlinear_non_ox3q1h ==>
4083   !y1 y2 y3 y4 y5 y6.
4084         ineq
4085       [(&2 * hminus, y1, &2 * hplus );
4086        (&2,y2,&2 * hminus );
4087        (&2,y3,&2 * hminus);
4088        (&2,y4,&2 * hminus);
4089        (&2,y5,&2 * hminus );
4090        (&2,y6,&2 * hminus )
4091       ]
4092     (rad2_y y1 y2 y3 y4 y5 y6 < &2 ==>
4093     (&0 <= gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun  + gamma3f y1 y2 y6 sqrt2 lmfun))`,
4094   (* {{{ proof *)
4095   [
4096   REPEAT WEAKER_STRIP_TAC;
4097   MP_TAC cell3_from_ineq_thm_ALT;
4098   ASM_REWRITE_TAC[];
4099   DISCH_TAC;
4100   MP_TAC g_quqya_g_quqyb;
4101   ANTS_TAC;
4102     BY(ASM_REWRITE_TAC (map get_pack_nonlinear_non_ox3q1h ["FHBVYXZ a";"FHBVYXZ b";"FWGKMBZ"]));
4103   ASM_REWRITE_TAC[];
4104   BY(DISCH_THEN (unlist REWRITE_TAC))
4105   ]);;
4106   (* }}} *)
4107
4108
4109 (*
4110 let gamma10_gamma11_concl =
4111   add_hyp ["GLFVCVK4 2477216213";"QITNPEA  5400790175 a";"QITNPEA  5400790175 b";"FWGKMBZ"]
4112     (mk_imp(cell3_from_ineq,`!y1 y2 y3 y4 y5 y6.
4113     &2 * hminus <= y1 /\ y1 <= &2 * hplus /\
4114      &2 <= y2 /\ y2 < &2 * hminus /\
4115      &2 <= y3 /\ y3 < &2 * hminus /\
4116      &2 * hminus <= y4 /\ y4 <= sqrt8 /\
4117      &2 <= y5 /\ y5 < &2 * hminus /\
4118      &2 <= y6 /\ y6 < &2 * hminus /\
4119     rad2_y y1 y2 y3 y4 y5 y6 < &2 ==>
4120     (#0.0057 <= gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun / &(wtcount6_y y1 y2 y3 y4 y5 y6)
4121      + beta_bump_y y1 y2 y3 y4 y5 y6  +
4122      gamma3f y1 y2 y6 sqrt2 lmfun)`));;
4123 *)
4124
4125 let gamma10_gamma11_concl =
4126   add_hyp ["GLFVCVK4 2477216213";"QITNPEA  5400790175 a";"QITNPEA  5400790175 b";"FWGKMBZ"]
4127     (mk_imp(cell3_from_ineq,`!y1 y2 y3 y4 y5 y6.
4128     &2 * hminus <= y1 /\ y1 <= &2 * hplus /\
4129      &2 <= y2 /\ y2 < &2 * hminus /\
4130      &2 <= y3 /\ y3 < &2 * hminus /\
4131      &2 * hminus <= y4 /\ y4 <= sqrt8 /\
4132      &2 <= y5 /\ y5 < &2 * hminus /\
4133      &2 <= y6 /\ y6 < &2 * hminus /\
4134     rad2_y y1 y2 y3 y4 y5 y6 < &2 ==>
4135     (#0.0057 <= gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun / &(wtcount6_y y1 y2 y3 y4 y5 y6)
4136      + beta_bumpA_y y1 y2 y3 y4 y5 y6  +
4137      gamma3f y1 y2 y6 sqrt2 lmfun)`));;
4138
4139 let gamma10_gamma11 = prove_by_refinement(
4140   gamma10_gamma11_concl,
4141   (* {{{ proof *)
4142   [
4143   REPEAT WEAK_STRIP_TAC;
4144   FIRST_X_ASSUM (C INTRO_TAC [`y1`;`y2`;`y6`]);
4145   REPEAT (FIRST_X_ASSUM (C INTRO_TAC [`y1`;`y2`;`y3`;`y4`;`y5`;`y6`]));
4146   REWRITE_TAC[Sphere.ineq];
4147   REPEAT WEAK_STRIP_TAC;
4148   REPEAT (FIRST_X_ASSUM_ST `gamma4fgcy` MP_TAC);
4149   REPEAT (FIRST_X_ASSUM_ST `gamma3f` MP_TAC);
4150   REPEAT (FIRST_X_ASSUM_ST `delta_x` MP_TAC);
4151   ASM_REWRITE_TAC[];
4152   ASM_SIMP_TAC[y_bounds];
4153   REWRITE_TAC[GSYM Sphere.rad2_y];
4154   ASM_SIMP_TAC[arith `x < y ==> ~(x > y)`];
4155   DISCH_TAC;
4156   ANTS_TAC;
4157     GMATCH_SIMP_TAC REAL_LT_RSQRT;
4158     MATCH_MP_TAC rad2_eta2;
4159     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `y3`)));
4160     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `y4`)));
4161     GOAL_TERM (fun w -> (EXISTS_TAC ( env w `y5`)));
4162     ASM_SIMP_TAC[y_bounds];
4163     FIRST_X_ASSUM MP_TAC;
4164     REWRITE_TAC[Sphere.y_of_x;Sphere.delta_y];
4165     BY(REAL_ARITH_TAC);
4166   REPEAT DISCH_TAC;
4167   SUBGOAL_THEN `#0.0057 <= gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun / &2  +     beta_bump_lb +     gamma3f y1 y2 y6 sqrt2 lmfun` ASSUME_TAC;
4168     ASM_CASES_TAC `eta_y y1 y2 y6 pow 2 < #1.34 pow 2`;
4169       REPLICATE_TAC 4 (FIRST_X_ASSUM MP_TAC);
4170       BY(REAL_ARITH_TAC);
4171     REPEAT (FIRST_X_ASSUM_ST `gamma4fgcy` MP_TAC);
4172     ASM_REWRITE_TAC[];
4173     FIRST_X_ASSUM_ST `gamma3f` MP_TAC;
4174     BY(REAL_ARITH_TAC);
4175   FIRST_X_ASSUM MP_TAC;
4176   MATCH_MP_TAC (arith `x <= x' /\ y <= y' ==> (z <= x + y + u ==> z <= x' + y' +u)`);
4177   CONJ2_TAC;
4178     BY(ASM_MESON_TAC[(* Merge_ineq *) beta_bumpA_lb1;arith `&1 * x = x`]);
4179   ASM_CASES_TAC (`wtcount6_y y1 y2 y3 y4 y5 y6 = 2`);
4180     ASM_REWRITE_TAC[];
4181     BY(REAL_ARITH_TAC);
4182   COMMENT "insert here";
4183   FIRST_X_ASSUM_ST `norm2hh` MP_TAC;
4184   REWRITE_TAC[TAUT ` (a \/b) <=> (~b ==> a) `];
4185   ANTS_TAC;
4186     DISCH_THEN (MP_TAC o (MATCH_MP quarter_norm2hh));
4187     BY(REPEAT (FIRST_X_ASSUM_ST `hminus` MP_TAC) THEN REAL_ARITH_TAC);
4188   DISCH_TAC;
4189   COMMENT "end insert";
4190   SUBGOAL_THEN `critical_edge_y y1 /\ ~critical_edge_y y2 /\ ~critical_edge_y y3 /\ ~critical_edge_y y4 /\ ~critical_edge_y y5 /\ ~critical_edge_y y6 /\ wtcount6_y y1 y2 y3 y4 y5 y6 = 1` ASSUME_TAC;
4191     FIRST_X_ASSUM_ST `wtcount6_y` MP_TAC;
4192     REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y;Sphere.critical_edge_y];
4193     TYPED_ABBREV_TAC  `A = if &2 * hminus <= y4 /\ y4 <= &2 * hplus then 1 else 0`;
4194     ASM_REWRITE_TAC[];
4195     REPEAT (GMATCH_SIMP_TAC COND_FALSE);
4196     REWRITE_TAC[DE_MORGAN_THM;arith `~(x <= y) <=> y < x`];
4197     ASM_SIMP_TAC[y_bounds];
4198     REWRITE_TAC[arith `(1 + 0 +0 ) + A + 0 + 0 = 1 + A`];
4199     EXPAND_TAC "A";
4200     COND_CASES_TAC;
4201       BY(MESON_TAC[arith `1 + 1 = 2`]);
4202     DISCH_TAC;
4203     CONJ2_TAC;
4204       BY(ARITH_TAC);
4205     REPEAT (FIRST_X_ASSUM_ST `hminus` MP_TAC);
4206     BY(REAL_ARITH_TAC);
4207   ASM_REWRITE_TAC[];
4208   FIRST_X_ASSUM_ST `gamma4fgcy` MP_TAC;
4209   BY(REAL_ARITH_TAC)
4210   ]);;
4211   (* }}} *)
4212
4213 let gamma10_gamma11_ALT = prove_by_refinement(
4214   `pack_nonlinear_non_ox3q1h ==>
4215    (!y1 y2 y3 y4 y5 y6.
4216     &2 * hminus <= y1 /\ y1 <= &2 * hplus /\
4217      &2 <= y2 /\ y2 < &2 * hminus /\
4218      &2 <= y3 /\ y3 < &2 * hminus /\
4219      &2 * hminus <= y4 /\ y4 <= sqrt8 /\
4220      &2 <= y5 /\ y5 < &2 * hminus /\
4221      &2 <= y6 /\ y6 < &2 * hminus /\
4222     rad2_y y1 y2 y3 y4 y5 y6 < &2 ==>
4223     (#0.0057 <= gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun / &(wtcount6_y y1 y2 y3 y4 y5 y6)
4224      + beta_bumpA_y y1 y2 y3 y4 y5 y6  +
4225      gamma3f y1 y2 y6 sqrt2 lmfun))`,
4226   (* {{{ proof *)
4227   [
4228   REPEAT WEAKER_STRIP_TAC;
4229   MP_TAC cell3_from_ineq_thm_ALT;
4230   ASM_REWRITE_TAC[];
4231   DISCH_TAC;
4232   MP_TAC gamma10_gamma11;
4233   ANTS_TAC;
4234     BY(ASM_REWRITE_TAC (map get_pack_nonlinear_non_ox3q1h ["GLFVCVK4 2477216213";"QITNPEA  5400790175 a";"QITNPEA  5400790175 b";"FWGKMBZ"]));
4235   ASM_REWRITE_TAC[];
4236   DISCH_THEN MATCH_MP_TAC;
4237   BY(ASM_REWRITE_TAC[])
4238   ]);;
4239   (* }}} *)
4240
4241
4242
4243 let gamma3_x_gamma3f = prove_by_refinement(
4244   `!a b c y4 y5 y6.
4245     &2 * hminus <= y4 /\
4246     &2 <= y5 /\ y5 <= &2 * hminus /\
4247     &2 <= y6 /\ y6 <= &2 * hminus ==>
4248     gamma3f y4 y5 y6 sqrt2 lmfun = (gamma3_x (h0cut y4)) a b c (y4*y4) (y5*y5) (y6*y6)`,
4249   (* {{{ proof *)
4250   [
4251   REWRITE_TAC[Sphere.gamma3f;Functional_equation.nonf_gamma3_x;Sphere.y_of_x;Sphere.vol3r;Sphere.vol3f;Sphere.vol_y];
4252   REWRITE_TAC[Sphere.dih_y;(* Merge_ineq *) sol_y_sol_x;LET_DEF;LET_END_DEF];
4253   REWRITE_TAC[Nonlinear_lemma.sqrt2_sqrt2];
4254   REPEAT WEAK_STRIP_TAC;
4255   REPEAT (GMATCH_SIMP_TAC Nonlinear_lemma.sqrtxx);
4256   ASM_SIMP_TAC[y_bounds];
4257   REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC);
4258   REWRITE_TAC[arith `x * #0.5 = x/ &2`];
4259   REWRITE_TAC[GSYM (* Merge_ineq *) lmfun_h0cut];
4260   REPEAT (GMATCH_SIMP_TAC (GSYM Nonlinear_lemma.lmfun_lfun));
4261   ASM_SIMP_TAC[y_bounds];
4262   BINOP_TAC;
4263     REWRITE_TAC[ (arith `x * &2 * mm1/pi = (&2 * mm1/pi) * x`)];
4264     AP_TERM_TAC;
4265     BY(MESON_TAC[(* Merge_ineq *) sol_x_sym;(* Merge_ineq *) sol_x_sym2]);
4266   REWRITE_TAC[arith `x * &8 * mm2/ pi = (&8 * mm2 /pi) * x`];
4267   AP_TERM_TAC;
4268   BY(MESON_TAC[Nonlinear_lemma.dih_x_sym2;Nonlinear_lemma.dih_x_sym])
4269   ]);;
4270   (* }}} *)
4271
4272 let atn_add = prove_by_refinement(
4273   `!x y. abs(atn x + atn y) < pi / &2 ==>
4274     atn x + atn y = atn ((x+y)/(&1 - x * y))`,
4275   (* {{{ proof *)
4276   [
4277   REPEAT WEAK_STRIP_TAC;
4278   MATCH_MP_TAC Taylor_atn.tan_one_one;
4279   GMATCH_SIMP_TAC TAN_ADD;
4280   REWRITE_TAC[ATN_TAN;ATN_BOUND];
4281   ASM_REWRITE_TAC[COS_ATN_NZ];
4282   MATCH_MP_TAC Taylor_atn.cos_nz;
4283   BY(ASM_REWRITE_TAC[])
4284   ]);;
4285   (* }}} *)
4286
4287
4288
4289 let atn_inv = prove_by_refinement(
4290   `!x. &0 < x ==> atn x + atn (&1 / x) = pi/ &2`,
4291   (* {{{ proof *)
4292   [
4293   REPEAT WEAK_STRIP_TAC;
4294   ASM_SIMP_TAC[GSYM Trigonometry1.ATN2_BREAKDOWN];
4295   SIMP_TAC[arith `&0 < &1`; Trigonometry1.ATN2_BREAKDOWN];
4296   REWRITE_TAC[arith `x / &1 = x`];
4297   BY(REAL_ARITH_TAC)
4298   ]);;
4299   (* }}} *)
4300
4301 let atn_add2 = prove_by_refinement(
4302   `!x y. &0 < x /\ &0 < y /\ x * y < &1 ==>
4303     atn x + atn y = atn ((x+y)/(&1 - x * y))`,
4304   (* {{{ proof *)
4305   [
4306   REPEAT WEAK_STRIP_TAC;
4307   MATCH_MP_TAC atn_add;
4308   MATCH_MP_TAC (arith `&0 < u /\ u < y ==> abs(u) < y`);
4309   CONJ_TAC;
4310     MATCH_MP_TAC (arith `&0 < x /\ &0 < y ==> &0 < x + y`);
4311     BY(ASM_REWRITE_TAC[ ATN_POS_LT]);
4312   INTRO_TAC ATN_MONO_LT [`y`;`&1 / x`];
4313   ANTS_TAC;
4314     GMATCH_SIMP_TAC REAL_LT_RDIV_EQ;
4315     ONCE_REWRITE_TAC[arith `x * y = y*x`];
4316     BY(ASM_REWRITE_TAC[]);
4317   DISCH_TAC;
4318   GMATCH_SIMP_TAC (GSYM atn_inv);
4319   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `x`)));
4320   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
4321   ]);;
4322   (* }}} *)
4323
4324 let delta_x_rrr = prove_by_refinement(
4325   `!x1 x2 x6 r. delta_x x1 x2 r r r x6 = -- x1 * x2 *x6 + r * ups_x x1 x2 x6`,
4326   (* {{{ proof *)
4327   [
4328   REWRITE_TAC[Sphere.delta_x;Sphere.ups_x];
4329   BY(REAL_ARITH_TAC)
4330   ]);;
4331   (* }}} *)
4332
4333 let rho_x_ups_x = prove_by_refinement(
4334   `!x1 x2 x3 x4 x5 x6.
4335     rho_x x1 x2 x3 x4 x5 x6 * ups_x x1 x2 x6 = chi_x x4 x5 x3 x1 x2 x6 pow 2 + &4 * delta_x x1 x2 x3 x4 x5 x6 * x1 * x2 * x6`,
4336   (* {{{ proof *)
4337   [
4338   REWRITE_TAC[Sphere.rho_x;Sphere.chi_x;Sphere.delta_x;Sphere.ups_x];
4339   BY(REAL_ARITH_TAC)
4340   ]);;
4341   (* }}} *)
4342
4343 let chi_rad2 = prove_by_refinement(
4344   `!x1 x2 x3 x4 x5 x6 r.
4345     rad2_x x1 x2 x3 x4 x5 x6 = r /\ ~(delta_x x1 x2 x3 x4 x5 x6 = &0) ==>
4346     delta_x x1 x2 r r r x6 = (chi_x x4 x5 x3 x1 x2 x6 pow 2)/ (&4 * delta_x x1 x2 x3 x4 x5 x6)`,
4347   (* {{{ proof *)
4348   [
4349   REWRITE_TAC[Sphere.rad2_x;delta_x_rrr];
4350   REPEAT WEAK_STRIP_TAC;
4351   EXPAND_TAC "r";
4352   SUBGOAL_THEN `rho_x x1 x2 x3 x4 x5 x6 / (delta_x x1 x2 x3 x4 x5 x6 * &4) * ups_x x1 x2 x6 = (rho_x x1 x2 x3 x4 x5 x6 * ups_x x1 x2 x6) /  (&4 *delta_x x1 x2 x3 x4 x5 x6)` SUBST1_TAC;
4353     Calc_derivative.CALC_ID_TAC;
4354     BY(ASM_REWRITE_TAC[arith `~(&4 = &0)`]);
4355   REWRITE_TAC[rho_x_ups_x];
4356   Calc_derivative.CALC_ID_TAC;
4357   ASM_REWRITE_TAC[];
4358   BY(REAL_ARITH_TAC)
4359   ]);;
4360   (* }}} *)
4361
4362 let delta_x4_rad2 = prove_by_refinement(
4363   `!x1 x2 x3 x4 x5 x6 r.
4364     rad2_x x1 x2 x3 x4 x5 x6 = r /\ ~(delta_x x1 x2 x3 x4 x5 x6 = &0) ==>
4365     delta_x4 x1 x2 r r r x6 = x1 * (-- x1 + x2 + x6)
4366     `,
4367   (* {{{ proof *)
4368   [
4369   REWRITE_TAC[Sphere.rad2_x];
4370   REPEAT WEAK_STRIP_TAC;
4371   REWRITE_TAC[Sphere.delta_x4];
4372   EXPAND_TAC "r";
4373   ABBREV_TAC `h = rho_x x1 x2 x3 x4 x5 x6`;
4374   Calc_derivative.CALC_ID_TAC;
4375   ASM_REWRITE_TAC[];
4376   BY(REAL_ARITH_TAC)
4377   ]);;
4378   (* }}} *)
4379
4380
4381
4382 let dih_x_rad2 = prove_by_refinement(
4383   `!x1 x2 x3 x4 x5 x6 r.
4384     rad2_x x1 x2 x3 x4 x5 x6 = r /\ &0 < delta_x x1 x2 x3 x4 x5 x6 /\ &0 < x1 ==>
4385     dih_x x1 x2 r r r x6 = pi/ &2 + atn2 (abs(chi_x x4 x5 x3 x1 x2 x6) , sqrt(x1 * delta_x x1 x2 x3 x4 x5 x6) * (x1 - x2 - x6))`,
4386   (* {{{ proof *)
4387   [
4388   REWRITE_TAC[Sphere.dih_x;LET_DEF;LET_END_DEF];
4389   REPEAT WEAK_STRIP_TAC;
4390   GMATCH_SIMP_TAC delta_x4_rad2;
4391   GMATCH_SIMP_TAC chi_rad2;
4392   GEXISTL_TAC [`x3`;`x4`;`x5`];
4393   ASM_SIMP_TAC[ arith `&0 < x ==> ~(x = &0)`];
4394   CONJ_TAC;
4395     BY(ASM_MESON_TAC[arith `&0 < x ==> ~(x = &0)`]);
4396   AP_TERM_TAC;
4397   SUBGOAL_THEN `&0 < sqrt (x1 / delta_x x1 x2 x3 x4 x5 x6)` ASSUME_TAC;
4398     GMATCH_SIMP_TAC SQRT_POS_LT;
4399     GMATCH_SIMP_TAC REAL_LT_DIV;
4400     BY(ASM_REWRITE_TAC[]);
4401   SUBGOAL_THEN `sqrt   (&4 *   x1 *   chi_x x4 x5 x3 x1 x2 x6 pow 2 / (&4 * delta_x x1 x2 x3 x4 x5 x6)) = (sqrt (x1 /delta_x x1 x2 x3 x4 x5 x6)) * abs(chi_x x4 x5 x3 x1 x2 x6)` SUBST1_TAC;
4402     REWRITE_TAC[ GSYM POW_2_SQRT_ABS ];
4403     GMATCH_SIMP_TAC (GSYM SQRT_MUL);
4404     REWRITE_TAC[ REAL_LE_POW_2];
4405     GMATCH_SIMP_TAC REAL_LE_DIV;
4406     ASM_SIMP_TAC[arith `&0 < x ==> &0 <= x`];
4407     AP_TERM_TAC;
4408     Calc_derivative.CALC_ID_TAC;
4409     ASM_SIMP_TAC[arith `&0 < x ==> ~(x = &0)`];
4410     BY(REAL_ARITH_TAC);
4411   SUBGOAL_THEN `-- (x1 * (-- x1 + x2 + x6)) = sqrt(x1 / delta_x x1 x2 x3 x4 x5 x6) * (sqrt (x1 * delta_x x1 x2 x3 x4 x5 x6) *  (x1 - x2 - x6))` SUBST1_TAC;
4412     ONCE_REWRITE_TAC[arith `x * y * z = (z * (x * y))`];
4413     GMATCH_SIMP_TAC (GSYM SQRT_MUL);
4414     GMATCH_SIMP_TAC REAL_LE_MUL;
4415     GMATCH_SIMP_TAC REAL_LE_DIV;
4416     ASM_SIMP_TAC[arith `&0 < x ==> &0 <= x`];
4417     SUBGOAL_THEN `x1 / delta_x x1 x2 x3 x4 x5 x6 * x1 * delta_x x1 x2 x3 x4 x5 x6 = x1 pow 2` SUBST1_TAC;
4418       Calc_derivative.CALC_ID_TAC;
4419       BY(ASM_SIMP_TAC[arith `&0 < x ==> ~(x = &0)`]);
4420     GMATCH_SIMP_TAC POW_2_SQRT;
4421     CONJ_TAC;
4422       BY(ASM_SIMP_TAC[arith `&0 < x ==> &0 <= x`]);
4423     BY(REAL_ARITH_TAC);
4424   MATCH_MP_TAC Trigonometry1.ATN2_LMUL_EQ;
4425   BY(ASM_REWRITE_TAC[])
4426   ]);;
4427   (* }}} *)
4428
4429 (*
4430 let dih_circumrad = prove_by_refinement(
4431   `!x1 x2 x3 x4 x5 x6 r.
4432     rad2_x x1 x2 x3 x4 x5 x6 = r ==>
4433     dih_x x1 x2 r r r x6 + dih_x x1 r x3 r x5 r = dih_x x1 x2 x3 x4 x5 x6`,
4434   (* {{{ proof *)
4435   [
4436     rt[Sphere.dih_x;LET_DEF;LET_END_DEF;Sphere.rad2_x]
4437   ]);;
4438   (* }}} *)
4439 *)
4440
4441 let gamma23_full8_x_gamma = prove_by_refinement(
4442  (add_hyp  ["GRKIBMP A V2"] `!y1 y2 y3 y4 y5 y6 .
4443     eta_y y1 y2 y6 pow 2 < &2 /\
4444     eta_y y1 y3 y5 pow 2 < &2 /\
4445     &2 <= rad2_y y1 y2 y3 y4 y5 y6 /\
4446     dih_y y1 y2 sqrt2 sqrt2 sqrt2 y6 + dih_y y1 sqrt2 y3 sqrt2 y5 sqrt2 <= dih_y y1 y2 y3 y4 y5 y6
4447  ==>
4448     ineq [
4449       (&2 * hminus, y1, &2 * hplus);
4450       (&2 ,y2,&2 * hminus);
4451       (&2,y3,&2 * hminus);
4452       (&2,y4,sqrt8);
4453       (&2,y5,&2 * hminus);
4454       (&2,y6,&2 * hminus)
4455     ]
4456     (
4457     y_of_x (gamma23_full8_x (h0cut y1)) y1 y2 y3 y4 y5 y6 <=
4458     gamma3f y1 y2 y6 sqrt2 lmfun + gamma3f y1 y3 y5 sqrt2 lmfun +
4459     (dih_y y1 y2 y3 y4 y5 y6 - dih_y y1 y2 sqrt2 sqrt2 sqrt2 y6 - dih_y y1 sqrt2 y3 sqrt2 y5 sqrt2) *  gamma2_x_div_azim_v2 (h0cut y1) (y1* y1))`)
4460 ,
4461   (* {{{ proof *)
4462   [
4463   REWRITE_TAC[Sphere.ineq];
4464   REPEAT WEAK_STRIP_TAC;
4465   REWRITE_TAC[Functional_equation.nonf_gamma23_full8_x;Sphere.y_of_x];
4466   REPEAT (GMATCH_SIMP_TAC (GSYM gamma3_x_gamma3f));
4467   ASM_SIMP_TAC[y_bounds];
4468   REWRITE_TAC[Sphere.dih_y;LET_DEF;LET_END_DEF;Nonlinear_lemma.sqrt2_sqrt2];
4469   MATCH_MP_TAC( arith `u <= v ==> (x + y + u <= x + y + v)`);
4470   REWRITE_TAC[ arith `x - (y + z) = x - y - z`];
4471   GMATCH_SIMP_TAC Real_ext.REAL_LE_LMUL_IMP;
4472   CONJ2_TAC;
4473     FIRST_X_ASSUM (C INTRO_TAC [`y1`;`&1`;`&1`;`&1`;`&1`;`&1`]);
4474     ASM_SIMP_TAC[y_bounds;arith `&1 <= &1`];
4475     REWRITE_TAC[Functional_equation.nonf_gamma2_x1_div_a_v2;Sphere.y_of_x];
4476     BY(REAL_ARITH_TAC);
4477   FIRST_X_ASSUM_ST `dih_y` MP_TAC;
4478   REWRITE_TAC[Sphere.dih_y;LET_DEF;LET_END_DEF];
4479   REWRITE_TAC[Nonlinear_lemma.sqrt2_sqrt2];
4480   BY(REAL_ARITH_TAC)
4481   ]);;
4482   (* }}} *)
4483
4484
4485 let undiv_gamma3 = prove_by_refinement(
4486   `!y4 y5 y6 w.
4487   &2 <= y4 /\
4488             &2 <= y5 /\
4489             &2 <= y6 /\
4490             y4 <= &2 * sqrt (&2) /\
4491             y5 <= &2 * sqrt (&2) /\
4492             y6 <= &2 * hminus /\
4493               eta_x (y4 * y4) (y5 * y5) (y6 * y6) < sqrt (&2) /\
4494      #0.008 *y_of_x dih4_x_div_sqrtdelta_posbranch sqrt2 sqrt2 sqrt2 y4 y5 y6 <
4495     y_of_x (gamma3f_x_div_sqrtdelta (h0cut y4) (h0cut y5) (&1)) sqrt2 sqrt2 sqrt2 y4 y5 y6 / w ==>   #0.008 * dih_y y4 sqrt2 y6 sqrt2 y5 sqrt2 < gamma3f y4 y5 y6 sqrt2 lmfun /w`,
4496   (* {{{ proof *)
4497   [
4498   REPEAT WEAK_STRIP_TAC;
4499   GMATCH_SIMP_TAC gamma3f_gamma3f_x_div_sqrtdelta;
4500   GEXISTL_TAC [`sqrt2 * sqrt2`;`sqrt2 * sqrt2`;`sqrt2 * sqrt2`];
4501   ASM_SIMP_TAC[y_bounds];
4502   REWRITE_TAC[Sphere.dih_y;LET_DEF;LET_END_DEF];
4503   REWRITE_TAC[Nonlinear_lemma.sqrt2_sqrt2];
4504   GMATCH_SIMP_TAC dih_x_dih_x_div_sqrtdelta_posbranch;
4505   GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
4506   SUBGOAL_THEN `delta_x4 (y4 * y4) (y5 * y5) (&2) (&2) (&2) (y6 * y6) = delta_x4 (y4*y4) (&2) (y5 * y5) (&2) (y6*y6) (&2)` SUBST1_TAC;
4507     REWRITE_TAC[Sphere.delta_x4];
4508     BY((REAL_ARITH_TAC));
4509   GMATCH_SIMP_TAC (* Merge_ineq *) delta_x4_pos;
4510   GMATCH_SIMP_TAC REAL_LT_MUL_EQ;
4511   ASM_SIMP_TAC[y_bounds];
4512   REWRITE_TAC[arith `&4 = &2 * &2 /\ &8 = #8.0`;GSYM Nonlinear_lemma.sqrt8_2];
4513   GMATCH_SIMP_TAC Misc_defs_and_lemmas.ABS_SQUARE;
4514   GMATCH_SIMP_TAC Misc_defs_and_lemmas.ABS_SQUARE_LE;
4515   GMATCH_SIMP_TAC Misc_defs_and_lemmas.ABS_SQUARE_LE;
4516   REWRITE_TAC[arith `abs(&2) = &2`];
4517   GMATCH_SIMP_TAC (arith `&0 <= y ==> abs(y) = y`);
4518   ASM_SIMP_TAC[y_bounds];
4519   SUBGOAL_THEN `y4 < sqrt8` ASSUME_TAC;
4520     MATCH_MP_TAC ETA_Y_LE_IMP_LT;
4521     REWRITE_TAC[Sphere.eta_y;LET_DEF;LET_END_DEF];
4522     GEXISTL_TAC [`y5`;`y6`];
4523     ASM_SIMP_TAC[y_bounds];
4524     BY((ASM_SIMP_TAC[Sphere.sqrt2;Nonlinear_lemma.sqrt8_sqrt2]));
4525   ASM_REWRITE_TAC[];
4526   SUBGOAL_THEN `delta_x (y4 * y4) (y5 * y5) (&2) (&2) (&2) (y6 * y6) = delta_x (&2) (&2) (&2) (y4 * y4) (y5 * y5)  (y6 * y6) ` SUBST1_TAC;
4527     REWRITE_TAC[Sphere.delta_x];
4528     BY((REAL_ARITH_TAC));
4529   SUBGOAL_THEN `delta_x (y4 * y4) (&2) (y6 * y6) (&2) (y5 * y5) (&2) = delta_x (&2) (&2) (&2) (y4 * y4) (y5 * y5)  (y6 * y6) ` SUBST1_TAC;
4530     REWRITE_TAC[Sphere.delta_x];
4531     BY((REAL_ARITH_TAC));
4532   SUBCONJ_TAC;
4533     GMATCH_SIMP_TAC (MESON[ETA_Y_BOUNDS] `!y4 y5 y6. &2 <= y4 /\ y4 <= sqrt8 /\ &2 <= y5 /\ y5 <= sqrt8 /\ &2 <= y6 /\ y6 <= sqrt8 /\    eta_y y4 y5 y6 < sqrt2 ==>     &0 < delta_x (&2) (&2) (&2) (y4 * y4) (y5*y5) (y6*y6)`);
4534     REWRITE_TAC[Sphere.eta_y;LET_DEF;LET_END_DEF];
4535     ASM_SIMP_TAC[y_bounds];
4536     BY((ASM_SIMP_TAC[Sphere.sqrt2;Nonlinear_lemma.sqrt8_sqrt2]));
4537   DISCH_TAC;
4538   INTRO_TAC Optimize.h0cutC [`y6`];
4539   ASM_REWRITE_TAC[];
4540   DISCH_THEN SUBST1_TAC;
4541   ONCE_REWRITE_TAC[arith `(a * b * c < (e * b)/w) <=> (b * (a *c) < b * (e/w))`];
4542   GMATCH_SIMP_TAC REAL_LT_LMUL_EQ;
4543   GMATCH_SIMP_TAC SQRT_POS_LT;
4544   ASM_REWRITE_TAC[];
4545   FIRST_X_ASSUM_ST `y_of_x` MP_TAC;
4546   REWRITE_TAC[Sphere.y_of_x];
4547   REWRITE_TAC[Nonlinear_lemma.sqrt2_sqrt2];
4548   BY((REWRITE_TAC[Nonlin_def.dih4_x_div_sqrtdelta_posbranch;Sphere.rotate4]))
4549   ]);;
4550   (* }}} *)
4551
4552
4553
4554 let undiv_gamma3_nn = prove_by_refinement(
4555   `!y4 y5 y6 w w'.
4556     &0 < w' /\
4557             &0 <= gamma3f y4 y5 y6 sqrt2 lmfun /\
4558   &2 <= y4 /\
4559             &2 <= y5 /\
4560             &2 <= y6 /\
4561             y4 <= &2 * sqrt (&2) /\
4562             y5 <= &2 * sqrt (&2) /\
4563             y6 <= &2 * hminus /\
4564               eta_x (y4 * y4) (y5 * y5) (y6 * y6) < sqrt (&2) /\
4565               w' <= w /\
4566      #0.008 *y_of_x dih4_x_div_sqrtdelta_posbranch sqrt2 sqrt2 sqrt2 y4 y5 y6 <
4567     y_of_x (gamma3f_x_div_sqrtdelta (h0cut y4) (h0cut y5) (&1)) sqrt2 sqrt2 sqrt2 y4 y5 y6 / w ==>   #0.008 * dih_y y4 sqrt2 y6 sqrt2 y5 sqrt2 < gamma3f y4 y5 y6 sqrt2 lmfun /w'`,
4568   (* {{{ proof *)
4569   [
4570   REPEAT WEAK_STRIP_TAC;
4571   MATCH_MP_TAC REAL_LTE_TRANS;
4572   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `gamma3f y4 y5 y6 sqrt2 lmfun / w`)));
4573   CONJ_TAC;
4574     MATCH_MP_TAC undiv_gamma3;
4575     BY(ASM_REWRITE_TAC[]);
4576   GMATCH_SIMP_TAC REAL_LE_RDIV_EQ;
4577   REWRITE_TAC[arith `x / y * z = (x * z) / y`];
4578   GMATCH_SIMP_TAC REAL_LE_LDIV_EQ;
4579   GMATCH_SIMP_TAC Real_ext.REAL_LE_LMUL_IMP;
4580   BY(ASM_MESON_TAC[arith `&0 < w' /\ w' <= w ==> &0 < w`])
4581   ]);;
4582   (* }}} *)
4583
4584
4585
4586 (* final hypothesis is contained in cell3_from_ineq_thm *)
4587
4588 let cell3_008_from_ineq = `!y1 y2 y6.
4589    &2 *hminus <= y1 /\ &2 <= y2 /\ &2 <= y6 /\
4590     y1 <= &2 * hplus /\ y2 <= &2 * sqrt(&2) /\ y6 <= &2 * sqrt(&2) /\
4591     eta_y (y1) (y2) (y6) < sqrt(&2) /\ &0 <= gamma3f y1 y2 y6 sqrt2 lmfun ==>
4592     dih_y y1 y2 sqrt2 sqrt2 sqrt2 y6  * #0.008 <= gamma3f y1 y2 y6 sqrt2 lmfun / &(wtcount3_y y1 y2 y6)`;;
4593
4594 let cell3_008 =
4595   add_hyp  [          "QZECFIC wt1";"QZECFIC wt2 A";"CIHTIUM";(* "CJFZZDW"; *)]
4596     cell3_008_from_ineq;;
4597
4598 (*
4599 g cell3_008;;
4600 g  (mk_imp(`pack_nonlinear_non_ox3q1h`,cell3_008_from_ineq));;
4601 *)
4602
4603 let cell3_008_from_ineq_thm = prove_by_refinement(
4604   cell3_008,
4605   (* {{{ proof *)
4606   [
4607   DISCH_TAC;
4608   COMMENT "0. symmetry reduction";
4609   SUBGOAL_THEN `!(p:real->real->real->bool). (!y1 y2 y6. p y1 y2 y6 ==> p y1 y6 y2) /\ (!y1 y2 y6. y6 <= y2 ==> p y1 y2 y6) ==> (!y1 y2 y6. p y1 y2 y6)` MATCH_MP_TAC;
4610     BY(MESON_TAC[arith `y <= x \/ x <= y`]);
4611   CONJ_TAC;
4612     REPEAT WEAK_STRIP_TAC;
4613     FIRST_X_ASSUM_ST `( /\ )` MP_TAC;
4614     ASM_SIMP_TAC[];
4615     SUBGOAL_THEN `gamma3f y1 y2 y6 sqrt2 lmfun = gamma3f y1 y6 y2 sqrt2 lmfun` SUBST1_TAC;
4616       BY(ASM_MESON_TAC[(* Merge_ineq *) gamma3f_sym]);
4617     ASM_REWRITE_TAC[];
4618     ANTS_TAC;
4619       BY(ASM_MESON_TAC[Collect_geom.ETA_Y_SYYM]);
4620     SUBGOAL_THEN `dih_y y1 y6 sqrt2 sqrt2 sqrt2 y2 = dih_y y1 y2 sqrt2 sqrt2 sqrt2 y6` SUBST1_TAC;
4621       BY(MESON_TAC[Nonlinear_lemma.dih_y_sym;Nonlinear_lemma.dih_y_sym2]);
4622     SUBGOAL_THEN `wtcount3_y y1 y6 y2 = wtcount3_y y1 y2 y6` SUBST1_TAC;
4623       REWRITE_TAC[Sphere.wtcount3_y];
4624       BY(ARITH_TAC);
4625     BY(MESON_TAC[]);
4626   REPEAT GEN_TAC;
4627   DISCH_THEN BURY_TAC;
4628   ABBREV_TAC `Q = (\y1 y2 y6. &2 * hminus <= y1 /\ &2 <= y2 /\ &2 <= y6 /\ y1 <= &2 * hplus /\ y2 <= &2 * sqrt (&2) /\ y6 <= &2 * sqrt (&2) /\ eta_y y1 y2 y6 < sqrt (&2))`;
4629   DISCH_TAC;
4630   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w`Q y1 y2 y6`) ASSUME_TAC));
4631     EXPAND_TAC "Q";
4632     BY(BY((ASM_REWRITE_TAC[])));
4633   INTRO_TAC ETA_Y_BOUNDS [`y1`;`y2`;`y6`];
4634   ANTS_TAC;
4635     BY(ASM_SIMP_TAC[y_bounds;Nonlinear_lemma.sqrt8_sqrt2;Sphere.sqrt2]);
4636   REPEAT WEAK_STRIP_TAC;
4637   INTRO_TAC ETA_Y_LE_IMP_LT_ALL [`y1`;`y2`;`y6`];
4638   ANTS_TAC;
4639     BY((((ASM_SIMP_TAC[Nonlinear_lemma.sqrt8_sqrt2;Sphere.sqrt2;y_bounds]))));
4640   REPEAT WEAK_STRIP_TAC;
4641   COMMENT "1. remove excess variables";
4642   REPEAT (FIRST_X_ASSUM_ST `ineq` MP_TAC);
4643   REWRITE_TAC[ineq_constant];
4644   REWRITE_TAC[ RIGHT_FORALL_IMP_THM];
4645   REWRITE_TAC[MESON[] `(!y. (y = a ==> P y)) <=> P a`];
4646   REPEAT WEAK_STRIP_TAC;
4647   COMMENT "2. insert Q";
4648   REPEAT (FIRST_X_ASSUM_ST `ineq` MP_TAC);
4649   REWRITE_TAC[arith `!x y. x > y <=> y < x`;arith `!x y. x >= y <=> y <= x`];
4650   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!P. (!y4 y5 y6. P y4 y5 y6) ==> (!y4 y5 y6. Q y4 y5 y6 ==> P y4 y5 y6)`) MP_TAC));
4651     BY((((MESON_TAC[]))));
4652   DISCH_THEN (fun t -> (REPEAT (DISCH_THEN (ASSUME_TAC o (MATCH_MP t)))));
4653   COMMENT "3. remove eta_y";
4654   GOAL_TERM (fun w -> (SUBGOAL_THEN ( env w `!R f.  (!y4 y5 y6. Q y4 y5 y6 ==> ineq (R y4 y5 y6) (f y4 y5 y6 \/ &2 < eta_y y4 y5 y6 pow 2)) ==> (!y4 y5 y6. Q y4 y5 y6 ==> ineq (R y4 y5 y6) (f y4 y5 y6))`) MP_TAC));
4655     REPEAT WEAK_STRIP_TAC;
4656     GOAL_TERM (fun w -> (FIRST_X_ASSUM (MP_TAC o (ISPECL ( envl w [`y4`;`y5`;`y6'`])))));
4657     ASM_REWRITE_TAC[];
4658     MATCH_MP_TAC ineq_monotone;
4659     GOAL_TERM (fun w -> (ENOUGH_TO_SHOW_TAC ( env w `~(&2 < eta_y y4 y5 y6' pow 2)`)));
4660       BY((((MESON_TAC[]))));
4661     MATCH_MP_TAC (arith `x < &2 ==> ~(&2 < x)`);
4662     FIRST_X_ASSUM MP_TAC;
4663     EXPAND_TAC "Q";
4664     DISCH_TAC;
4665     REWRITE_TAC[GSYM Nonlinear_lemma.sqrt2_sqrt2];
4666     REWRITE_TAC[arith `x pow 2 = x * x`];
4667     GMATCH_SIMP_TAC Misc_defs_and_lemmas.ABS_SQUARE;
4668     GMATCH_SIMP_TAC (arith `&0 <= x ==> (abs x = x)`);
4669     ASM_REWRITE_TAC[Sphere.sqrt2];
4670     MATCH_MP_TAC eta_y_nn;
4671     BY((((ASM_MESON_TAC[ETA_Y_BOUNDS;y_bounds;arith `x < y ==> x <= y`;Sphere.sqrt2;Nonlinear_lemma.sqrt8_sqrt2]))));
4672   DISCH_THEN (fun t -> (REPEAT (FIRST_X_ASSUM_ST `eta_y` (fun CONJUNCTS_THEN2 -> ASSUME_TAC (MATCH_MP t CONJUNCTS_THEN2)))) THEN MP_TAC t);
4673   MP_TAC (MESON[] `!y4 y5 y6. &2 < eta_y y4 y5 y6 pow 2 <=> (F \/ &2 < eta_y y4 y5 y6 pow 2)`);
4674   DISCH_THEN (fun t -> REPEAT (FIRST_X_ASSUM_ST `eta_y` (MP_TAC o (ONCE_REWRITE_RULE[t]))));
4675   REPEAT WEAK_STRIP_TAC;
4676   FIRST_X_ASSUM MP_TAC;
4677   (DISCH_THEN (fun t -> (REPEAT (FIRST_X_ASSUM_ST `eta_y` (fun CONJUNCTS_THEN2 -> ASSUME_TAC (MATCH_MP t CONJUNCTS_THEN2)))) THEN MP_TAC t));
4678   DISCH_THEN kill;
4679   COMMENT "add weight counts";
4680   SUBGOAL_THEN `critical_edge_y y1` ASSUME_TAC;
4681     REWRITE_TAC[Sphere.critical_edge_y];
4682     BY(ASM_SIMP_TAC[y_bounds]);
4683   SUBGOAL_THEN `y6 < &2 * hminus` ASSUME_TAC;
4684     REWRITE_TAC[arith `x < y <=> ~(y <= x)`];
4685     DISCH_TAC;
4686     FIRST_X_ASSUM (C INTRO_TAC [`y1`;`y2`;`y6`]);
4687     ASM_SIMP_TAC[y_bounds;Sphere.ineq];
4688     ASM_SIMP_TAC[Nonlinear_lemma.sqrt8_sqrt2;Sphere.sqrt2];
4689     REWRITE_TAC[TAUT `(~(a ==> ~b)) <=> (a /\ b)`];
4690     CONJ2_TAC;
4691       BY(ASM_MESON_TAC[arith `x <= y /\ y <= z ==> x <= z`]);
4692     BY(ASM_MESON_TAC[Nonlinear_lemma.sqrt8_sqrt2;Sphere.sqrt2;y_bounds]);
4693   SUBGOAL_THEN `~critical_edge_y y6` ASSUME_TAC;
4694     BY(ASM_REWRITE_TAC[Sphere.critical_edge_y;arith `x <= y <=> ~(y < x)`]);
4695   SUBGOAL_THEN `wtcount3_y y1 y2 y6 =  if critical_edge_y y2 then 2 else 1` ASSUME_TAC;
4696     ASM_REWRITE_TAC[Sphere.wtcount3_y];
4697     BY(COND_CASES_TAC THEN TRY (ARITH_TAC));
4698   COMMENT "4. apply undiv_gamma3";
4699   MATCH_MP_TAC (arith `a * b < c ==> b * a <= c`);
4700   SUBGOAL_THEN `dih_y y1 y2 sqrt2 sqrt2 sqrt2 y6 = dih_y y1 sqrt2 y6 sqrt2 y2 sqrt2` SUBST1_TAC;
4701     BY(MESON_TAC[Nonlinear_lemma.dih_y_sym;Nonlinear_lemma.dih_y_sym2]);
4702   MATCH_MP_TAC undiv_gamma3_nn;
4703   ASM_SIMP_TAC[y_bounds];
4704   REWRITE_TAC[RIGHT_EXISTS_AND_THM];
4705   CONJ_TAC;
4706     BY(COND_CASES_TAC THEN REAL_ARITH_TAC);
4707   CONJ_TAC;
4708     FIRST_X_ASSUM_ST `eta_y` MP_TAC;
4709     BY(REWRITE_TAC[Sphere.eta_y;LET_DEF;LET_END_DEF]);
4710   COMMENT "5. split along y2";
4711   ASM_CASES_TAC `y2 < &2 * hminus`;
4712     SUBGOAL_THEN `~critical_edge_y y2` (unlist REWRITE_TAC);
4713       REWRITE_TAC[Sphere.critical_edge_y];
4714       BY(ASM_SIMP_TAC[arith `x < y ==> ~(y <= x)`]);
4715     EXISTS_TAC `&1`;
4716     REWRITE_TAC[arith `&1 <= &1`];
4717     SUBGOAL_THEN `h0cut y2 = &1` SUBST1_TAC;
4718       MATCH_MP_TAC Optimize.h0cutC;
4719       BY(ASM_SIMP_TAC[arith `x < y ==> (x <= y)`]);
4720     REWRITE_TAC[arith `x/ &1 = x`];
4721     FIRST_X_ASSUM_ST `h0cut` MP_TAC;
4722     REWRITE_TAC[Sphere.ineq;TAUT `(a ==> b ==> c) <=> (a /\ b ==> c)`];
4723     DISCH_THEN MATCH_MP_TAC;
4724     BY(ASM_SIMP_TAC [arith `x < y ==> x <= y`]);
4725   COMMENT "5a. second half of split";
4726   EXISTS_TAC `&2`;
4727   CONJ_TAC;
4728     BY(COND_CASES_TAC THEN REAL_ARITH_TAC);
4729   FIRST_X_ASSUM_ST `x / &2 ` MP_TAC;
4730   REWRITE_TAC[Sphere.ineq;TAUT `(a ==> b ==> c) <=> (a /\ b ==> c)`];
4731   DISCH_THEN MATCH_MP_TAC;
4732   BY(ASM_SIMP_TAC [arith `~(x < y) ==> y <= x`;arith `x < y ==> x<= y`])
4733   ]);;
4734   (* }}} *)
4735
4736 let cell3_008_from_ineq_ALT = prove_by_refinement(
4737 `pack_nonlinear_non_ox3q1h ==> (!y1 y2 y6.
4738    &2 *hminus <= y1 /\ &2 <= y2 /\ &2 <= y6 /\
4739     y1 <= &2 * hplus /\ y2 <= &2 * sqrt(&2) /\ y6 <= &2 * sqrt(&2) /\
4740     eta_y (y1) (y2) (y6) < sqrt(&2)
4741     ==>
4742     dih_y y1 y2 sqrt2 sqrt2 sqrt2 y6  * #0.008 <= gamma3f y1 y2 y6 sqrt2 lmfun / &(wtcount3_y y1 y2 y6))`,
4743   (* {{{ proof *)
4744   [
4745   REPEAT WEAKER_STRIP_TAC;
4746   MP_TAC cell3_from_ineq_thm_ALT;
4747   ASM_REWRITE_TAC[];
4748   DISCH_TAC;
4749   MP_TAC cell3_008_from_ineq_thm;
4750   ANTS_TAC;
4751     BY((ASM_REWRITE_TAC (map get_pack_nonlinear_non_ox3q1h ["QZECFIC wt1";"QZECFIC wt2 A";"CIHTIUM"])));
4752   DISCH_THEN MATCH_MP_TAC;
4753   (ASM_REWRITE_TAC[]);
4754   FIRST_X_ASSUM MATCH_MP_TAC;
4755   ASM_REWRITE_TAC[];
4756   CONJ_TAC;
4757     FIRST_X_ASSUM_ST `hminus` MP_TAC;
4758     MP_TAC Nonlinear_lemma.hminus_gt;
4759     BY(REAL_ARITH_TAC);
4760   BY(ASM_MESON_TAC[y_bounds])
4761   ]);;
4762   (* }}} *)
4763
4764
4765
4766 let gamma23_keep135_x_gamma = prove_by_refinement(
4767  (add_hyp  ["GRKIBMP A V2"] `!y1 y2 y3 y4 y5 y6 .
4768     eta_y y1 y2 y6 pow 2 < &2 /\
4769     eta_y y1 y3 y5 pow 2 < &2 /\
4770     &2 <= rad2_y y1 y2 y3 y4 y5 y6 /\
4771     dih_y y1 y2 sqrt2 sqrt2 sqrt2 y6  * #0.008 <= gamma3f y1 y2 y6 sqrt2 lmfun / &(wtcount3_y y1 y2 y6) /\
4772     dih_y y1 y2 sqrt2 sqrt2 sqrt2 y6 + dih_y y1 sqrt2 y3 sqrt2 y5 sqrt2 <= dih_y y1 y2 y3 y4 y5 y6
4773    ==>
4774     ineq [
4775       (&2 * hminus, y1, &2 * hplus);
4776       (&2 ,y2,sqrt8);
4777       (&2,y3,&2 * hminus);
4778       (&2,y4,sqrt8);
4779       (&2,y5,&2 * hminus);
4780       (&2,y6,sqrt8)
4781     ]
4782     (
4783     y_of_x (gamma23_keep135_x (h0cut y1)) y1 y2 y3 y4 y5 y6 <=
4784     gamma3f y1 y2 y6 sqrt2 lmfun / &(wtcount3_y y1 y2 y6) + gamma3f y1 y3 y5 sqrt2 lmfun +
4785     (dih_y y1 y2 y3 y4 y5 y6 - dih_y y1 y2 sqrt2 sqrt2 sqrt2 y6 - dih_y y1 sqrt2 y3 sqrt2 y5 sqrt2) *  gamma2_x_div_azim_v2 (h0cut y1) (y1* y1))`),
4786   (* {{{ proof *)
4787   [
4788   REWRITE_TAC[Sphere.ineq];
4789   REPEAT WEAK_STRIP_TAC;
4790   REWRITE_TAC[Functional_equation.nonf_gamma23_keep135_x;Sphere.y_of_x];
4791   REPEAT (GMATCH_SIMP_TAC (GSYM gamma3_x_gamma3f));
4792   ASM_SIMP_TAC[y_bounds];
4793   MATCH_MP_TAC (arith `u <= w + v ==> (x + u <=  w + x + v)`);
4794   MATCH_MP_TAC (arith `(?f1 f2. f1 + f2 = f /\ f1 <= x /\ f2 <= y) ==> f <= x + y`);
4795   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `dih_y y1 y2 sqrt2 sqrt2 sqrt2 y6  * #0.008`)));
4796   GOAL_TERM (fun w -> (EXISTS_TAC ( env w `(dih_y y1 y2 y3 y4 y5 y6 -       dih_y y1 y2 sqrt2 sqrt2 sqrt2 y6 -       dih_y y1 sqrt2 y3 sqrt2 y5 sqrt2) * #0.008 `)));
4797   REPEAT (FIRST_X_ASSUM_ST `dih_y` MP_TAC);
4798   REWRITE_TAC[Sphere.dih_y;LET_DEF;LET_END_DEF;Nonlinear_lemma.sqrt2_sqrt2];
4799   REPEAT WEAK_STRIP_TAC;
4800   ASM_REWRITE_TAC[];
4801   CONJ_TAC;
4802     BY(REAL_ARITH_TAC);
4803   GMATCH_SIMP_TAC Real_ext.REAL_LE_LMUL_IMP;
4804   CONJ_TAC;
4805     FIRST_X_ASSUM MP_TAC;
4806     BY(REAL_ARITH_TAC);
4807   FIRST_X_ASSUM_ST `gamma2_x1_div_a_v2` (C INTRO_TAC [`y1`;`&1`;`&1`;`&1`;`&1`;`&1`]);
4808   ASM_SIMP_TAC[y_bounds;arith `&1 <= &1`];
4809   REWRITE_TAC[Sphere.y_of_x;Functional_equation.nonf_gamma2_x1_div_a_v2];
4810   BY(REAL_ARITH_TAC)
4811   ]);;
4812   (* }}} *)
4813
4814
4815
4816 (* ========================================================================== *)
4817 (* MATERIAL ADDED FEB 2013 *)
4818 (* ========================================================================== *)
4819
4820 let ineq_critical_edge2 = prove_by_refinement(
4821   `!u v y f.
4822     ( y < &2 * hminus ==>
4823     ineq (APPEND u (CONS (&2,y,&2 * hminus) v)) f) /\
4824     ineq (APPEND u (CONS (&2 * hminus,y,sqrt8) v)) f ==>
4825     ineq (APPEND u (CONS (&2,y,sqrt8) v)) f`,
4826   (* {{{ proof *)
4827   [
4828   REWRITE_TAC[ineq_APPEND;Sphere.critical_edge_y];
4829   REWRITE_TAC[Sphere.ineq];
4830   REPEAT WEAK_STRIP_TAC;
4831   SUBGOAL_THEN `(y <= &2 * hminus ==> y <= sqrt8) /\ (&2 * hminus <= y ==> &2 <= y)` ASSUME_TAC;
4832     BY(ASM_SIMP_TAC[y_bounds]);
4833   DISJ_CASES_TAC (arith `y < &2 * hminus \/ &2 * hminus <= y`);
4834     FIRST_X_ASSUM_ST `ineq` kill;
4835     FIRST_X_ASSUM_ST `ineq` MP_TAC;
4836     ASM_REWRITE_TAC[];
4837     MATCH_MP_TAC ineq_monotone;
4838     BY(ASM_MESON_TAC[arith `y < x ==> y <= x`]);
4839   FIRST_X_ASSUM_ST `ineq` MP_TAC;
4840   MATCH_MP_TAC ineq_monotone;
4841   BY(ASM_MESON_TAC[])
4842   ]);;
4843   (* }}} *)
4844
4845 let CRIT2_TAC n  =
4846   CHOP_LIST_TAC n THEN
4847     MATCH_MP_TAC ( ineq_critical_edge2)
4848     THEN ASM_REWRITE_TAC[APPEND];;
4849
4850
4851 let ineq_critical_edge3 = prove_by_refinement(
4852   `!u v y f.
4853     ( y < &2 * hminus ==>
4854     ineq (APPEND u (CONS (&2,y,&2 * hminus) v)) f) /\
4855     (  &2 * hplus < y ==>
4856     ineq (APPEND u (CONS (&2 * hplus,y,sqrt8) v)) f) /\
4857     ineq (APPEND u (CONS (&2 * hminus,y,&2 * hplus) v)) f ==>
4858     ineq (APPEND u (CONS (&2,y,sqrt8) v)) f`,
4859   (* {{{ proof *)
4860   [
4861   REWRITE_TAC[ineq_APPEND;Sphere.critical_edge_y];
4862   REWRITE_TAC[Sphere.ineq];
4863   REPEAT WEAK_STRIP_TAC;
4864   SUBGOAL_THEN `(y <= &2 * hminus ==> y <= sqrt8) /\ (&2 * hminus <= y ==> &2 <= y)` ASSUME_TAC;
4865     BY(ASM_SIMP_TAC[y_bounds]);
4866   SUBGOAL_THEN `(y <= &2 * hplus ==> y <= sqrt8) /\ (&2 * hplus < y ==> &2 <= y)` ASSUME_TAC;
4867     MP_TAC hminus_lt_hplus;
4868     (MP_TAC y_bounds);
4869     REWRITE_TAC[Sphere.sqrt2;Nonlinear_lemma.sqrt8_sqrt2];
4870     DISCH_THEN (C INTRO_TAC [`y`]);
4871     REPEAT WEAK_STRIP_TAC;
4872     CONJ_TAC;
4873       BY(ASM_REWRITE_TAC[]);
4874     DISCH_TAC;
4875     FIRST_X_ASSUM MATCH_MP_TAC;
4876     REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC);
4877     BY(REAL_ARITH_TAC);
4878   DISJ_CASES_TAC (arith `y < &2 * hminus \/ (&2 * hminus <= y /\ y <= &2 * hplus) \/ (&2 * hplus < y)`);
4879     FIRST_X_ASSUM (fun t -> (FIRST_X_ASSUM (fun s -> MP_TAC (MATCH_MP t s) THEN ASSUME_TAC s)));
4880     MATCH_MP_TAC ineq_monotone;
4881     BY(ASM_MESON_TAC[arith `y < x ==> y <= x`]);
4882   FIRST_X_ASSUM DISJ_CASES_TAC;
4883     FIRST_X_ASSUM_ST `ineq` MP_TAC;
4884     MATCH_MP_TAC ineq_monotone;
4885     BY(ASM_MESON_TAC[]);
4886   FIRST_X_ASSUM (fun t -> (FIRST_X_ASSUM (fun s -> MP_TAC (MATCH_MP t s) THEN ASSUME_TAC s)));
4887   MATCH_MP_TAC ineq_monotone;
4888   REPEAT WEAK_STRIP_TAC;
4889   FIRST_X_ASSUM MATCH_MP_TAC;
4890   BY(ASM_MESON_TAC[arith `y < x ==> y <= x`])
4891   ]);;
4892   (* }}} *)
4893
4894 let CRIT3_TAC n  =
4895   CHOP_LIST_TAC n THEN
4896     MATCH_MP_TAC ( ineq_critical_edge3)
4897     THEN ASM_REWRITE_TAC[APPEND];;
4898
4899 let ineq_critical_edge4 = prove_by_refinement(
4900   `!u v y f.
4901     (  &2 * hplus < y ==>
4902     ineq (APPEND u (CONS (&2 * hplus,y,sqrt8) v)) f) /\
4903     ineq (APPEND u (CONS (&2 * hminus,y,&2 * hplus) v)) f ==>
4904     ineq (APPEND u (CONS (&2 * hminus,y,sqrt8) v)) f`,
4905   (* {{{ proof *)
4906   [
4907   REWRITE_TAC[ineq_APPEND;Sphere.critical_edge_y];
4908   REWRITE_TAC[Sphere.ineq];
4909   REPEAT WEAK_STRIP_TAC;
4910   SUBGOAL_THEN `(y <= &2 * hminus ==> y <= sqrt8) /\ (&2 * hminus <= y ==> &2 <= y)` ASSUME_TAC;
4911     BY(ASM_SIMP_TAC[y_bounds]);
4912   SUBGOAL_THEN `(y <= &2 * hplus ==> y <= sqrt8) /\ (&2 * hplus < y ==> &2 *hminus <= y)` ASSUME_TAC;
4913     MP_TAC hminus_lt_hplus;
4914     (MP_TAC y_bounds);
4915     REWRITE_TAC[Sphere.sqrt2;Nonlinear_lemma.sqrt8_sqrt2];
4916     DISCH_THEN (C INTRO_TAC [`y`]);
4917     REPEAT WEAK_STRIP_TAC;
4918     CONJ_TAC;
4919       BY(ASM_REWRITE_TAC[]);
4920     FIRST_X_ASSUM MP_TAC;
4921     BY(REAL_ARITH_TAC);
4922   DISJ_CASES_TAC (arith `(&2 * hplus < y) \/ (y <= &2 * hplus)`);
4923     FIRST_X_ASSUM (fun t -> (FIRST_X_ASSUM (fun s -> MP_TAC (MATCH_MP t s) THEN ASSUME_TAC s)));
4924     MATCH_MP_TAC ineq_monotone;
4925     BY(ASM_MESON_TAC[arith `y < x ==> y <= x`]);
4926   FIRST_X_ASSUM_ST `ineq` MP_TAC;
4927   MATCH_MP_TAC ineq_monotone;
4928   BY(ASM_MESON_TAC[])
4929   ]);;
4930   (* }}} *)
4931
4932 let CRIT4_TAC n  =
4933   CHOP_LIST_TAC n THEN
4934     MATCH_MP_TAC ( ineq_critical_edge4)
4935     THEN ASM_REWRITE_TAC[APPEND];;
4936
4937 (* XX tchales 2013/2/16.  I don't believe that 3803737830 is ever
4938    used.  I think it may be possible to delete! *)
4939
4940 (* QITNPEA4 series 3803737830.
4941     We assume type QX, so exclude QU (quarters).
4942     We use TSKAJXY to assume &0 <= gamma4fgcy.  *)
4943
4944 (* Feb 2013. I don't think this gets used ...
4945 let QITNPEA4_3803737830_concl = `!y1 y2 y3 y4 y5 y6.
4946   ineq [(&2 * hminus, y1, &2 * hplus);
4947         (&2 ,y2, sqrt8);
4948         (&2,y3,sqrt8);
4949         (&2,y4,sqrt8);
4950         (&2,y5,sqrt8);
4951         (&2,y6,sqrt8)]
4952   (rad2_y y1 y2 y3 y4 y5 y6 < &2 /\
4953    (~(y2 < &2 * hminus /\ y3 < &2 * hminus /\
4954         y4 < &2 * hminus /\ y5 < &2 * hminus /\ y6 < &2 * hminus)) /\
4955    (&0 <= gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun )
4956    ==>
4957      (gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun / &(wtcount6_y y1 y2 y3 y4 y5 y6) +
4958         beta_bumpA_y y1 y2 y3 y4 y5 y6
4959       - #0.0105256 +  #0.00522841*dih_y y1 y2 y3 y4 y5 y6 > #0.0))`;;
4960
4961 let QITNPEA4_3803737830_full_hypl =   [
4962 "QITNPEA4 0 0 0 1 3803737830";
4963 "QITNPEA4 0 0 1 0 3803737830";
4964 "QITNPEA4 0 1 0 0 3803737830";
4965 "QITNPEA4 1 0 0 0 3803737830";
4966 "QITNPEA4 0 0 1 1 3803737830";
4967 "QITNPEA4 0 1 0 1 3803737830";
4968 "QITNPEA4 1 0 0 1 3803737830";
4969 "QITNPEA4 0 1 1 0 3803737830";
4970 "QITNPEA4 1 0 1 0 3803737830";
4971 "QITNPEA4 1 1 0 0 3803737830";
4972 "QITNPEA4 0 1 1 1 3803737830";
4973 "QITNPEA4 1 0 1 1 3803737830";
4974 "QITNPEA4 1 1 0 1 3803737830";
4975 "QITNPEA4 1 1 1 0 3803737830";
4976 "QITNPEA4 1 1 1 1 3803737830";
4977 "QITNPEA4 3803737830 supercritical";
4978 "CIHTIUM";
4979 "FWGKMBZ";
4980 ];;
4981
4982 let QITNPEA4_3803737830_full = add_hyp
4983    QITNPEA4_3803737830_full_hypl
4984  QITNPEA4_3803737830_concl;;
4985
4986 let QITNPEA4_3803737830 = prove_by_refinement(
4987   QITNPEA4_3803737830_full,
4988   (* {{{ proof *)
4989   [
4990   REPEAT DISCH_TAC;
4991   COMMENT "WLOG. y2 <= y6";
4992   SUBGOAL_THEN `!(p:real->real->real->real->real->real->bool). ((!y1 y2 y3 y4 y5 y6. (p y1 y2 y3 y4 y5 y6 ==> p y1 y6 y5 y4 y3 y2)) /\ (!y1 y2 y3 y4 y5 y6. (y2 <= y6) ==> p y1 y2 y3 y4 y5 y6)) ==> (!y1 y2 y3 y4 y5 y6. p y1 y2 y3 y4 y5 y6)` MATCH_MP_TAC;
4993     BY(MESON_TAC[arith `y <= x \/ x <= y`]);
4994   CONJ_TAC;
4995     REPEAT GEN_TAC;
4996     REWRITE_TAC[Sphere.ineq];
4997     REPEAT WEAK_STRIP_TAC;
4998     REPLICATE_TAC 2 (FIRST_X_ASSUM_ST `gamma4fgcy` MP_TAC);
4999     ASM_REWRITE_TAC[];
5000     SUBGOAL_THEN `gamma4fgcy y1 y6 y5 y4 y3 y2 lmfun = gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun` SUBST1_TAC;
5001       BY(MESON_TAC[gamma4fgcy_sym23;gamma4fgcy_sym12;gamma4fgcy_sym03]);
5002     SUBGOAL_THEN `wtcount6_y y1 y6 y5 y4 y3 y2 = wtcount6_y y1 y2 y3 y4 y5 y6` SUBST1_TAC;
5003       BY(REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y] THEN ARITH_TAC);
5004     SUBGOAL_THEN `beta_bumpA_y y1 y6 y5 y4 y3 y2 = beta_bumpA_y y1 y2 y3 y4 y5 y6` SUBST1_TAC;
5005       REWRITE_TAC[ Sphere.beta_bumpA_y];
5006       BY(REAL_ARITH_TAC);
5007     SUBGOAL_THEN `dih_y y1 y6 y5 y4 y3 y2 = dih_y y1 y2 y3 y4 y5 y6` SUBST1_TAC;
5008       BY(MESON_TAC[Nonlinear_lemma.dih_y_sym;Nonlinear_lemma.dih_y_sym2]);
5009     SUBGOAL_THEN `rad2_y y1 y2 y3 y4 y5 y6 = rad2_y y1 y6 y5 y4 y3 y2` SUBST1_TAC;
5010       BY(MESON_TAC[rad2_y_sym]);
5011     REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC);
5012     BY(MESON_TAC[]);
5013   COMMENT "WLOG y2 < &2 * hminus";
5014   REWRITE_TAC[Sphere.ineq];
5015   REPEAT WEAK_STRIP_TAC;
5016   FIRST_X_ASSUM_ST `delta_x` MP_TAC;
5017   REPEAT WEAK_STRIP_TAC;
5018   FIRST_X_ASSUM_ST `delta_x` (C INTRO_TAC [`y1`;`y2`;`y3`;`y4`;`y5`;`y6`]);
5019   REWRITE_TAC[Sphere.ineq;arith `x > &0 <=> &0 < x`;Sphere.y_of_x];
5020   ASM_SIMP_TAC[y_bounds];
5021   DISCH_TAC;
5022   FIRST_X_ASSUM_ST `eta_y` (C INTRO_TAC [`&1`;`&1`;`&1`;`y1`;`y2`;`y6`]);
5023   REWRITE_TAC[Sphere.ineq;arith `&1 <= &1`];
5024   ASM_SIMP_TAC[y_bounds];
5025   SUBGOAL_THEN `y1 <= sqrt8` ASSUME_TAC;
5026     REWRITE_TAC[Nonlinear_lemma.sqrt8_sqrt2];
5027     BY(ASM_SIMP_TAC[y_bounds;Sphere.sqrt2]);
5028   ASM_REWRITE_TAC[];
5029   DISCH_TAC;
5030   INTRO_TAC rad2_eta2 [`y1`;`y2`;`y3`;`y4`;`y5`;`y6`];
5031   ASM_SIMP_TAC[y_bounds;Sphere.delta_y];
5032   DISCH_TAC;
5033   ASM_CASES_TAC `&2 * hminus <= y2`;
5034     FIRST_X_ASSUM_ST `>` MP_TAC;
5035     ASM_REWRITE_TAC[];
5036     ANTS_TAC;
5037       BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC);
5038     FIRST_X_ASSUM_ST `eta_y` MP_TAC;
5039     BY(REAL_ARITH_TAC);
5040   COMMENT "remove rad2";
5041   FIRST_X_ASSUM_ST `rad2_y` MP_TAC;
5042   REWRITE_TAC[Sphere.rad2_y];
5043   DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP (arith `x < &2 ==> ~(x > &2)`) t));
5044   REPEAT (FIRST_X_ASSUM_ST `ineq` (C INTRO_TAC [`y1`;`y2`;`y3`;`y4`;`y5`;`y6`]));
5045   ASM_REWRITE_TAC[];
5046   (COMMENT "0 < weight");
5047   SUBGOAL_THEN `critical_edge_y y1` ASSUME_TAC;
5048     REWRITE_TAC[Sphere.critical_edge_y];
5049     BY(ASM_REWRITE_TAC[]);
5050   SUBGOAL_THEN `&0 < &(wtcount6_y y1 y2 y3 y4 y5 y6)` ASSUME_TAC;
5051     REWRITE_TAC[ REAL_OF_NUM_LT];
5052     REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
5053     ASM_REWRITE_TAC[];
5054     BY(ARITH_TAC);
5055   REPEAT WEAK_STRIP_TAC;
5056   ASM_CASES_TAC `y2 < &2 * hminus /\ y3 < &2 * hminus /\ y5 < &2 * hminus /\ y6 < &2 * hminus`;
5057     SUBGOAL_THEN `&2 * hminus <=  y4` ASSUME_TAC;
5058       FIRST_X_ASSUM MP_TAC;
5059       REPEAT (FIRST_X_ASSUM_ST `~x` MP_TAC);
5060       REWRITE_TAC[arith `&2 * hminus <= y4 <=> ~(y4 < &2 * hminus)`];
5061       BY(REAL_ARITH_TAC);
5062     SUBGOAL_THEN `~critical_edge_y y2 /\ ~critical_edge_y y3 /\ ~critical_edge_y y5 /\ ~critical_edge_y y6` ASSUME_TAC;
5063       BY(ASM_SIMP_TAC[Sphere.critical_edge_y;arith `!x. x < &2 * hminus ==> ~(&2 * hminus <= x)`]);
5064     SUBGOAL_THEN `wtcount6_y y1 y2 y3 y4 y5 y6 = if critical_edge_y y4 then (2) else (1)` SUBST1_TAC;
5065       ASM_REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
5066       BY(COND_CASES_TAC THEN ARITH_TAC);
5067     SUBGOAL_THEN `beta_bumpA_y y1 y2 y3 y4 y5 y6 = if critical_edge_y y4 then &1 * beta_bump_force_y y1 y2 y3 y4 y5 y6 else (&0)` SUBST1_TAC;
5068       ASM_REWRITE_TAC[ Sphere.beta_bumpA_y;Sphere.beta_bump_force_y];
5069       BY(COND_CASES_TAC THEN REAL_ARITH_TAC);
5070     ASM_CASES_TAC `critical_edge_y y4`;
5071       ASM_REWRITE_TAC[];
5072       FIRST_X_ASSUM_ST `&1 * x` MP_TAC;
5073       REWRITE_TAC[Sphere.ineq];
5074       BY(ASM_SIMP_TAC[y_bounds;arith `!x. x < &2 * hminus ==> x <= &2 * hminus`]);
5075     ASM_REWRITE_TAC[];
5076     FIRST_X_ASSUM_ST `ineq` MP_TAC;
5077     REWRITE_TAC[Sphere.ineq];
5078     ASM_SIMP_TAC[y_bounds;arith `!x. x < &2 * hminus ==> x <= &2 * hminus`];
5079     ANTS_TAC;
5080       FIRST_X_ASSUM MP_TAC;
5081       FIRST_X_ASSUM_ST `hminus` MP_TAC;
5082       BY(MESON_TAC[Sphere.critical_edge_y;arith `~(y <= &2 * hplus) ==> &2 * hplus <= y`]);
5083     BY(REAL_ARITH_TAC);
5084   COMMENT "remove beta_bumpA_y";
5085   SUBGOAL_THEN `beta_bumpA_y y1 y2 y3 y4 y5 y6 = &0` SUBST1_TAC;
5086     ASM_REWRITE_TAC[ Sphere.beta_bumpA_y];
5087     FIRST_X_ASSUM MP_TAC;
5088     REWRITE_TAC[DE_MORGAN_THM];
5089     BY(COND_CASES_TAC THEN (TRY REAL_ARITH_TAC));
5090   FIRST_X_ASSUM_ST `ineq` kill;
5091   REPEAT (FIRST_X_ASSUM_ST `ineq` MP_TAC);
5092   REWRITE_TAC[arith `&0 * x = &0`];
5093   REPEAT DISCH_TAC;
5094   COMMENT "fix weights";
5095   SUBGOAL_THEN `!a w' f g. ineq a (f / &w' + g > #0.0) ==> ineq a (&0 <= f /\ wtcount6_y y1 y2 y3 y4 y5 y6 <= w') ==> ineq a (f / &(wtcount6_y y1 y2 y3 y4 y5 y6) + g > #0.0)` MP_TAC;
5096     REPEAT GEN_TAC;
5097     DISCH_TAC;
5098     MATCH_MP_TAC ineq_MP;
5099     FIRST_X_ASSUM MP_TAC;
5100     MATCH_MP_TAC ineq_monotone;
5101     REPEAT WEAK_STRIP_TAC;
5102     ENOUGH_TO_SHOW_TAC `f/ &w' <= f/ &(wtcount6_y y1 y2 y3 y4 y5 y6)`;
5103       REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC);
5104       BY(REAL_ARITH_TAC);
5105     REWRITE_TAC[real_div];
5106     GMATCH_SIMP_TAC Real_ext.REAL_LE_LMUL_IMP;
5107     ASM_REWRITE_TAC[];
5108     GMATCH_SIMP_TAC REAL_LE_INV2;
5109     ASM_REWRITE_TAC[];
5110     REWRITE_TAC[ REAL_OF_NUM_LE];
5111     BY(ASM_REWRITE_TAC[]);
5112   FIRST_X_ASSUM_ST `&1 * x` kill;
5113   DISCH_THEN (fun t -> REPEAT (FIRST_X_ASSUM_ST `ineq` (fun s -> MP_TAC(MATCH_MP t s))));
5114   ASM_REWRITE_TAC[ineq_T];
5115   REPEAT WEAK_STRIP_TAC;
5116   ABBREV_TAC `ccc = (gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun /            &(wtcount6_y y1 y2 y3 y4 y5 y6) +            &0 -  #0.0105256 +            #0.00522841 * dih_y y1 y2 y3 y4 y5 y6 >             #0.0)`;
5117   FIRST_X_ASSUM kill;
5118   COMMENT "make strict ineqs";
5119   ENOUGH_TO_SHOW_TAC `ineq [(&2 * hminus, y1, &2 * hplus);      (&2 ,y2, &2 * hminus);  (&2,y3,sqrt8);  (&2,y4,sqrt8);  (&2,y5,sqrt8);  (&2,y6,sqrt8)] ccc`;
5120     REWRITE_TAC[Sphere.ineq];
5121     BY(ASM_SIMP_TAC[arith `~(x <= y2) ==> (y2 <= x)`]);
5122   SUBGOAL_THEN `(( y2 < &2 * hminus /\  y3 < &2 * hminus /\  y5 < &2 * hminus /\  y6 < &2 * hminus) ==> ineq   [&2 * hminus,y1,&2 * hplus; &2,y2,&2 * hminus; &2 ,y3,&2 * hminus;&2,y4,&2 * hminus; &2 ,y5,&2 * hminus; &2 ,y6,&2 * hminus] ccc) /\ (( y2  < &2 * hminus /\  y3 < &2 * hminus /\  y5 < &2 * hminus /\  y6 < &2 * hminus) ==> ineq [&2 * hminus,y1,&2 * hplus; &2,y2,&2 * hminus; &2 ,y3,&2 * hminus;&2 * hminus,y4,sqrt8; &2 ,y5,&2 * hminus; &2 ,y6,&2 * hminus]  ccc)` MP_TAC;
5123     REWRITE_TAC[Sphere.ineq;Sphere.critical_edge_y];
5124     FIRST_X_ASSUM_ST `~x` MP_TAC;
5125     MP_TAC hminus_lt_hplus;
5126     BY(REAL_ARITH_TAC);
5127   REPEAT WEAK_STRIP_TAC;
5128   SUBGOAL_THEN `~critical_edge_y y2 /\ y2 < &2 * hminus` MP_TAC;
5129     REWRITE_TAC[Sphere.critical_edge_y];
5130     BY(ASM_SIMP_TAC[ arith `~(x <= y2) ==> (y2 < x)`]);
5131   REPEAT WEAK_STRIP_TAC;
5132   SUBGOAL_THEN `!y. y < &2 * hminus ==> ~critical_edge_y y` ASSUME_TAC;
5133     REWRITE_TAC[Sphere.critical_edge_y];
5134     BY(REAL_ARITH_TAC);
5135   COMMENT "split cases";
5136   CRIT2_TAC 2 THEN CONJ_TAC THEN REPEAT WEAK_STRIP_TAC THEN CRIT2_TAC 3 THEN CONJ_TAC THEN REPEAT WEAK_STRIP_TAC THEN CRIT2_TAC 4 THEN CONJ_TAC THEN REPEAT WEAK_STRIP_TAC THEN CRIT2_TAC 5 THEN CONJ_TAC THEN REPEAT WEAK_STRIP_TAC THEN (TRY (FIRST_X_ASSUM MATCH_MP_TAC)) THEN (REPEAT (FIRST_X_ASSUM_ST `ineq` kill)) THEN ASM_REWRITE_TAC[Sphere.ineq;Sphere.wtcount6_y;Sphere.wtcount3_y] THEN REPEAT WEAK_STRIP_TAC THEN ASM_SIMP_TAC[] THEN TRY(ARITH_TAC);
5137     REPLICATE_TAC 10 (FIRST_X_ASSUM MP_TAC);
5138     BY(MESON_TAC[]);
5139   REPLICATE_TAC 10 (FIRST_X_ASSUM MP_TAC);
5140   BY(MESON_TAC[])
5141   ]);;
5142   (* }}} *)
5143 *)
5144
5145 (* I don't think this gets used. Feb 2013.
5146 let QITNPEA4_3803737830_ALT  = prove_by_refinement(
5147  (mk_imp (`pack_nonlinear_non_ox3q1h`,QITNPEA4_3803737830_concl)),
5148   (* {{{ proof *)
5149   [
5150   REPEAT WEAKER_STRIP_TAC;
5151   MP_TAC QITNPEA4_3803737830;
5152   ASM_REWRITE_TAC (map get_pack_nonlinear_non_ox3q1h QITNPEA4_3803737830_full_hypl);
5153   BY(DISCH_THEN (unlist REWRITE_TAC))
5154   ]);;
5155   (* }}} *)
5156 *)
5157
5158 let QITNPEA1_9063653052_concl = `!y1 y2 y3 y4 y5 y6.
5159   ineq [(&2 * hminus, y1, &2 * hplus);
5160         (&2 ,y2, &2 * hminus);
5161         (&2* hminus,y3,sqrt8);
5162         (&2,y4,sqrt8);
5163         (&2,y5,&2 * hminus);
5164         (&2,y6,&2 * hminus)]
5165   (rad2_y y1 y2 y3 y4 y5 y6 < &2 /\
5166    (&0 <= gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun ) /\
5167   (y2 < &2 * hminus /\ y5 < &2 * hminus /\ y6 < &2 * hminus)
5168    ==>
5169      (gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun / &(wtcount6_y y1 y2 y3 y4 y5 y6)
5170           > #0.0057))`;;
5171
5172 let QITNPEA1_9063653052_hypl =
5173  [
5174 "QITNPEA1 1 0 9063653052 A";
5175 "QITNPEA1 1 1 9063653052 A";
5176 "QITNPEA1 1 2 9063653052 A";
5177 "QITNPEA1 2 0 9063653052 A";
5178 "QITNPEA1 2 1 9063653052 A";
5179 "QITNPEA1 2 2 9063653052 A";
5180 ] ;;
5181
5182 let QITNPEA1_9063653052_full = add_hyp
5183  QITNPEA1_9063653052_hypl
5184   QITNPEA1_9063653052_concl;;
5185
5186 let QITNPEA_9063653052_weak = prove_by_refinement(
5187   QITNPEA1_9063653052_full,
5188   (* {{{ proof *)
5189   [
5190   REPEAT WEAK_STRIP_TAC;
5191   REWRITE_TAC[Sphere.ineq];
5192   REPEAT WEAK_STRIP_TAC;
5193   COMMENT "remove rad2";
5194   FIRST_X_ASSUM_ST `rad2_y` MP_TAC;
5195   REWRITE_TAC[Sphere.rad2_y];
5196   DISCH_THEN (ASSUME_TAC o (MATCH_MP (arith `x < &2 ==> ~(x > &2)`)));
5197   REPEAT (FIRST_X_ASSUM_ST `ineq` (C INTRO_TAC [`y1`;`y2`;`y3`;`y4`;`y5`;`y6`]));
5198   ASM_REWRITE_TAC[];
5199   (COMMENT "0 < weight");
5200   SUBGOAL_THEN `critical_edge_y y1` ASSUME_TAC;
5201     REWRITE_TAC[Sphere.critical_edge_y];
5202     BY(ASM_REWRITE_TAC[]);
5203   SUBGOAL_THEN `&0 < &(wtcount6_y y1 y2 y3 y4 y5 y6)` ASSUME_TAC;
5204     REWRITE_TAC[ REAL_OF_NUM_LT];
5205     REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
5206     ASM_REWRITE_TAC[];
5207     BY(ARITH_TAC);
5208   REPEAT WEAK_STRIP_TAC;
5209   COMMENT "fix weights";
5210   SUBGOAL_THEN `!a w' f . ineq a (f / &w'  > #0.0057) ==> ineq a (&0 <= f /\ wtcount6_y y1 y2 y3 y4 y5 y6 <= w') ==> ineq a (f / &(wtcount6_y y1 y2 y3 y4 y5 y6)  > #0.0057)` MP_TAC;
5211     REPEAT GEN_TAC;
5212     DISCH_TAC;
5213     MATCH_MP_TAC ineq_MP;
5214     FIRST_X_ASSUM MP_TAC;
5215     MATCH_MP_TAC ineq_monotone;
5216     REPEAT WEAK_STRIP_TAC;
5217     ENOUGH_TO_SHOW_TAC `f/ &w' <= f/ &(wtcount6_y y1 y2 y3 y4 y5 y6)`;
5218       REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC);
5219       BY(REAL_ARITH_TAC);
5220     REWRITE_TAC[real_div];
5221     GMATCH_SIMP_TAC Real_ext.REAL_LE_LMUL_IMP;
5222     ASM_REWRITE_TAC[];
5223     GMATCH_SIMP_TAC REAL_LE_INV2;
5224     ASM_REWRITE_TAC[];
5225     REWRITE_TAC[ REAL_OF_NUM_LE];
5226     BY(ASM_REWRITE_TAC[]);
5227   DISCH_THEN (fun t -> REPEAT (FIRST_X_ASSUM_ST `ineq` (fun s -> MP_TAC(MATCH_MP t s))));
5228   ASM_REWRITE_TAC[ineq_T];
5229   REPEAT WEAK_STRIP_TAC;
5230   ABBREV_TAC `ccc = (gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun /   &(wtcount6_y y1 y2 y3 y4 y5 y6) >             #0.0057)`;
5231   FIRST_X_ASSUM kill;
5232   COMMENT "make strict ineqs";
5233   ENOUGH_TO_SHOW_TAC `ineq [(&2 * hminus, y1, &2 * hplus);      (&2 ,y2, &2 * hminus);  (&2* hminus,y3,sqrt8);  (&2,y4,sqrt8);  (&2,y5,&2 * hminus);    (&2,y6,&2 * hminus)]  ccc`;
5234     REWRITE_TAC[Sphere.ineq];
5235     BY(ASM_REWRITE_TAC[]);
5236   SUBGOAL_THEN `!y. y < &2 * hminus ==> ~critical_edge_y y` ASSUME_TAC;
5237     REWRITE_TAC[Sphere.critical_edge_y];
5238     BY(REAL_ARITH_TAC);
5239   SUBGOAL_THEN `!y.  &2 * hplus < y ==> ~critical_edge_y y` ASSUME_TAC;
5240     REWRITE_TAC[Sphere.critical_edge_y];
5241     BY(REAL_ARITH_TAC);
5242   SUBGOAL_THEN `~critical_edge_y y2 /\ ~critical_edge_y y5 /\ ~critical_edge_y y6` MP_TAC;
5243     FIRST_X_ASSUM kill;
5244     BY(ASM_MESON_TAC[]);
5245   REPEAT STRIP_TAC;
5246   BY(CRIT3_TAC 3 THEN REPEAT CONJ_TAC THEN REPEAT WEAK_STRIP_TAC THEN TRY(CRIT4_TAC 2 THEN CONJ_TAC THEN REPEAT WEAK_STRIP_TAC) THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN (REPEAT (FIRST_X_ASSUM_ST `ineq` kill)) THEN ASM_REWRITE_TAC[Sphere.ineq;Sphere.wtcount6_y;Sphere.wtcount3_y] THEN REPEAT WEAK_STRIP_TAC THEN ASM_SIMP_TAC[] THEN TRY(ARITH_TAC))
5247   ]);;
5248   (* }}} *)
5249
5250 let QITNPEA4_9063653052_weak_ALT  = prove_by_refinement(
5251  (mk_imp (`pack_nonlinear_non_ox3q1h`,QITNPEA1_9063653052_concl)),
5252   (* {{{ proof *)
5253   [
5254   REPEAT WEAKER_STRIP_TAC;
5255   MP_TAC QITNPEA_9063653052_weak;
5256   ASM_REWRITE_TAC (map get_pack_nonlinear_non_ox3q1h QITNPEA1_9063653052_hypl);
5257   BY(DISCH_THEN (unlist REWRITE_TAC))
5258   ]);;
5259   (* }}} *)
5260
5261 let g_qxd_concl =
5262   `!y1 y2 y3 y4 y5 y6.
5263     ineq [(&2 * hminus,y1, &2 * hplus);
5264     (&2,y2, sqrt8);
5265     (&2,y3, sqrt8);
5266     (&2,y4, sqrt8);
5267     (&2,y5, sqrt8);
5268     (&2,y6, sqrt8)
5269    ]
5270     (#2.3 < dih_y y1 y2 y3 y4 y5 y6 ==>
5271        #0.0057 < gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun / &(wtcount6_y y1 y2 y3 y4 y5 y6) + beta_bumpA_y y1 y2 y3 y4 y5 y6)`;;
5272
5273 let g_qxd_hypl = [
5274   "BIXPCGW 7080972881 a2";
5275   "BIXPCGW 1738910218 a2";
5276   "BIXPCGW 7274157868 a";
5277 ];;
5278
5279 let g_qxd_full = add_hyp g_qxd_hypl g_qxd_concl;;
5280
5281 let g_qxd = prove_by_refinement(
5282   g_qxd_full,
5283   (* {{{ proof *)
5284   [
5285   REPEAT WEAK_STRIP_TAC;
5286   CRIT2_TAC 1;
5287   CONJ2_TAC;
5288     REPLICATE_TAC 2 (FIRST_X_ASSUM kill);
5289     REWRITE_TAC[Sphere.ineq];
5290     REPEAT WEAK_STRIP_TAC;
5291     FIRST_X_ASSUM (C INTRO_TAC [`y1`;`y2`;`y3`;`y4`;`y5`;`y6`]);
5292     REWRITE_TAC[Sphere.ineq];
5293     ASM_SIMP_TAC[];
5294     BY(FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC);
5295   DISCH_TAC;
5296   CRIT2_TAC 2;
5297   CONJ2_TAC;
5298     REPLICATE_TAC 2 (FIRST_X_ASSUM_ST `ineq` kill);
5299     REWRITE_TAC[Sphere.ineq];
5300     REPEAT WEAK_STRIP_TAC;
5301     FIRST_X_ASSUM (C INTRO_TAC [`y1`;`y3`;`y2`;`y4`;`y6`;`y5`]);
5302     REWRITE_TAC[Sphere.ineq];
5303     ASM_SIMP_TAC[y_bounds];
5304     FIRST_X_ASSUM (MP_TAC o (MATCH_MP (arith `x < y ==> ~(y < x)`)));
5305     BY(MESON_TAC[Nonlinear_lemma.dih_y_sym;Nonlinear_lemma.dih_y_sym2]);
5306   DISCH_TAC;
5307   CRIT2_TAC 4;
5308   CONJ2_TAC;
5309     REPLICATE_TAC 2 (FIRST_X_ASSUM_ST `ineq` kill);
5310     REWRITE_TAC[Sphere.ineq];
5311     REPEAT WEAK_STRIP_TAC;
5312     FIRST_X_ASSUM (C INTRO_TAC [`y1`;`y5`;`y6`;`y4`;`y2`;`y3`]);
5313     REWRITE_TAC[Sphere.ineq];
5314     ASM_SIMP_TAC[y_bounds];
5315     FIRST_X_ASSUM (MP_TAC o (MATCH_MP (arith `x < y ==> ~(y < x)`)));
5316     BY(MESON_TAC[Nonlinear_lemma.dih_y_sym;Nonlinear_lemma.dih_y_sym2]);
5317   DISCH_TAC;
5318   CRIT2_TAC 5;
5319   CONJ2_TAC;
5320     REPLICATE_TAC 2 (FIRST_X_ASSUM_ST `ineq` kill);
5321     REWRITE_TAC[Sphere.ineq];
5322     REPEAT WEAK_STRIP_TAC;
5323     FIRST_X_ASSUM (C INTRO_TAC [`y1`;`y6`;`y5`;`y4`;`y3`;`y2`]);
5324     REWRITE_TAC[Sphere.ineq];
5325     ASM_SIMP_TAC[y_bounds];
5326     FIRST_X_ASSUM (MP_TAC o (MATCH_MP (arith `x < y ==> ~(y < x)`)));
5327     BY(MESON_TAC[Nonlinear_lemma.dih_y_sym;Nonlinear_lemma.dih_y_sym2]);
5328   DISCH_TAC;
5329   ASM_CASES_TAC `y4 <= &2 * hplus`;
5330     FIRST_X_ASSUM_ST `ineq` kill;
5331     REWRITE_TAC[Sphere.ineq];
5332     REPEAT WEAK_STRIP_TAC;
5333     FIRST_X_ASSUM_ST `ineq` (C INTRO_TAC [`y1`;`y2`;`y3`;`y4`;`y5`;`y6`]);
5334     REWRITE_TAC[Sphere.ineq];
5335     ASM_SIMP_TAC[y_bounds];
5336     FIRST_X_ASSUM (MP_TAC o (MATCH_MP (arith `x < y ==> ~(y < x)`)));
5337     BY(MESON_TAC[]);
5338   SUBGOAL_THEN `!y. y < &2 * hminus ==> ~critical_edge_y y` ASSUME_TAC;
5339     BY(REWRITE_TAC[Sphere.critical_edge_y] THEN REAL_ARITH_TAC);
5340   REWRITE_TAC[Sphere.ineq];
5341   REPEAT WEAK_STRIP_TAC;
5342   SUBGOAL_THEN `critical_edge_y y1` ASSUME_TAC;
5343     BY(REWRITE_TAC[Sphere.critical_edge_y] THEN (REPEAT (FIRST_X_ASSUM MP_TAC)) THEN REAL_ARITH_TAC);
5344   SUBGOAL_THEN `~critical_edge_y y4` ASSUME_TAC;
5345     BY(REWRITE_TAC[Sphere.critical_edge_y] THEN (REPEAT (FIRST_X_ASSUM MP_TAC)) THEN REAL_ARITH_TAC);
5346   SUBGOAL_THEN `wtcount6_y y1 y2 y3 y4 y5 y6 = 1` SUBST1_TAC;
5347     ASM_SIMP_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
5348     BY(ARITH_TAC);
5349   SUBGOAL_THEN `beta_bumpA_y y1 y2 y3 y4 y5 y6 = &0` SUBST1_TAC;
5350     ASM_SIMP_TAC[Sphere.beta_bumpA_y];
5351     BY(REAL_ARITH_TAC);
5352   REWRITE_TAC[arith `x / &1 = x /\ x + &0 = x`];
5353   REWRITE_TAC[arith `x < y <=> y > x`];
5354   FIRST_X_ASSUM_ST `ineq` (C INTRO_TAC [`y1`;`y2`;`y3`;`y4`;`y5`;`y6`]);
5355   REWRITE_TAC[Sphere.ineq];
5356   ASM_SIMP_TAC[y_bounds];
5357   BY(REPEAT (FIRST_X_ASSUM MP_TAC) THEN REAL_ARITH_TAC)
5358   ]);;
5359   (* }}} *)
5360
5361 let g_qxd_ALT  = prove_by_refinement(
5362   (mk_imp (`pack_nonlinear_non_ox3q1h`,g_qxd_concl)),
5363   (* {{{ proof *)
5364   [
5365   REPEAT WEAKER_STRIP_TAC;
5366   MP_TAC g_qxd;
5367   ASM_REWRITE_TAC (map get_pack_nonlinear_non_ox3q1h g_qxd_hypl);
5368   BY(DISCH_THEN (unlist REWRITE_TAC))
5369   ]);;
5370   (* }}} *)
5371
5372 let gamma_qx_concl = `!y1 y2 y3 y4 y5 y6. ineq
5373    [(&2 * hminus, y1, &2 * hplus);
5374     (&2,y2,sqrt8);
5375     (&2,y3,sqrt8);
5376     (&2,y4,sqrt8);
5377     (&2,y5,sqrt8);
5378     (&2,y6,sqrt8)
5379    ]
5380    ((rad2_y y1 y2 y3 y4 y5 y6 < &2) /\
5381       ~(y2 < &2 * hminus /\ y3 < &2 * hminus /\ y4 < &2 * hminus /\ y5 < &2 * hminus /\ y6 < &2 * hminus)
5382  ==> (&0 < gamma4fgcy y1 y2 y3 y4 y5 y6 lmfun / &(wtcount6_y y1 y2 y3 y4 y5 y6) + beta_bumpA_y y1 y2 y3 y4 y5 y6))`;;
5383
5384 let gamma_qx_hypl = [
5385 "GLFVCVK4 2477216213";
5386 "GLFVCVK4a 8328676778";
5387 ];;
5388
5389 let gamma_qx_full  = add_hyp gamma_qx_hypl gamma_qx_concl;;
5390
5391 let gamma_qx = prove_by_refinement(
5392   gamma_qx_full,
5393   (* {{{ proof *)
5394   [
5395   REPEAT WEAK_STRIP_TAC;
5396   REWRITE_TAC[Sphere.ineq];
5397   REPEAT WEAK_STRIP_TAC;
5398   REPEAT (FIRST_X_ASSUM (C INTRO_TAC [`y1`;`y2`;`y3`;`y4`;`y5`;`y6`]));
5399   REPEAT WEAK_STRIP_TAC;
5400   SUBGOAL_THEN `critical_edge_y y1` ASSUME_TAC;
5401     REWRITE_TAC[Sphere.critical_edge_y];
5402     BY(ASM_SIMP_TAC[]);
5403   SUBGOAL_THEN `&0 < &(wtcount6_y y1 y2 y3 y4 y5 y6)` ASSUME_TAC;
5404     REWRITE_TAC[ REAL_OF_NUM_LT];
5405     REWRITE_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
5406     ASM_REWRITE_TAC[];
5407     BY(ARITH_TAC);
5408   COMMENT "case wt2-beta";
5409   ASM_CASES_TAC `y2 < &2 * hminus /\ y3 < &2 * hminus /\ critical_edge_y y4 /\ y5 < &2 * hminus /\ y6 < &2 * hminus`;
5410     SUBGOAL_THEN `!y. y < &2 * hminus ==> ~critical_edge_y y` ASSUME_TAC;
5411       BY(REWRITE_TAC[Sphere.critical_edge_y] THEN REAL_ARITH_TAC);
5412     SUBGOAL_THEN `wtcount6_y y1 y2 y3 y4 y5 y6 = 2` SUBST1_TAC;
5413       ASM_SIMP_TAC[Sphere.wtcount6_y;Sphere.wtcount3_y];
5414       BY(ARITH_TAC);
5415     SUBGOAL_THEN `beta_bumpA_y y1 y2 y3 y4 y5 y6 = beta_bump_force_y y1 y2 y3 y4 y5 y6` SUBST1_TAC;
5416       ASM_SIMP_TAC[Sphere.beta_bumpA_y;Sphere.beta_bump_force_y];
5417       BY(REAL_ARITH_TAC);
5418     FIRST_X_ASSUM_ST `ineq` MP_TAC;
5419     ASM_SIMP_TAC[Sphere.ineq;arith `x < y ==> x <= y`];
5420     ASM_SIMP_TAC[GSYM Sphere.rad2_y;arith `x < y ==> ~( x > y)`];
5421     REWRITE_TAC[arith `x > y <=> y < x`];
5422     DISCH_THEN MATCH_MP_TAC;
5423     BY(ASM_MESON_TAC[Sphere.critical_edge_y]);
5424   COMMENT "beta_bumpA_y =0";
5425   SUBGOAL_THEN `beta_bumpA_y y1 y2 y3 y4 y5 y6 = &0` SUBST1_TAC;
5426     REWRITE_TAC[Sphere.beta_bumpA_y];
5427     REPEAT COND_CASES_TAC THEN TRY(REAL_ARITH_TAC);
5428     BY(ASM_MESON_TAC[]);
5429   REWRITE_TAC[arith `x + &0 = x`];
5430   GMATCH_SIMP_TAC REAL_LT_DIV;
5431   ASM_REWRITE_TAC[];
5432   FIRST_X_ASSUM_ST `ineq` kill;
5433   FIRST_X_ASSUM_ST `ineq` MP_TAC;
5434   ASM_SIMP_TAC[Sphere.ineq;y_bounds];
5435   ASM_REWRITE_TAC[GSYM Sphere.rad2_y];
5436   SUBGOAL_THEN `~(norm2hh y1 y2 y3 y4 y5 y6 < (hplus - hminus) pow 2)` (unlist REWRITE_TAC);
5437     DISCH_TAC;
5438     FIRST_X_ASSUM (MP_TAC o (MATCH_MP quarter_norm2hh));
5439     BY(ASM_MESON_TAC[]);
5440   FIRST_X_ASSUM_ST `rad2_y` MP_TAC;
5441   BY(REAL_ARITH_TAC)
5442   ]);;
5443   (* }}} *)
5444
5445 let gamma_qx_ALT  = prove_by_refinement(
5446   (mk_imp (`pack_nonlinear_non_ox3q1h`,gamma_qx_concl)),
5447   (* {{{ proof *)
5448   [
5449   REPEAT WEAKER_STRIP_TAC;
5450   MP_TAC gamma_qx;
5451   ASM_REWRITE_TAC (map get_pack_nonlinear_non_ox3q1h gamma_qx_hypl);
5452   BY(DISCH_THEN (unlist REWRITE_TAC))
5453   ]);;
5454   (* }}} *)
5455
5456  end;;