colo12-c703.uibk.ac.at Git - Multivariate Analysis/.git/blob - Multivariate/flyspeck.ml

   1 (* ========================================================================= *)
   2 (* Results intended for Flyspeck.                                            *)
   3 (* ========================================================================= *)
   4
   5 needs "Multivariate/polytope.ml";;
   6 needs "Multivariate/realanalysis.ml";;
   7 needs "Multivariate/geom.ml";;
   8 needs "Multivariate/cross.ml";;
   9
  10 prioritize_vector();;
  11
  12 (* ------------------------------------------------------------------------- *)
  13 (* Not really Flyspeck-specific but needs both angles and cross products.    *)
  14 (* ------------------------------------------------------------------------- *)
  15
  16 let NORM_CROSS = prove
  17  (`!x y. norm(x cross y) = norm(x) * norm(y) * sin(vector_angle x y)`,
  18   REPEAT GEN_TAC THEN
  19   MATCH_MP_TAC REAL_POW_EQ THEN EXISTS_TAC `2` THEN
  20   SIMP_TAC[NORM_POS_LE; SIN_VECTOR_ANGLE_POS; REAL_LE_MUL; ARITH_EQ] THEN
  21   MP_TAC(SPECL [`x:real^3`; `y:real^3`] NORM_CROSS_DOT) THEN
  22   REWRITE_TAC[VECTOR_ANGLE] THEN
  23   MP_TAC(SPEC `vector_angle (x:real^3) y` SIN_CIRCLE) THEN
  24   CONV_TAC REAL_RING);;
  25
  26 (* ------------------------------------------------------------------------- *)
  27 (* Other miscelleneous lemmas.                                               *)
  28 (* ------------------------------------------------------------------------- *)
  29
  30 let COPLANAR_INSERT_0_NEG = prove
  31  (`coplanar(vec 0 INSERT --x INSERT s) <=> coplanar(vec 0 INSERT x INSERT s)`,
  32   REWRITE_TAC[coplanar; INSERT_SUBSET] THEN
  33   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a ==> ~(b /\ c))`] THEN
  34   SIMP_TAC[AFFINE_HULL_EQ_SPAN; SPAN_NEG_EQ]);;
  35
  36 let COPLANAR_IMP_NEGLIGIBLE = prove
  37  (`!s:real^3->bool. coplanar s ==> negligible s`,
  38   REWRITE_TAC[coplanar] THEN
  39   MESON_TAC[NEGLIGIBLE_AFFINE_HULL_3; NEGLIGIBLE_SUBSET]);;
  40
  41 let NOT_COPLANAR_0_4_IMP_INDEPENDENT = prove
  42  (`!v1 v2 v3:real^N. ~coplanar {vec 0,v1,v2,v3} ==> independent {v1,v2,v3}`,
  43   REPEAT GEN_TAC THEN REWRITE_TAC[independent; CONTRAPOS_THM] THEN
  44   REWRITE_TAC[dependent] THEN
  45   SUBGOAL_THEN
  46    `!v1 v2 v3:real^N. v1 IN span {v2,v3} ==> coplanar{vec 0,v1,v2,v3}`
  47   ASSUME_TAC THENL
  48    [REPEAT STRIP_TAC THEN REWRITE_TAC[coplanar] THEN
  49     MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `v2:real^N`; `v3:real^N`] THEN
  50     SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT] THEN
  51     REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
  52     ASM_SIMP_TAC[SPAN_SUPERSET; IN_INSERT] THEN
  53     POP_ASSUM MP_TAC THEN SPEC_TAC(`v1:real^N`,`v1:real^N`) THEN
  54     REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[];
  55     REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN
  56     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  57     FIRST_X_ASSUM SUBST_ALL_TAC THENL
  58      [FIRST_X_ASSUM(MP_TAC o SPECL [`v1:real^N`; `v2:real^N`; `v3:real^N`]);
  59       FIRST_X_ASSUM(MP_TAC o SPECL [`v2:real^N`; `v3:real^N`; `v1:real^N`]);
  60       FIRST_X_ASSUM(MP_TAC o SPECL [`v3:real^N`; `v1:real^N`; `v2:real^N`])]
  61     THEN REWRITE_TAC[INSERT_AC] THEN DISCH_THEN MATCH_MP_TAC THEN
  62     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
  63      `a IN s ==> s SUBSET t ==> a IN t`)) THEN
  64     MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]]);;
  65
  66 let NOT_COPLANAR_NOT_COLLINEAR = prove
  67  (`!v1 v2 v3 w:real^N. ~coplanar {v1, v2, v3, w} ==> ~collinear {v1, v2, v3}`,
  68   REPEAT GEN_TAC THEN
  69   REWRITE_TAC[COLLINEAR_AFFINE_HULL; coplanar; CONTRAPOS_THM] THEN
  70   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN
  71   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
  72   REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN STRIP_TAC THEN
  73   EXISTS_TAC `w:real^N` THEN ASM_SIMP_TAC[HULL_INC; IN_INSERT] THEN
  74   REPEAT CONJ_TAC THEN
  75   MATCH_MP_TAC(SET_RULE `!t. t SUBSET s /\ x IN t ==> x IN s`) THEN
  76   EXISTS_TAC `affine hull {x:real^N,y}` THEN
  77   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]);;
  78
  79 (* ------------------------------------------------------------------------- *)
  80 (* Some special scaling theorems.                                            *)
  81 (* ------------------------------------------------------------------------- *)
  82
  83 let SUBSET_AFFINE_HULL_SPECIAL_SCALE = prove
  84  (`!a x s t.
  85         ~(a = &0)
  86         ==> (vec 0 INSERT (a % x) INSERT s SUBSET affine hull t <=>
  87              vec 0 INSERT x INSERT s SUBSET affine hull t)`,
  88   REPEAT STRIP_TAC THEN REWRITE_TAC[INSERT_SUBSET] THEN
  89   MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN
  90   ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; SPAN_MUL_EQ]);;
  91
  92 let COLLINEAR_SPECIAL_SCALE = prove
  93  (`!a x y. ~(a = &0) ==> (collinear {vec 0,a % x,y} <=> collinear{vec 0,x,y})`,
  94   REPEAT STRIP_TAC THEN REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN
  95   ASM_SIMP_TAC[SUBSET_AFFINE_HULL_SPECIAL_SCALE]);;
  96
  97 let COLLINEAR_SCALE_ALL = prove
  98  (`!a b v w. ~(a = &0) /\ ~(b = &0)
  99              ==> (collinear {vec 0,a % v,b % w} <=> collinear {vec 0,v,w})`,
 100   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE] THEN
 101   ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN
 102   ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE]);;
 103
 104 let COPLANAR_SPECIAL_SCALE = prove
 105  (`!a x y z.
 106     ~(a = &0) ==> (coplanar {vec 0,a % x,y,z} <=> coplanar {vec 0,x,y,z})`,
 107   REPEAT STRIP_TAC THEN REWRITE_TAC[coplanar] THEN
 108   ASM_SIMP_TAC[SUBSET_AFFINE_HULL_SPECIAL_SCALE]);;
 109
 110 let COPLANAR_SCALE_ALL = prove
 111  (`!a b c x y z.
 112         ~(a = &0) /\ ~(b = &0) /\ ~(c = &0)
 113         ==> (coplanar {vec 0,a % x,b % y,c % z} <=> coplanar {vec 0,x,y,z})`,
 114   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[COPLANAR_SPECIAL_SCALE] THEN
 115   ONCE_REWRITE_TAC[SET_RULE `{a,b,c,d} = {a,c,d,b}`] THEN
 116   ASM_SIMP_TAC[COPLANAR_SPECIAL_SCALE] THEN
 117   ONCE_REWRITE_TAC[SET_RULE `{a,b,c,d} = {a,c,d,b}`] THEN
 118   ASM_SIMP_TAC[COPLANAR_SPECIAL_SCALE]);;
 119
 120 (* ------------------------------------------------------------------------- *)
 121 (* Specialized lemmas about "dropout".                                       *)
 122 (* ------------------------------------------------------------------------- *)
 123
 124 let DROPOUT_BASIS_3 = prove
 125  (`(dropout 3:real^3->real^2) (basis 1) = basis 1 /\
 126    (dropout 3:real^3->real^2) (basis 2) = basis 2 /\
 127    (dropout 3:real^3->real^2) (basis 3) = vec 0`,
 128   SIMP_TAC[LAMBDA_BETA; dropout; basis; CART_EQ; DIMINDEX_2; DIMINDEX_3; ARITH;
 129            VEC_COMPONENT; LT_IMP_LE; ARITH_RULE `i <= 2 ==> i + 1 <= 3`;
 130            ARITH_RULE `1 <= i + 1`] THEN
 131   ARITH_TAC);;
 132
 133 let COLLINEAR_BASIS_3 = prove
 134  (`collinear {vec 0,basis 3,x} <=> (dropout 3:real^3->real^2) x = vec 0`,
 135   SIMP_TAC[CART_EQ; FORALL_2; FORALL_3; DIMINDEX_2; DIMINDEX_3;
 136            dropout; LAMBDA_BETA; BASIS_COMPONENT; ARITH; REAL_MUL_RID;
 137            VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RZERO; UNWIND_THM1;
 138            COLLINEAR_LEMMA] THEN
 139   REWRITE_TAC[RIGHT_EXISTS_AND_THM; GSYM EXISTS_REFL] THEN REAL_ARITH_TAC);;
 140
 141 let OPEN_DROPOUT_3 = prove
 142  (`!P. open {x | P x} ==> open {x | P((dropout 3:real^3->real^2) x)}`,
 143   REPEAT STRIP_TAC THEN MP_TAC(ISPECL
 144    [`dropout 3:real^3->real^2`; `{x:real^2 | P x}`]
 145    CONTINUOUS_OPEN_PREIMAGE_UNIV) THEN
 146   ASM_REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN
 147   GEN_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
 148   SIMP_TAC[LINEAR_DROPOUT; DIMINDEX_2; DIMINDEX_3; ARITH]);;
 149
 150 let SLICE_DROPOUT_3 = prove
 151  (`!P t. slice 3 t {x | P((dropout 3:real^3->real^2) x)} = {x | P x}`,
 152   REPEAT GEN_TAC THEN REWRITE_TAC[slice] THEN
 153   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_INTER] THEN
 154   X_GEN_TAC `y:real^2` THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
 155   DISCH_TAC THEN EXISTS_TAC `(pushin 3 t:real^2->real^3) y` THEN
 156   ASM_SIMP_TAC[DIMINDEX_2; DIMINDEX_3; DROPOUT_PUSHIN; ARITH] THEN
 157   SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL; DIMINDEX_3; ARITH]);;
 158
 159 let NOT_COPLANAR_IMP_NOT_COLLINEAR_DROPOUT_3 = prove
 160  (`!x y:real^3.
 161         ~coplanar {vec 0,basis 3, x, y}
 162         ==> ~collinear {vec 0,dropout 3 x:real^2,dropout 3 y}`,
 163   REPEAT GEN_TAC THEN REWRITE_TAC[COLLINEAR_AFFINE_HULL; coplanar] THEN
 164   REWRITE_TAC[CONTRAPOS_THM; INSERT_SUBSET; LEFT_IMP_EXISTS_THM] THEN
 165   MAP_EVERY X_GEN_TAC [`u:real^2`; `v:real^2`] THEN
 166   REWRITE_TAC[EMPTY_SUBSET] THEN
 167   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
 168   ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN] THEN STRIP_TAC THEN
 169   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [AFFINE_HULL_2]) THEN
 170   REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
 171   MAP_EVERY X_GEN_TAC [`a:real`;`b:real`] THEN STRIP_TAC THEN
 172   SUBGOAL_THEN `?r s. a * r + b * s = -- &1` STRIP_ASSUME_TAC THENL
 173    [ASM_CASES_TAC `a = &0` THENL
 174      [UNDISCH_TAC `a + b = &1` THEN
 175       ASM_SIMP_TAC[REAL_MUL_LZERO; REAL_ADD_LID; REAL_MUL_LID; EXISTS_REFL];
 176       ASM_SIMP_TAC[REAL_FIELD
 177        `~(a = &0) ==> (a * r + x = y <=> r = (y - x) / a)`] THEN
 178       MESON_TAC[]];
 179     ALL_TAC] THEN
 180   EXISTS_TAC `vector[(u:real^2)$1; u$2; r]:real^3` THEN
 181   EXISTS_TAC `vector[(v:real^2)$1; v$2; s]:real^3` THEN
 182   EXISTS_TAC `basis 3:real^3` THEN
 183   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
 184    [REWRITE_TAC[AFFINE_HULL_3; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
 185     MAP_EVERY EXISTS_TAC [`a / &2`;`b / &2`; `&1 / &2`] THEN
 186     ASM_REWRITE_TAC[REAL_ARITH
 187       `a / &2 + b / &2 + &1 / &2 = &1 <=> a + b = &1`] THEN
 188     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN
 189     SIMP_TAC[CART_EQ; DIMINDEX_2; DIMINDEX_3; FORALL_2; FORALL_3;
 190              VEC_COMPONENT; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
 191              VECTOR_3; BASIS_COMPONENT; ARITH] THEN
 192     REPEAT(FIRST_X_ASSUM(MP_TAC o SYM)) THEN CONV_TAC REAL_RING;
 193     ALL_TAC] THEN
 194   SIMP_TAC[AFFINE_HULL_EQ_SPAN] THEN DISCH_TAC THEN
 195   SIMP_TAC[SPAN_SUPERSET; IN_INSERT] THEN
 196   SUBGOAL_THEN
 197     `!x. (dropout 3:real^3->real^2) x IN span {u,v}
 198          ==> x IN span {vector [u$1; u$2; r], vector [v$1; v$2; s], basis 3}`
 199     (fun th -> ASM_MESON_TAC[th]) THEN
 200   GEN_TAC THEN REWRITE_TAC[SPAN_2; SPAN_3] THEN
 201   SIMP_TAC[IN_ELIM_THM; IN_UNIV; CART_EQ; DIMINDEX_2; DIMINDEX_3;
 202            FORALL_2; FORALL_3; dropout; VECTOR_ADD_COMPONENT; LAMBDA_BETA;
 203            VECTOR_MUL_COMPONENT; VECTOR_3; BASIS_COMPONENT; ARITH] THEN
 204   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN
 205   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN
 206   STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID] THEN
 207   REWRITE_TAC[REAL_ARITH `x = a + b + c * &1 <=> c = x - a - b`] THEN
 208   REWRITE_TAC[EXISTS_REFL]);;
 209
 210 let SLICE_312 = prove
 211  (`!s:real^3->bool. slice 1 t s = {y:real^2 | vector[t;y$1;y$2] IN s}`,
 212   SIMP_TAC[EXTENSION; IN_SLICE; DIMINDEX_2; DIMINDEX_3; ARITH] THEN
 213   REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN
 214   AP_THM_TAC THEN AP_TERM_TAC THEN
 215   SIMP_TAC[CART_EQ; pushin; LAMBDA_BETA; FORALL_3; DIMINDEX_3; ARITH;
 216            VECTOR_3]);;
 217
 218 let SLICE_123 = prove
 219  (`!s:real^3->bool. slice 3 t s = {y:real^2 | vector[y$1;y$2;t] IN s}`,
 220   SIMP_TAC[EXTENSION; IN_SLICE; DIMINDEX_2; DIMINDEX_3; ARITH] THEN
 221   REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN
 222   AP_THM_TAC THEN AP_TERM_TAC THEN
 223   SIMP_TAC[CART_EQ; pushin; LAMBDA_BETA; FORALL_3; DIMINDEX_3; ARITH;
 224            VECTOR_3]);;
 225
 226 (* ------------------------------------------------------------------------- *)
 227 (* "Padding" injection from real^2 -> real^3 with zero last coordinate.      *)
 228 (* ------------------------------------------------------------------------- *)
 229
 230 let pad2d3d = new_definition
 231  `(pad2d3d:real^2->real^3) x = lambda i. if i < 3 then x$i else &0`;;
 232
 233 let FORALL_PAD2D3D_THM = prove
 234  (`!P. (!y:real^3. y$3 = &0 ==> P y) <=> (!x. P(pad2d3d x))`,
 235   GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
 236    [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[pad2d3d] THEN
 237     SIMP_TAC[LAMBDA_BETA; DIMINDEX_3; ARITH; LT_REFL];
 238     FIRST_X_ASSUM(MP_TAC o SPEC `(lambda i. (y:real^3)$i):real^2`) THEN
 239     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
 240     SIMP_TAC[CART_EQ; pad2d3d; DIMINDEX_3; ARITH; LAMBDA_BETA; DIMINDEX_2;
 241              ARITH_RULE `i < 3 <=> i <= 2`] THEN
 242     REWRITE_TAC[ARITH_RULE `i <= 3 <=> i <= 2 \/ i = 3`] THEN
 243     ASM_MESON_TAC[]]);;
 244
 245 let QUANTIFY_PAD2D3D_THM = prove
 246  (`(!P. (!y:real^3. y$3 = &0 ==> P y) <=> (!x. P(pad2d3d x))) /\
 247    (!P. (?y:real^3. y$3 = &0 /\ P y) <=> (?x. P(pad2d3d x)))`,
 248   REWRITE_TAC[MESON[] `(?y. P y) <=> ~(!x. ~P x)`] THEN
 249   REWRITE_TAC[GSYM FORALL_PAD2D3D_THM] THEN MESON_TAC[]);;
 250
 251 let LINEAR_PAD2D3D = prove
 252  (`linear pad2d3d`,
 253   REWRITE_TAC[linear; pad2d3d] THEN
 254   SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
 255            LAMBDA_BETA; DIMINDEX_2; DIMINDEX_3; ARITH;
 256            ARITH_RULE `i < 3 ==> i <= 2`] THEN
 257   REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
 258   REAL_ARITH_TAC);;
 259
 260 let INJECTIVE_PAD2D3D = prove
 261  (`!x y. pad2d3d x = pad2d3d y ==> x = y`,
 262   SIMP_TAC[CART_EQ; pad2d3d; LAMBDA_BETA; DIMINDEX_3; DIMINDEX_2] THEN
 263   REWRITE_TAC[ARITH_RULE `i < 3 <=> i <= 2`] THEN
 264   MESON_TAC[ARITH_RULE `i <= 2 ==> i <= 3`]);;
 265
 266 let NORM_PAD2D3D = prove
 267  (`!x. norm(pad2d3d x) = norm x`,
 268   SIMP_TAC[NORM_EQ; DOT_2; DOT_3; pad2d3d; LAMBDA_BETA;
 269            DIMINDEX_2; DIMINDEX_3; ARITH] THEN
 270   REAL_ARITH_TAC);;
 271
 272 (* ------------------------------------------------------------------------- *)
 273 (* Apply 3D->2D conversion to a goal. Take care to preserve variable names.  *)
 274 (* ------------------------------------------------------------------------- *)
 275
 276 let PAD2D3D_QUANTIFY_CONV =
 277   let gv = genvar `:real^2` in
 278   let pth = CONV_RULE (BINOP_CONV(BINDER_CONV(RAND_CONV(GEN_ALPHA_CONV gv))))
 279                       QUANTIFY_PAD2D3D_THM in
 280   let conv1 = GEN_REWRITE_CONV I [pth]
 281   and dest_quant tm = try dest_forall tm with Failure _ -> dest_exists tm in
 282   fun tm ->
 283     let th = conv1 tm in
 284     let name = fst(dest_var(fst(dest_quant tm))) in
 285     let ty = snd(dest_var(fst(dest_quant(rand(concl th))))) in
 286     CONV_RULE(RAND_CONV(GEN_ALPHA_CONV(mk_var(name,ty)))) th;;
 287
 288 let PAD2D3D_TAC =
 289   let pad2d3d_tm = `pad2d3d`
 290   and pths = [LINEAR_PAD2D3D; INJECTIVE_PAD2D3D; NORM_PAD2D3D]
 291   and cth = prove
 292    (`{} = IMAGE pad2d3d {} /\
 293      vec 0 = pad2d3d(vec 0)`,
 294     REWRITE_TAC[IMAGE_CLAUSES] THEN MESON_TAC[LINEAR_PAD2D3D; LINEAR_0]) in
 295   let lasttac =
 296     GEN_REWRITE_TAC REDEPTH_CONV [LINEAR_INVARIANTS pad2d3d_tm pths] in
 297   fun gl -> (GEN_REWRITE_TAC ONCE_DEPTH_CONV [cth] THEN
 298              CONV_TAC(DEPTH_CONV PAD2D3D_QUANTIFY_CONV) THEN
 299              lasttac) gl;;
 300
 301 (* ------------------------------------------------------------------------- *)
 302 (* The notion of a plane, and using it to characterize coplanarity.          *)
 303 (* ------------------------------------------------------------------------- *)
 304
 305 let plane = new_definition
 306   `plane x = (?u v w. ~(collinear {u,v,w}) /\ x = affine hull {u,v,w})`;;
 307
 308 let PLANE_TRANSLATION_EQ = prove
 309  (`!a:real^N s. plane(IMAGE (\x. a + x) s) <=> plane s`,
 310   REWRITE_TAC[plane] THEN GEOM_TRANSLATE_TAC[]);;
 311
 312 let PLANE_TRANSLATION = prove
 313  (`!a:real^N s. plane s ==> plane(IMAGE (\x. a + x) s)`,
 314   REWRITE_TAC[PLANE_TRANSLATION_EQ]);;
 315
 316 add_translation_invariants [PLANE_TRANSLATION_EQ];;
 317
 318 let PLANE_LINEAR_IMAGE_EQ = prove
 319  (`!f:real^M->real^N p.
 320         linear f /\ (!x y. f x = f y ==> x = y)
 321         ==> (plane(IMAGE f p) <=> plane p)`,
 322   REPEAT STRIP_TAC THEN REWRITE_TAC[plane] THEN
 323   MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
 324    `?u. u IN IMAGE f (:real^M) /\
 325         ?v. v IN IMAGE f (:real^M) /\
 326             ?w. w IN IMAGE (f:real^M->real^N) (:real^M) /\
 327                 ~collinear {u, v, w} /\ IMAGE f p = affine hull {u, v, w}` THEN
 328   CONJ_TAC THENL
 329    [REWRITE_TAC[RIGHT_AND_EXISTS_THM; IN_IMAGE; IN_UNIV] THEN
 330     REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN
 331     EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
 332     SUBGOAL_THEN `{u,v,w} SUBSET IMAGE (f:real^M->real^N) p` MP_TAC THENL
 333      [ASM_REWRITE_TAC[HULL_SUBSET]; SET_TAC[]];
 334     REWRITE_TAC[EXISTS_IN_IMAGE; IN_UNIV] THEN
 335     REWRITE_TAC[SET_RULE `{f a,f b,f c} = IMAGE f {a,b,c}`] THEN
 336     ASM_SIMP_TAC[AFFINE_HULL_LINEAR_IMAGE] THEN
 337     REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN BINOP_TAC THENL
 338      [ASM_MESON_TAC[COLLINEAR_LINEAR_IMAGE_EQ]; ASM SET_TAC[]]]);;
 339
 340 let PLANE_LINEAR_IMAGE = prove
 341  (`!f:real^M->real^N p.
 342         linear f /\ plane p /\ (!x y. f x = f y ==> x = y)
 343         ==> plane(IMAGE f p)`,
 344   MESON_TAC[PLANE_LINEAR_IMAGE_EQ]);;
 345
 346 add_linear_invariants [PLANE_LINEAR_IMAGE_EQ];;
 347
 348 let AFFINE_PLANE = prove
 349  (`!p. plane p ==> affine p`,
 350   SIMP_TAC[plane; LEFT_IMP_EXISTS_THM; AFFINE_AFFINE_HULL]);;
 351
 352 let ROTATION_PLANE_HORIZONTAL = prove
 353  (`!s. plane s
 354        ==>  ?a f. orthogonal_transformation f /\ det(matrix f) = &1 /\
 355                   IMAGE f (IMAGE (\x. a + x) s) = {z:real^3 | z$3 = &0}`,
 356   let lemma = prove
 357    (`span {z:real^3 | z$3 = &0} = {z:real^3 | z$3 = &0}`,
 358     REWRITE_TAC[SPAN_EQ_SELF; subspace; IN_ELIM_THM] THEN
 359     SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT;
 360              DIMINDEX_3; ARITH] THEN REAL_ARITH_TAC) in
 361   REPEAT STRIP_TAC THEN
 362   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [plane]) THEN
 363   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
 364   MAP_EVERY X_GEN_TAC [`a:real^3`; `b:real^3`; `c:real^3`] THEN
 365   MAP_EVERY (fun t ->
 366     ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC];
 367                            ALL_TAC])
 368    [`a:real^3 = b`; `a:real^3 = c`; `b:real^3 = c`] THEN
 369   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC) THEN
 370   ASM_SIMP_TAC[AFFINE_HULL_INSERT_SPAN; IN_INSERT; NOT_IN_EMPTY] THEN
 371   EXISTS_TAC `--a:real^3` THEN
 372   REWRITE_TAC[SET_RULE `IMAGE (\x:real^3. --a + x) {a + x | x | x IN s} =
 373                         IMAGE (\x. --a + a + x) s`] THEN
 374   REWRITE_TAC[VECTOR_ARITH `--a + a + x:real^3 = x`; IMAGE_ID] THEN
 375   REWRITE_TAC[SET_RULE `{x - a:real^x | x = b \/ x = c} = {b - a,c - a}`] THEN
 376   MP_TAC(ISPEC `span{b - a:real^3,c - a}`
 377     ROTATION_LOWDIM_HORIZONTAL) THEN
 378   REWRITE_TAC[DIMINDEX_3] THEN ANTS_TAC THENL
 379    [MATCH_MP_TAC LET_TRANS THEN
 380     EXISTS_TAC `CARD{b - a:real^3,c - a}` THEN
 381     SIMP_TAC[DIM_SPAN; DIM_LE_CARD; FINITE_RULES] THEN
 382     SIMP_TAC[CARD_CLAUSES; FINITE_RULES] THEN ARITH_TAC;
 383     ALL_TAC] THEN
 384   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^3->real^3` THEN
 385   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
 386   FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN
 387   ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE] THEN
 388   GEN_REWRITE_TAC RAND_CONV [GSYM lemma] THEN
 389   MATCH_MP_TAC DIM_EQ_SPAN THEN CONJ_TAC THENL
 390    [ASM_MESON_TAC[IMAGE_SUBSET; SPAN_INC; SUBSET_TRANS]; ALL_TAC] THEN
 391   MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2` THEN CONJ_TAC THENL
 392    [MP_TAC(ISPECL [`{z:real^3 | z$3 = &0}`; `(:real^3)`] DIM_EQ_SPAN) THEN
 393     REWRITE_TAC[SUBSET_UNIV; DIM_UNIV; DIMINDEX_3; lemma] THEN
 394     MATCH_MP_TAC(TAUT `~r /\ (~p ==> q) ==> (q ==> r) ==> p`) THEN
 395     REWRITE_TAC[ARITH_RULE `~(x <= 2) <=> 3 <= x`] THEN
 396     REWRITE_TAC[EXTENSION; SPAN_UNIV; IN_ELIM_THM] THEN
 397     DISCH_THEN(MP_TAC o SPEC `vector[&0;&0;&1]:real^3`) THEN
 398     REWRITE_TAC[IN_UNIV; VECTOR_3] THEN REAL_ARITH_TAC;
 399     ALL_TAC] THEN
 400   MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `dim {b - a:real^3,c - a}` THEN
 401   CONJ_TAC THENL
 402    [ALL_TAC; ASM_MESON_TAC[LE_REFL; DIM_INJECTIVE_LINEAR_IMAGE;
 403              ORTHOGONAL_TRANSFORMATION_INJECTIVE]] THEN
 404   MP_TAC(ISPEC `{b - a:real^3,c - a}` INDEPENDENT_BOUND_GENERAL) THEN
 405   SIMP_TAC[CARD_CLAUSES; FINITE_RULES; IN_SING; NOT_IN_EMPTY] THEN
 406   ASM_REWRITE_TAC[VECTOR_ARITH `b - a:real^3 = c - a <=> b = c`; ARITH] THEN
 407   DISCH_THEN MATCH_MP_TAC THEN
 408   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (RAND_CONV o RAND_CONV)
 409     [SET_RULE `{a,b,c} = {b,a,c}`]) THEN
 410   REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN
 411   REWRITE_TAC[independent; CONTRAPOS_THM; dependent] THEN
 412   REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; RIGHT_OR_DISTRIB] THEN
 413   REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM2] THEN
 414   ASM_SIMP_TAC[SET_RULE `~(a = b) ==> {a,b} DELETE b = {a}`;
 415                SET_RULE `~(a = b) ==> {a,b} DELETE a = {b}`;
 416                VECTOR_ARITH `b - a:real^3 = c - a <=> b = c`] THEN
 417   REWRITE_TAC[SPAN_BREAKDOWN_EQ; SPAN_EMPTY; IN_SING] THEN
 418   ONCE_REWRITE_TAC[VECTOR_SUB_EQ] THEN MESON_TAC[COLLINEAR_LEMMA; INSERT_AC]);;
 419
 420 let ROTATION_HORIZONTAL_PLANE = prove
 421  (`!p. plane p
 422        ==>  ?a f. orthogonal_transformation f /\ det(matrix f) = &1 /\
 423                   IMAGE (\x. a + x) (IMAGE f {z:real^3 | z$3 = &0}) = p`,
 424   REPEAT STRIP_TAC THEN
 425   FIRST_X_ASSUM(MP_TAC o MATCH_MP ROTATION_PLANE_HORIZONTAL) THEN
 426   DISCH_THEN(X_CHOOSE_THEN `a:real^3`
 427    (X_CHOOSE_THEN `f:real^3->real^3` STRIP_ASSUME_TAC)) THEN
 428   FIRST_ASSUM(X_CHOOSE_THEN `g:real^3->real^3` STRIP_ASSUME_TAC o MATCH_MP
 429     ORTHOGONAL_TRANSFORMATION_INVERSE) THEN
 430   MAP_EVERY EXISTS_TAC [`--a:real^3`; `g:real^3->real^3`] THEN
 431   FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
 432   ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID;
 433                   VECTOR_ARITH `--a + a + x:real^3 = x`] THEN
 434   MATCH_MP_TAC(REAL_RING `!f. f * g = &1 /\ f = &1 ==> g = &1`) THEN
 435   EXISTS_TAC `det(matrix(f:real^3->real^3))` THEN
 436   REWRITE_TAC[GSYM DET_MUL] THEN
 437   ASM_SIMP_TAC[GSYM MATRIX_COMPOSE; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN
 438   ASM_REWRITE_TAC[o_DEF; MATRIX_ID; DET_I]);;
 439
 440 let COPLANAR = prove
 441  (`2 <= dimindex(:N)
 442    ==> !s:real^N->bool. coplanar s <=> ?x. plane x /\ s SUBSET x`,
 443   DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[coplanar; plane] THEN
 444   CONV_TAC SYM_CONV THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
 445   ONCE_REWRITE_TAC[MESON[]
 446    `(?x u v w. p x u v w) <=> (?u v w x. p x u v w)`] THEN
 447   REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN
 448   EQ_TAC THENL [MESON_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
 449   MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`; `w:real^N`] THEN DISCH_TAC THEN
 450   SUBGOAL_THEN
 451    `s SUBSET {u + x:real^N | x | x IN span {y - u | y IN {v,w}}}`
 452   MP_TAC THENL
 453    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
 454      (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN
 455     REWRITE_TAC[AFFINE_HULL_INSERT_SUBSET_SPAN];
 456     ALL_TAC] THEN
 457   ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
 458   DISCH_THEN(MP_TAC o ISPEC `\x:real^N. x - u` o MATCH_MP IMAGE_SUBSET) THEN
 459   REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ADD_SUB; IMAGE_ID; SIMPLE_IMAGE] THEN
 460   REWRITE_TAC[IMAGE_CLAUSES] THEN
 461   MP_TAC(ISPECL [`{v - u:real^N,w - u}`; `2`] LOWDIM_EXPAND_BASIS) THEN
 462   ANTS_TAC THENL
 463    [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LE_TRANS THEN
 464     EXISTS_TAC `CARD{v - u:real^N,w - u}` THEN
 465     SIMP_TAC[DIM_LE_CARD; FINITE_INSERT; FINITE_RULES] THEN
 466     SIMP_TAC[CARD_CLAUSES; FINITE_RULES] THEN ARITH_TAC;
 467     ALL_TAC] THEN
 468   DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool`
 469    (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN
 470   CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN
 471   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
 472   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
 473   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN
 474   UNDISCH_TAC `span {v - u, w - u} SUBSET span {a:real^N, b}` THEN
 475   REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
 476   DISCH_THEN(ASSUME_TAC o MATCH_MP SUBSET_TRANS) THEN
 477   MAP_EVERY EXISTS_TAC [`u:real^N`; `u + a:real^N`; `u + b:real^N`] THEN
 478   CONJ_TAC THENL
 479    [REWRITE_TAC[COLLINEAR_3; COLLINEAR_LEMMA;
 480                 VECTOR_ARITH `--x = vec 0 <=> x = vec 0`;
 481                 VECTOR_ARITH `u - (u + a):real^N = --a`;
 482                 VECTOR_ARITH `(u + b) - (u + a):real^N = b - a`] THEN
 483     REWRITE_TAC[DE_MORGAN_THM; VECTOR_SUB_EQ;
 484       VECTOR_ARITH `b - a = c % -- a <=> (c - &1) % a + &1 % b = vec 0`] THEN
 485     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
 486      [ASM_MESON_TAC[IN_INSERT; INDEPENDENT_NONZERO]; ALL_TAC] THEN
 487     DISCH_THEN(X_CHOOSE_TAC `u:real`) THEN
 488     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN
 489     REWRITE_TAC[DEPENDENT_EXPLICIT] THEN
 490     MAP_EVERY EXISTS_TAC [`{a:real^N,b}`;
 491                           `\x:real^N. if x = a then u - &1 else &1`] THEN
 492     REWRITE_TAC[FINITE_INSERT; FINITE_RULES; SUBSET_REFL] THEN
 493     CONJ_TAC THENL
 494      [EXISTS_TAC `b:real^N` THEN ASM_REWRITE_TAC[IN_INSERT] THEN
 495       REAL_ARITH_TAC;
 496       ALL_TAC] THEN
 497     SIMP_TAC[VSUM_CLAUSES; FINITE_RULES] THEN
 498     ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; VECTOR_ADD_RID];
 499     ALL_TAC] THEN
 500   W(MP_TAC o PART_MATCH (lhs o rand) AFFINE_HULL_INSERT_SPAN o rand o snd) THEN
 501   ANTS_TAC THENL
 502    [REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN
 503     REWRITE_TAC[VECTOR_ARITH `u = u + a <=> a = vec 0`] THEN
 504     ASM_MESON_TAC[INDEPENDENT_NONZERO; IN_INSERT];
 505     ALL_TAC] THEN
 506   DISCH_THEN SUBST1_TAC THEN
 507   FIRST_ASSUM(MP_TAC o ISPEC `\x:real^N. u + x` o MATCH_MP IMAGE_SUBSET) THEN
 508   REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID;
 509               ONCE_REWRITE_RULE[VECTOR_ADD_SYM] VECTOR_SUB_ADD] THEN
 510   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN
 511   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
 512   REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; VECTOR_ADD_SUB] THEN
 513   SET_TAC[]);;
 514
 515 let COPLANAR_DET_EQ_0 = prove
 516  (`!v0 v1 (v2: real^3) v3.
 517         coplanar {v0,v1,v2,v3} <=>
 518         det(vector[v1 - v0; v2 - v0; v3 - v0]) = &0`,
 519   REPEAT GEN_TAC THEN REWRITE_TAC[DET_EQ_0_RANK; RANK_ROW] THEN
 520   REWRITE_TAC[rows; row; LAMBDA_ETA] THEN
 521   ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
 522   REWRITE_TAC[GSYM numseg; DIMINDEX_3] THEN
 523   CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN
 524   SIMP_TAC[IMAGE_CLAUSES; coplanar; VECTOR_3] THEN EQ_TAC THENL
 525    [REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
 526     MAP_EVERY X_GEN_TAC [`a:real^3`; `b:real^3`; `c:real^3`] THEN
 527     W(MP_TAC o PART_MATCH lhand AFFINE_HULL_INSERT_SUBSET_SPAN o
 528         rand o lhand o snd) THEN
 529     REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
 530     DISCH_THEN(MP_TAC o MATCH_MP SUBSET_TRANS) THEN
 531     DISCH_THEN(MP_TAC o ISPEC `\x:real^3. x - a` o MATCH_MP IMAGE_SUBSET) THEN
 532     ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
 533     REWRITE_TAC[IMAGE_CLAUSES; GSYM IMAGE_o; o_DEF; VECTOR_ADD_SUB; IMAGE_ID;
 534                 SIMPLE_IMAGE] THEN
 535     REWRITE_TAC[INSERT_SUBSET] THEN STRIP_TAC THEN
 536     GEN_REWRITE_TAC LAND_CONV [GSYM DIM_SPAN] THEN MATCH_MP_TAC LET_TRANS THEN
 537     EXISTS_TAC `CARD {b - a:real^3,c - a}` THEN
 538     CONJ_TAC THENL
 539      [MATCH_MP_TAC SPAN_CARD_GE_DIM;
 540       SIMP_TAC[CARD_CLAUSES; FINITE_RULES] THEN ARITH_TAC] THEN
 541     REWRITE_TAC[FINITE_INSERT; FINITE_RULES] THEN
 542     GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_SPAN] THEN
 543     MATCH_MP_TAC SPAN_MONO THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
 544     MP_TAC(VECTOR_ARITH `!x y:real^3. x - y = (x - a) - (y - a)`) THEN
 545     DISCH_THEN(fun th -> REPEAT CONJ_TAC THEN
 546       GEN_REWRITE_TAC LAND_CONV [th]) THEN
 547     MATCH_MP_TAC SPAN_SUB THEN ASM_REWRITE_TAC[];
 548     DISCH_TAC THEN
 549     MP_TAC(ISPECL [`{v1 - v0,v2 - v0,v3 - v0}:real^3->bool`; `2`]
 550                   LOWDIM_EXPAND_BASIS) THEN
 551     ASM_REWRITE_TAC[ARITH_RULE `n <= 2 <=> n < 3`; DIMINDEX_3; ARITH] THEN
 552     DISCH_THEN(X_CHOOSE_THEN `t:real^3->bool`
 553      (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN
 554     CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN
 555     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
 556     MAP_EVERY X_GEN_TAC [`a:real^3`; `b:real^3`] THEN
 557     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN
 558     SIMP_TAC[COPLANAR; DIMINDEX_3; ARITH; plane] THEN
 559     MAP_EVERY EXISTS_TAC [`v0:real^3`; `v0 + a:real^3`; `v0 + b:real^3`] THEN
 560     W(MP_TAC o PART_MATCH (lhs o rand) AFFINE_HULL_INSERT_SPAN o
 561       rand o snd) THEN
 562     ANTS_TAC THENL
 563      [REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN
 564       REWRITE_TAC[VECTOR_ARITH `u = u + a <=> a = vec 0`] THEN
 565       ASM_MESON_TAC[INDEPENDENT_NONZERO; IN_INSERT];
 566       ALL_TAC] THEN
 567     DISCH_THEN SUBST1_TAC THEN
 568     ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
 569     REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; IMAGE_ID; VECTOR_ADD_SUB] THEN
 570     MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
 571      `IMAGE (\v:real^3. v0 + v) (span{v1 - v0, v2 - v0, v3 - v0})` THEN
 572     ASM_SIMP_TAC[IMAGE_SUBSET] THEN
 573     REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_IMAGE] THEN CONJ_TAC THENL
 574      [EXISTS_TAC `vec 0:real^3` THEN REWRITE_TAC[SPAN_0] THEN VECTOR_ARITH_TAC;
 575       REWRITE_TAC[VECTOR_ARITH `v1:real^N = v0 + x <=> x = v1 - v0`] THEN
 576       REWRITE_TAC[UNWIND_THM2] THEN REPEAT CONJ_TAC THEN
 577       MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_INSERT]]]);;
 578
 579 let COPLANAR_CROSS_DOT = prove
 580  (`!v w x y. coplanar {v,w,x,y} <=> ((w - v) cross (x - v)) dot (y - v) = &0`,
 581   REWRITE_TAC[COPLANAR_DET_EQ_0; GSYM DOT_CROSS_DET] THEN
 582   MESON_TAC[CROSS_TRIPLE; DOT_SYM]);;
 583
 584 let PLANE_AFFINE_HULL_3 = prove
 585  (`!a b c:real^N. plane(affine hull {a,b,c}) <=> ~collinear{a,b,c}`,
 586   REWRITE_TAC[plane] THEN MESON_TAC[COLLINEAR_AFFINE_HULL_COLLINEAR]);;
 587
 588 let AFFINE_HULL_3_GENERATED = prove
 589  (`!s u v w:real^N.
 590         s SUBSET affine hull {u,v,w} /\ ~collinear s
 591         ==> affine hull {u,v,w} = affine hull s`,
 592   REWRITE_TAC[COLLINEAR_AFF_DIM; INT_NOT_LE] THEN REPEAT STRIP_TAC THEN
 593   CONV_TAC SYM_CONV THEN
 594   GEN_REWRITE_TAC RAND_CONV [GSYM HULL_HULL] THEN
 595   MATCH_MP_TAC AFF_DIM_EQ_AFFINE_HULL THEN ASM_REWRITE_TAC[] THEN
 596   MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `&2:int` THEN
 597   CONJ_TAC THENL [ALL_TAC; ASM_INT_ARITH_TAC] THEN
 598   REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN
 599   W(MP_TAC o PART_MATCH (lhand o rand) AFF_DIM_LE_CARD o lhand o snd) THEN
 600   REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN
 601   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INT_LE_TRANS) THEN
 602   REWRITE_TAC[INT_LE_SUB_RADD; INT_OF_NUM_ADD; INT_OF_NUM_LE] THEN
 603   SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ARITH_TAC);;
 604
 605 (* ------------------------------------------------------------------------- *)
 606 (* Additional WLOG tactic to rotate any plane p to {z | z$3 = &0}.           *)
 607 (* ------------------------------------------------------------------------- *)
 608
 609 let GEOM_HORIZONTAL_PLANE_RULE =
 610   let ifn = MATCH_MP
 611    (TAUT `(p ==> (x <=> x')) /\ (~p ==> (x <=> T)) ==> (x' ==> x)`)
 612   and pth = prove
 613    (`!a f. orthogonal_transformation (f:real^N->real^N)
 614            ==> ((!P. (!x. P x) <=> (!x. P (a + f x))) /\
 615                 (!P. (?x. P x) <=> (?x. P (a + f x))) /\
 616                 (!Q. (!s. Q s) <=> (!s. Q (IMAGE (\x. a + x) (IMAGE f s)))) /\
 617                 (!Q. (?s. Q s) <=> (?s. Q (IMAGE (\x. a + x) (IMAGE f s))))) /\
 618                (!P. {x | P x} =
 619                     IMAGE (\x. a + x) (IMAGE f {x | P(a + f x)}))`,
 620     REPEAT GEN_TAC THEN DISCH_TAC THEN
 621     MP_TAC(ISPEC `(\x. a + x) o (f:real^N->real^N)`
 622       QUANTIFY_SURJECTION_THM) THEN REWRITE_TAC[o_THM; IMAGE_o] THEN
 623     DISCH_THEN MATCH_MP_TAC THEN
 624     ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE;
 625                   VECTOR_ARITH `a + (x - a:real^N) = x`])
 626   and cth = prove
 627    (`!a f. {} = IMAGE (\x:real^3. a + x) (IMAGE f {})`,
 628     REWRITE_TAC[IMAGE_CLAUSES])
 629   and oth = prove
 630    (`!f:real^3->real^3.
 631         orthogonal_transformation f /\ det(matrix f) = &1
 632         ==> linear f /\
 633             (!x y. f x = f y ==> x = y) /\
 634             (!y. ?x. f x = y) /\
 635             (!x. norm(f x) = norm x) /\
 636             (2 <= dimindex(:3) ==> det(matrix f) = &1)`,
 637     GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
 638      [ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR];
 639       ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_INJECTIVE];
 640       ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE];
 641       ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION]])
 642   and fth = MESON[]
 643    `(!a f. q a f ==> (p <=> p' a f))
 644     ==> ((?a f. q a f) ==> (p <=> !a f. q a f ==> p' a f))` in
 645   fun tm ->
 646     let x,bod = dest_forall tm in
 647     let th1 = EXISTS_GENVAR_RULE
 648       (UNDISCH(ISPEC x ROTATION_HORIZONTAL_PLANE)) in
 649     let [a;f],tm1 = strip_exists(concl th1) in
 650     let [th_orth;th_det;th_im] = CONJUNCTS(ASSUME tm1) in
 651     let th2 = PROVE_HYP th_orth (UNDISCH(ISPECL [a;f] pth)) in
 652     let th3 = (EXPAND_QUANTS_CONV(ASSUME(concl th2)) THENC
 653                SUBS_CONV[GSYM th_im; ISPECL [a;f] cth]) bod in
 654     let th4 = PROVE_HYP th2 th3 in
 655     let th5 = TRANSLATION_INVARIANTS a in
 656     let th6 = GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV)
 657                 [ASSUME(concl th5)] th4 in
 658     let th7 = PROVE_HYP th5 th6 in
 659     let th8s = CONJUNCTS(MATCH_MP oth (CONJ th_orth th_det)) in
 660     let th9 = LINEAR_INVARIANTS f th8s in
 661     let th10 = GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) [th9] th7 in
 662     let th11 = if intersect (frees(concl th10)) [a;f] = []
 663                then PROVE_HYP th1 (itlist SIMPLE_CHOOSE [a;f] th10)
 664                else MP (MATCH_MP fth (GENL [a;f] (DISCH_ALL th10))) th1 in
 665     let th12 = REWRITE_CONV[ASSUME(mk_neg(hd(hyp th11)))] bod in
 666     let th13 = ifn(CONJ (DISCH_ALL th11) (DISCH_ALL th12)) in
 667     let th14 = MATCH_MP MONO_FORALL (GEN x th13) in
 668     GEN_REWRITE_RULE (TRY_CONV o LAND_CONV) [FORALL_SIMP] th14;;
 669
 670 let GEOM_HORIZONTAL_PLANE_TAC p =
 671   W(fun (asl,w) ->
 672         let avs,bod = strip_forall w
 673         and avs' = subtract (frees w) (freesl(map (concl o snd) asl)) in
 674         let avs,bod = strip_forall w in
 675         MAP_EVERY X_GEN_TAC avs THEN
 676         MAP_EVERY (fun t -> SPEC_TAC(t,t)) (rev(subtract (avs@avs') [p])) THEN
 677         SPEC_TAC(p,p) THEN
 678         W(MATCH_MP_TAC o GEOM_HORIZONTAL_PLANE_RULE o snd));;
 679
 680 (* ------------------------------------------------------------------------- *)
 681 (* Affsign and its special cases, with invariance theorems.                  *)
 682 (* ------------------------------------------------------------------------- *)
 683
 684 let lin_combo = new_definition
 685   `lin_combo V f = vsum V (\v. f v % (v:real^N))`;;
 686
 687 let affsign = new_definition
 688   `affsign sgn s t (v:real^A) <=>
 689      (?f. (v = lin_combo (s UNION t) f) /\
 690           (!w. t w ==> sgn (f w)) /\
 691           (sum (s UNION t) f = &1))`;;
 692
 693 let sgn_gt = new_definition `sgn_gt = (\t. (&0 < t))`;;
 694 let sgn_ge = new_definition `sgn_ge = (\t. (&0 <= t))`;;
 695 let sgn_lt = new_definition `sgn_lt = (\t. (t < &0))`;;
 696 let sgn_le = new_definition `sgn_le = (\t. (t <= &0))`;;
 697
 698 let aff_gt_def = new_definition `aff_gt = affsign sgn_gt`;;
 699 let aff_ge_def = new_definition `aff_ge = affsign sgn_ge`;;
 700 let aff_lt_def = new_definition `aff_lt = affsign sgn_lt`;;
 701 let aff_le_def = new_definition `aff_le = affsign sgn_le`;;
 702
 703 let AFFSIGN = prove
 704  (`affsign sgn s t =
 705         {y | ?f. y = vsum (s UNION t) (\v. f v % v) /\
 706                 (!w. w IN t ==> sgn(f w)) /\
 707                 sum (s UNION t) f = &1}`,
 708   REWRITE_TAC[FUN_EQ_THM; affsign; lin_combo; IN_ELIM_THM] THEN
 709   REWRITE_TAC[IN]);;
 710
 711 let AFFSIGN_ALT = prove
 712  (`affsign sgn s t =
 713         {y | ?f. (!w. w IN (s UNION t) ==> w IN t ==> sgn(f w)) /\
 714                  sum (s UNION t) f = &1 /\
 715                  vsum (s UNION t) (\v. f v % v) = y}`,
 716   REWRITE_TAC[SET_RULE `(w IN (s UNION t) ==> w IN t ==> P w) <=>
 717                         (w IN t ==> P w)`] THEN
 718   REWRITE_TAC[AFFSIGN; EXTENSION; IN_ELIM_THM] THEN MESON_TAC[]);;
 719
 720 let IN_AFFSIGN = prove
 721  (`y IN affsign sgn s t <=>
 722         ?u. (!x. x IN t ==> sgn(u x)) /\
 723             sum (s UNION t) u = &1 /\
 724             vsum (s UNION t) (\x. u(x) % x) = y`,
 725   REWRITE_TAC[AFFSIGN; IN_ELIM_THM] THEN SET_TAC[]);;
 726
 727 let AFFSIGN_DISJOINT_DIFF = prove
 728  (`!s t. affsign sgn s t = affsign sgn (s DIFF t) t`,
 729   REWRITE_TAC[AFFSIGN; SET_RULE `(s DIFF t) UNION t = s UNION t`]);;
 730
 731 let AFF_GE_DISJOINT_DIFF = prove
 732  (`!s t. aff_ge s t = aff_ge (s DIFF t) t`,
 733   REWRITE_TAC[aff_ge_def] THEN MATCH_ACCEPT_TAC AFFSIGN_DISJOINT_DIFF);;
 734
 735 let AFFSIGN_INJECTIVE_LINEAR_IMAGE = prove
 736  (`!f:real^M->real^N sgn s t v.
 737         linear f /\ (!x y. f x = f y ==> x = y)
 738         ==> (affsign sgn (IMAGE f s) (IMAGE f t) =
 739              IMAGE f (affsign sgn s t))`,
 740   let lemma0 = prove
 741    (`vsum s (\x. u x % x) = vsum {x | x IN s /\ ~(u x = &0)} (\x. u x % x)`,
 742     MATCH_MP_TAC VSUM_SUPERSET THEN SIMP_TAC[SUBSET; IN_ELIM_THM] THEN
 743     REWRITE_TAC[TAUT `p /\ ~(p /\ ~q) <=> p /\ q`] THEN
 744     SIMP_TAC[o_THM; VECTOR_MUL_LZERO]) in
 745   let lemma1 = prove
 746    (`!f:real^M->real^N s.
 747            linear f /\ (!x y. f x = f y ==> x = y)
 748            ==> (sum(IMAGE f s) u = &1 /\ vsum(IMAGE f s) (\x. u x % x) = y <=>
 749                 sum s (u o f) = &1 /\ f(vsum s (\x. (u o f) x % x)) = y)`,
 750     REPEAT STRIP_TAC THEN
 751     W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o funpow 3 lhand o snd) THEN
 752     ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN
 753     MATCH_MP_TAC(MESON[] `(p ==> z = x) ==> (p /\ x = y <=> p /\ z = y)`) THEN
 754     DISCH_TAC THEN ONCE_REWRITE_TAC[lemma0] THEN
 755     SUBGOAL_THEN
 756      `{y | y IN IMAGE (f:real^M->real^N) s /\ ~(u y = &0)} =
 757       IMAGE f {x | x IN s /\ ~(u(f x) = &0)}`
 758     SUBST1_TAC THENL [ASM SET_TAC[]; CONV_TAC SYM_CONV] THEN
 759     SUBGOAL_THEN `FINITE {x | x IN s /\ ~(u((f:real^M->real^N) x) = &0)}`
 760     ASSUME_TAC THENL
 761      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE
 762        (LAND_CONV o RATOR_CONV o RATOR_CONV) [sum]) THEN
 763       ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN
 764       REWRITE_TAC[GSYM sum; support; NEUTRAL_REAL_ADD; o_THM] THEN
 765       COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ];
 766       W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN
 767       ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
 768       DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF] THEN
 769       ASM_SIMP_TAC[LINEAR_VSUM; o_DEF; GSYM LINEAR_CMUL]]) in
 770   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[EXTENSION; IN_AFFSIGN] THEN
 771   REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE; IN_AFFSIGN] THEN
 772   REWRITE_TAC[GSYM IMAGE_UNION] THEN
 773   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP lemma1 th]) THEN
 774   X_GEN_TAC `y:real^N` THEN EQ_TAC THENL
 775    [DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN
 776     EXISTS_TAC `vsum (s UNION t) (\x. (u o (f:real^M->real^N)) x % x)` THEN
 777     ASM_REWRITE_TAC[] THEN
 778     EXISTS_TAC `(u:real^N->real) o (f:real^M->real^N)` THEN
 779     ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[o_THM];
 780     MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
 781     ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
 782     DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN
 783     DISCH_THEN(X_CHOOSE_THEN `x:real^M`
 784      (CONJUNCTS_THEN2 SUBST1_TAC MP_TAC)) THEN
 785     DISCH_THEN(X_CHOOSE_THEN `u:real^M->real` STRIP_ASSUME_TAC) THEN
 786     EXISTS_TAC `(u:real^M->real) o (g:real^N->real^M)` THEN
 787     ASM_REWRITE_TAC[o_DEF; ETA_AX]]);;
 788
 789 let AFF_GE_INJECTIVE_LINEAR_IMAGE = prove
 790  (`!f:real^M->real^N s t.
 791         linear f /\ (!x y. f x = f y ==> x = y)
 792         ==> aff_ge (IMAGE f s) (IMAGE f t) = IMAGE f (aff_ge s t)`,
 793   REWRITE_TAC[aff_ge_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);;
 794
 795 let AFF_GT_INJECTIVE_LINEAR_IMAGE = prove
 796  (`!f:real^M->real^N s t.
 797         linear f /\ (!x y. f x = f y ==> x = y)
 798         ==> aff_gt (IMAGE f s) (IMAGE f t) = IMAGE f (aff_gt s t)`,
 799   REWRITE_TAC[aff_gt_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);;
 800
 801 let AFF_LE_INJECTIVE_LINEAR_IMAGE = prove
 802  (`!f:real^M->real^N s t.
 803         linear f /\ (!x y. f x = f y ==> x = y)
 804         ==> aff_le (IMAGE f s) (IMAGE f t) = IMAGE f (aff_le s t)`,
 805   REWRITE_TAC[aff_le_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);;
 806
 807 let AFF_LT_INJECTIVE_LINEAR_IMAGE = prove
 808  (`!f:real^M->real^N s t.
 809         linear f /\ (!x y. f x = f y ==> x = y)
 810         ==> aff_lt (IMAGE f s) (IMAGE f t) = IMAGE f (aff_lt s t)`,
 811   REWRITE_TAC[aff_lt_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);;
 812
 813 add_linear_invariants
 814   [AFFSIGN_INJECTIVE_LINEAR_IMAGE;
 815    AFF_GE_INJECTIVE_LINEAR_IMAGE;
 816    AFF_GT_INJECTIVE_LINEAR_IMAGE;
 817    AFF_LE_INJECTIVE_LINEAR_IMAGE;
 818    AFF_LT_INJECTIVE_LINEAR_IMAGE];;
 819
 820 let IN_AFFSIGN_TRANSLATION = prove
 821  (`!sgn s t a v:real^N.
 822         affsign sgn s t v
 823         ==> affsign sgn (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) (a + v)`,
 824   REPEAT GEN_TAC THEN REWRITE_TAC[affsign; lin_combo] THEN
 825   ONCE_REWRITE_TAC[SET_RULE `(!x. s x ==> p x) <=> (!x. x IN s ==> p x)`] THEN
 826   DISCH_THEN(X_CHOOSE_THEN `f:real^N->real`
 827    (CONJUNCTS_THEN2 SUBST_ALL_TAC STRIP_ASSUME_TAC)) THEN
 828   EXISTS_TAC `\x. (f:real^N->real)(x - a)` THEN
 829   ASM_REWRITE_TAC[GSYM IMAGE_UNION] THEN REPEAT CONJ_TAC THENL
 830    [ALL_TAC;
 831     ASM_REWRITE_TAC[FORALL_IN_IMAGE; ETA_AX;
 832                     VECTOR_ARITH `(a + x) - a:real^N = x`];
 833     W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o lhs o snd) THEN
 834     SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN
 835     ASM_REWRITE_TAC[o_DEF; VECTOR_ADD_SUB; ETA_AX]] THEN
 836   MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
 837    `a + vsum {x | x IN s UNION t /\ ~(f x = &0)} (\v:real^N. f v % v)` THEN
 838   CONJ_TAC THENL
 839    [AP_TERM_TAC THEN MATCH_MP_TAC VSUM_SUPERSET THEN
 840     REWRITE_TAC[VECTOR_MUL_EQ_0; SUBSET; IN_ELIM_THM] THEN MESON_TAC[];
 841     ALL_TAC] THEN
 842   MATCH_MP_TAC EQ_TRANS THEN
 843   EXISTS_TAC `vsum (IMAGE (\x:real^N. a + x)
 844                           {x | x IN s UNION t /\ ~(f x = &0)})
 845                    (\v. f(v - a) % v)` THEN
 846   CONJ_TAC THENL
 847    [ALL_TAC;
 848     CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN
 849     CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
 850     ASM_REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; VECTOR_MUL_EQ_0] THEN
 851     REWRITE_TAC[VECTOR_ADD_SUB] THEN SET_TAC[]] THEN
 852   SUBGOAL_THEN `FINITE {x:real^N | x IN s UNION t /\ ~(f x = &0)}`
 853   ASSUME_TAC THENL
 854    [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE
 855      (LAND_CONV o RATOR_CONV o RATOR_CONV) [sum]) THEN
 856     ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN
 857     REWRITE_TAC[GSYM sum; support; NEUTRAL_REAL_ADD] THEN
 858     COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ];
 859     ALL_TAC] THEN
 860   W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o rhs o snd) THEN
 861   ASM_SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN
 862   DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[o_DEF; VECTOR_ADD_SUB] THEN
 863   ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VSUM_ADD] THEN
 864   AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[VSUM_RMUL] THEN
 865   GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_MUL_LID] THEN
 866   AP_THM_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
 867   MATCH_MP_TAC SUM_SUPERSET THEN SET_TAC[]);;
 868
 869 let AFFSIGN_TRANSLATION = prove
 870  (`!a:real^N sgn s t.
 871         affsign sgn (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) =
 872         IMAGE (\x. a + x) (affsign sgn s t)`,
 873   REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
 874    [REWRITE_TAC[SUBSET; IN] THEN GEN_TAC THEN
 875     DISCH_THEN(MP_TAC o SPEC `--a:real^N` o
 876       MATCH_MP IN_AFFSIGN_TRANSLATION) THEN
 877     REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `--a + a + x:real^N = x`;
 878                 IMAGE_ID] THEN
 879     DISCH_TAC THEN REWRITE_TAC[IMAGE; IN_ELIM_THM] THEN
 880     EXISTS_TAC `--a + x:real^N` THEN ASM_REWRITE_TAC[IN] THEN VECTOR_ARITH_TAC;
 881     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN GEN_TAC THEN REWRITE_TAC[IN] THEN
 882     DISCH_THEN(MP_TAC o SPEC `a:real^N` o MATCH_MP IN_AFFSIGN_TRANSLATION) THEN
 883     REWRITE_TAC[]]);;
 884
 885 let AFF_GE_TRANSLATION = prove
 886  (`!a:real^N s t.
 887         aff_ge (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) =
 888         IMAGE (\x. a + x) (aff_ge s t)`,
 889   REWRITE_TAC[aff_ge_def; AFFSIGN_TRANSLATION]);;
 890
 891 let AFF_GT_TRANSLATION = prove
 892  (`!a:real^N s t.
 893         aff_gt (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) =
 894         IMAGE (\x. a + x) (aff_gt s t)`,
 895   REWRITE_TAC[aff_gt_def; AFFSIGN_TRANSLATION]);;
 896
 897 let AFF_LE_TRANSLATION = prove
 898  (`!a:real^N s t.
 899         aff_le (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) =
 900         IMAGE (\x. a + x) (aff_le s t)`,
 901   REWRITE_TAC[aff_le_def; AFFSIGN_TRANSLATION]);;
 902
 903 let AFF_LT_TRANSLATION = prove
 904  (`!a:real^N s t.
 905         aff_lt (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) =
 906         IMAGE (\x. a + x) (aff_lt s t)`,
 907   REWRITE_TAC[aff_lt_def; AFFSIGN_TRANSLATION]);;
 908
 909 add_translation_invariants
 910   [AFFSIGN_TRANSLATION;
 911    AFF_GE_TRANSLATION;
 912    AFF_GT_TRANSLATION;
 913    AFF_LE_TRANSLATION;
 914    AFF_LT_TRANSLATION];;
 915
 916 (* ------------------------------------------------------------------------- *)
 917 (* Automate special cases of affsign.                                        *)
 918 (* ------------------------------------------------------------------------- *)
 919
 920 let AFF_TAC =
 921   REWRITE_TAC[DISJOINT_INSERT; DISJOINT_EMPTY] THEN
 922   REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN
 923   REPEAT STRIP_TAC THEN
 924   REWRITE_TAC[aff_ge_def; aff_gt_def; aff_le_def; aff_lt_def;
 925               sgn_ge; sgn_gt; sgn_le; sgn_lt; AFFSIGN_ALT] THEN
 926   REWRITE_TAC[SET_RULE `(x INSERT s) UNION t = x INSERT (s UNION t)`] THEN
 927   REWRITE_TAC[UNION_EMPTY] THEN
 928   SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN;
 929            FINITE_EMPTY; RIGHT_EXISTS_AND_THM; REAL_LT_ADD;
 930            REAL_LE_ADD; REAL_ARITH `&0 <= a / &2 <=> &0 <= a`;
 931            REAL_ARITH `&0 < a / &2 <=> &0 < a`;
 932            REAL_ARITH `a / &2 <= &0 <=> a <= &0`;
 933            REAL_ARITH `a / &2 < &0 <=> a < &0`;
 934            REAL_ARITH `a < &0 /\ b < &0 ==> a + b < &0`;
 935            REAL_ARITH `a < &0 /\ b <= &0 ==> a + b <= &0`] THEN
 936   ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; real_ge] THEN
 937   REWRITE_TAC[REAL_ARITH `x - y:real = z <=> x = y + z`;
 938               VECTOR_ARITH `x - y:real^N = z <=> x = y + z`] THEN
 939   REWRITE_TAC[RIGHT_AND_EXISTS_THM; REAL_ADD_RID; VECTOR_ADD_RID] THEN
 940   ONCE_REWRITE_TAC[REAL_ARITH `&1 = x <=> x = &1`] THEN
 941   REWRITE_TAC[] THEN SET_TAC[];;
 942
 943 let AFF_GE_1_1 = prove
 944  (`!x v w.
 945         DISJOINT {x} {v}
 946         ==> aff_ge {x} {v} =
 947              {y | ?t1 t2.
 948                      &0 <= t2 /\
 949                      t1 + t2 = &1 /\
 950                      y = t1 % x + t2 % v }`,
 951   AFF_TAC);;
 952
 953 let AFF_GE_1_2 = prove
 954  (`!x v w.
 955         DISJOINT {x} {v,w}
 956         ==> aff_ge {x} {v,w} =
 957              {y | ?t1 t2 t3.
 958
 959                      &0 <= t2 /\ &0 <= t3 /\
 960
 961                      t1 + t2 + t3 = &1 /\
 962                      y = t1 % x + t2 % v + t3 % w}`,
 963   AFF_TAC);;
 964
 965 let AFF_GE_2_1 = prove
 966  (`!x v w.
 967         DISJOINT {x,v} {w}
 968         ==> aff_ge {x,v} {w} =
 969              {y | ?t1 t2 t3.
 970                      &0 <= t3 /\
 971                      t1 + t2 + t3 = &1 /\
 972                      y = t1 % x + t2 % v + t3 % w}`,
 973   AFF_TAC);;
 974
 975 let AFF_GT_1_1 = prove
 976  (`!x v w.
 977         DISJOINT {x} {v}
 978         ==> aff_gt {x} {v} =
 979              {y | ?t1 t2.
 980                      &0 < t2 /\
 981                      t1 + t2 = &1 /\
 982                      y = t1 % x + t2 % v}`,
 983   AFF_TAC);;
 984
 985 let AFF_GT_1_2 = prove
 986  (`!x v w.
 987         DISJOINT {x} {v,w}
 988         ==> aff_gt {x} {v,w} =
 989              {y | ?t1 t2 t3.
 990                      &0 < t2 /\ &0 < t3 /\
 991                      t1 + t2 + t3 = &1 /\
 992                      y = t1 % x + t2 % v + t3 % w}`,
 993   AFF_TAC);;
 994
 995 let AFF_GT_2_1 = prove
 996  (`!x v w.
 997         DISJOINT {x,v} {w}
 998         ==> aff_gt {x,v} {w} =
 999              {y | ?t1 t2 t3.
1000                      &0 < t3 /\
1001                      t1 + t2 + t3 = &1 /\
1002                      y = t1 % x + t2 % v + t3 % w}`,
1003   AFF_TAC);;
1004
1005 let AFF_GT_3_1 = prove
1006  (`!v w x y.
1007         DISJOINT {v,w,x} {y}
1008         ==> aff_gt {v,w,x} {y} =
1009              {z | ?t1 t2 t3 t4.
1010                      &0 < t4 /\
1011                      t1 + t2 + t3 + t4 = &1 /\
1012                      z = t1 % v + t2 % w + t3 % x + t4 % y}`,
1013   AFF_TAC);;
1014
1015 let AFF_LT_1_1 = prove
1016  (`!x v.
1017         DISJOINT {x} {v}
1018         ==> aff_lt {x} {v} =
1019              {y | ?t1 t2.
1020                      t2 < &0 /\
1021                      t1 + t2 = &1 /\
1022                      y = t1 % x + t2 % v}`,
1023   AFF_TAC);;
1024
1025 let AFF_LT_2_1 = prove
1026  (`!x v w.
1027         DISJOINT {x,v} {w}
1028         ==> aff_lt {x,v} {w} =
1029              {y | ?t1 t2 t3.
1030                      t3 < &0 /\
1031                      t1 + t2 + t3 = &1 /\
1032                      y = t1 % x + t2 % v + t3 % w}`,
1033   AFF_TAC);;
1034
1035 let AFF_GE_1_2_0 = prove
1036  (`!v w.
1037         ~(v = vec 0) /\ ~(w = vec 0)
1038         ==> aff_ge {vec 0} {v,w} = {a % v + b % w | &0 <= a /\ &0 <= b}`,
1039   SIMP_TAC[AFF_GE_1_2;
1040            SET_RULE `DISJOINT {a} {b,c} <=> ~(b = a) /\ ~(c = a)`] THEN
1041   REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
1042   ONCE_REWRITE_TAC[MESON[]
1043    `(?a b c. P b c /\ Q b c /\ R a b c /\ S b c) <=>
1044     (?b c. P b c /\ Q b c /\ S b c /\ ?a. R a b c)`] THEN
1045   REWRITE_TAC[REAL_ARITH `t + s:real = &1 <=> t = &1 - s`; EXISTS_REFL] THEN
1046   SET_TAC[]);;
1047
1048 let AFF_GE_1_1_0 = prove
1049  (`!v. ~(v = vec 0) ==> aff_ge {vec 0} {v} = {a % v | &0 <= a}`,
1050   REPEAT STRIP_TAC THEN
1051   GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SET_RULE `{a} = {a,a}`] THEN
1052   ASM_SIMP_TAC[AFF_GE_1_2_0; GSYM VECTOR_ADD_RDISTRIB] THEN
1053   REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
1054   MESON_TAC[REAL_LE_ADD; REAL_ARITH
1055    `&0 <= a ==> &0 <= a / &2 /\ a / &2 + a / &2 = a`]);;
1056
1057 let AFF_GE_2_1_0 = prove
1058  (`!v w. DISJOINT {vec 0, v} {w}
1059          ==> aff_ge {vec 0, v} {w} = {s % v + t % w |s,t| &0 <= t}`,
1060   SIMP_TAC[AFF_GE_2_1; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
1061   REPEAT STRIP_TAC THEN
1062   ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
1063   ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?c b a. P a b c)`] THEN
1064   REWRITE_TAC[REAL_ARITH `t + u = &1 <=> t = &1 - u`; UNWIND_THM2] THEN
1065   SET_TAC[]);;
1066
1067 (* ------------------------------------------------------------------------- *)
1068 (* Properties of affsign variants.                                           *)
1069 (* ------------------------------------------------------------------------- *)
1070
1071 let CONVEX_AFFSIGN = prove
1072  (`!sgn. (!x y u. sgn(x) /\ sgn(y) /\ &0 <= u /\ u <= &1
1073                   ==> sgn((&1 - u) * x + u * y))
1074          ==> !s t:real^N->bool. convex(affsign sgn s t)`,
1075   REPEAT STRIP_TAC THEN REWRITE_TAC[AFFSIGN; CONVEX_ALT] THEN
1076   MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`] THEN
1077   REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN
1078   REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
1079   X_GEN_TAC `f:real^N->real` THEN STRIP_TAC THEN
1080   X_GEN_TAC `g:real^N->real` THEN STRIP_TAC THEN
1081   EXISTS_TAC `\x:real^N. (&1 - u) * f x + u * g x` THEN
1082   ASM_REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN REPEAT CONJ_TAC THENL
1083    [CONV_TAC SYM_CONV THEN
1084     W(MP_TAC o PART_MATCH (lhs o rand) VSUM_ADD_GEN o lhand o snd) THEN
1085     REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; VSUM_LMUL] THEN
1086     DISCH_THEN MATCH_MP_TAC;
1087     ASM_MESON_TAC[];
1088     W(MP_TAC o PART_MATCH (lhs o rand) SUM_ADD_GEN o lhand o snd) THEN
1089     ASM_REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; SUM_LMUL] THEN
1090     REWRITE_TAC[REAL_MUL_RID; REAL_SUB_ADD] THEN DISCH_THEN MATCH_MP_TAC] THEN
1091   (CONJ_TAC THENL
1092     [MP_TAC(ASSUME `sum (s UNION t:real^N->bool) f = &1`);
1093      MP_TAC(ASSUME `sum (s UNION t:real^N->bool) g = &1`)]) THEN
1094   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [sum] THEN
1095   ONCE_REWRITE_TAC[iterate] THEN
1096   REWRITE_TAC[support; NEUTRAL_REAL_ADD] THEN
1097   COND_CASES_TAC THEN REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ] THEN
1098   DISCH_THEN(K ALL_TAC) THEN
1099   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
1100    (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN
1101   REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN
1102   MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[CONTRAPOS_THM] THEN
1103   DISCH_THEN SUBST1_TAC THEN
1104   REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_RZERO; REAL_MUL_RZERO]);;
1105
1106 let CONVEX_AFF_GE = prove
1107  (`!s t. convex(aff_ge s t)`,
1108   REWRITE_TAC[aff_ge_def; sgn_ge] THEN MATCH_MP_TAC CONVEX_AFFSIGN THEN
1109   SIMP_TAC[REAL_LE_MUL; REAL_LE_ADD; REAL_SUB_LE]);;
1110
1111 let CONVEX_AFF_LE = prove
1112  (`!s t. convex(aff_le s t)`,
1113   REWRITE_TAC[aff_le_def; sgn_le] THEN MATCH_MP_TAC CONVEX_AFFSIGN THEN
1114   REWRITE_TAC[REAL_ARITH `x <= &0 <=> &0 <= --x`; REAL_NEG_ADD; GSYM
1115     REAL_MUL_RNEG] THEN
1116   SIMP_TAC[REAL_LE_MUL; REAL_LE_ADD; REAL_SUB_LE]);;
1117
1118 let CONVEX_AFF_GT = prove
1119  (`!s t. convex(aff_gt s t)`,
1120   REWRITE_TAC[aff_gt_def; sgn_gt] THEN MATCH_MP_TAC CONVEX_AFFSIGN THEN
1121   REWRITE_TAC[REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`;
1122               REAL_ARITH `x <= &1 <=> x = &1 \/ x < &1`] THEN
1123   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
1124   CONV_TAC REAL_RAT_REDUCE_CONV THEN
1125   REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_LID] THEN
1126   ASM_SIMP_TAC[REAL_LT_ADD; REAL_LT_MUL; REAL_SUB_LT]);;
1127
1128 let CONVEX_AFF_LT = prove
1129  (`!s t. convex(aff_lt s t)`,
1130   REWRITE_TAC[aff_lt_def; sgn_lt] THEN MATCH_MP_TAC CONVEX_AFFSIGN THEN
1131   REWRITE_TAC[REAL_ARITH `x < &0 <=> &0 < --x`; REAL_NEG_ADD; GSYM
1132     REAL_MUL_RNEG] THEN
1133   REWRITE_TAC[REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`;
1134               REAL_ARITH `x <= &1 <=> x = &1 \/ x < &1`] THEN
1135   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
1136   CONV_TAC REAL_RAT_REDUCE_CONV THEN
1137   REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_LID] THEN
1138   ASM_SIMP_TAC[REAL_LT_ADD; REAL_LT_MUL; REAL_SUB_LT]);;
1139
1140 let AFFSIGN_SUBSET_AFFINE_HULL = prove
1141  (`!sgn s t. (affsign sgn s t) SUBSET (affine hull (s UNION t))`,
1142   REWRITE_TAC[AFFINE_HULL_FINITE; AFFSIGN] THEN SET_TAC[]);;
1143
1144 let AFF_GE_SUBSET_AFFINE_HULL = prove
1145  (`!s t. (aff_ge s t) SUBSET (affine hull (s UNION t))`,
1146   REWRITE_TAC[aff_ge_def; AFFSIGN_SUBSET_AFFINE_HULL]);;
1147
1148 let AFF_LE_SUBSET_AFFINE_HULL = prove
1149  (`!s t. (aff_le s t) SUBSET (affine hull (s UNION t))`,
1150   REWRITE_TAC[aff_le_def; AFFSIGN_SUBSET_AFFINE_HULL]);;
1151
1152 let AFF_GT_SUBSET_AFFINE_HULL = prove
1153  (`!s t. (aff_gt s t) SUBSET (affine hull (s UNION t))`,
1154   REWRITE_TAC[aff_gt_def; AFFSIGN_SUBSET_AFFINE_HULL]);;
1155
1156 let AFF_LT_SUBSET_AFFINE_HULL = prove
1157  (`!s t. (aff_lt s t) SUBSET (affine hull (s UNION t))`,
1158   REWRITE_TAC[aff_lt_def; AFFSIGN_SUBSET_AFFINE_HULL]);;
1159
1160 let AFFSIGN_EQ_AFFINE_HULL = prove
1161  (`!sgn s t. affsign sgn s {} = affine hull s`,
1162   REWRITE_TAC[AFFSIGN; AFFINE_HULL_FINITE] THEN
1163   REWRITE_TAC[UNION_EMPTY; NOT_IN_EMPTY] THEN SET_TAC[]);;
1164
1165 let AFF_GE_EQ_AFFINE_HULL = prove
1166  (`!s t. aff_ge s {} = affine hull s`,
1167   REWRITE_TAC[aff_ge_def; AFFSIGN_EQ_AFFINE_HULL]);;
1168
1169 let AFF_LE_EQ_AFFINE_HULL = prove
1170  (`!s t. aff_le s {} = affine hull s`,
1171   REWRITE_TAC[aff_le_def; AFFSIGN_EQ_AFFINE_HULL]);;
1172
1173 let AFF_GT_EQ_AFFINE_HULL = prove
1174  (`!s t. aff_gt s {} = affine hull s`,
1175   REWRITE_TAC[aff_gt_def; AFFSIGN_EQ_AFFINE_HULL]);;
1176
1177 let AFF_LT_EQ_AFFINE_HULL = prove
1178  (`!s t. aff_lt s {} = affine hull s`,
1179   REWRITE_TAC[aff_lt_def; AFFSIGN_EQ_AFFINE_HULL]);;
1180
1181 let AFFSIGN_SUBSET_AFFSIGN = prove
1182  (`!sgn1 sgn2 s t.
1183         (!x. sgn1 x ==> sgn2 x) ==> affsign sgn1 s t SUBSET affsign sgn2 s t`,
1184   REPEAT STRIP_TAC THEN REWRITE_TAC[AFFSIGN; SUBSET; IN_ELIM_THM] THEN
1185   GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[]);;
1186
1187 let AFF_GT_SUBSET_AFF_GE = prove
1188  (`!s t. aff_gt s t SUBSET aff_ge s t`,
1189   REPEAT GEN_TAC THEN REWRITE_TAC[aff_gt_def; aff_ge_def] THEN
1190   MATCH_MP_TAC AFFSIGN_SUBSET_AFFSIGN THEN
1191   SIMP_TAC[sgn_gt; sgn_ge; REAL_LT_IMP_LE]);;
1192
1193 let AFFSIGN_MONO_LEFT = prove
1194  (`!sgn s s' t:real^N->bool.
1195         s SUBSET s' ==> affsign sgn s t SUBSET affsign sgn s' t`,
1196   REPEAT STRIP_TAC THEN
1197   REWRITE_TAC[AFFSIGN; SUBSET; IN_ELIM_THM] THEN
1198   X_GEN_TAC `y:real^N` THEN
1199   DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN
1200   EXISTS_TAC `\x:real^N. if x IN s UNION t then u x else &0` THEN
1201   REWRITE_TAC[COND_RAND; COND_RATOR; VECTOR_MUL_LZERO] THEN
1202   REWRITE_TAC[GSYM SUM_RESTRICT_SET; GSYM VSUM_RESTRICT_SET] THEN
1203   ASM_SIMP_TAC[SET_RULE
1204    `s SUBSET s' ==> {x | x IN s' UNION t /\ x IN s UNION t} = s UNION t`] THEN
1205   ASM SET_TAC[]);;
1206
1207 let AFFSIGN_MONO_SHUFFLE = prove
1208  (`!sgn s t s' t'.
1209         s' UNION t' = s UNION t /\ t' SUBSET t
1210         ==> affsign sgn s t SUBSET affsign sgn s' t'`,
1211   REPEAT STRIP_TAC THEN REWRITE_TAC[AFFSIGN; SUBSET; IN_ELIM_THM] THEN
1212   GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN
1213   ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;
1214
1215 let AFF_GT_MONO_LEFT = prove
1216  (`!s s' t. s SUBSET s' ==> aff_gt s t SUBSET aff_gt s' t`,
1217   REWRITE_TAC[aff_gt_def; AFFSIGN_MONO_LEFT]);;
1218
1219 let AFF_GE_MONO_LEFT = prove
1220  (`!s s' t. s SUBSET s' ==> aff_ge s t SUBSET aff_ge s' t`,
1221   REWRITE_TAC[aff_ge_def; AFFSIGN_MONO_LEFT]);;
1222
1223 let AFF_LT_MONO_LEFT = prove
1224  (`!s s' t. s SUBSET s' ==> aff_lt s t SUBSET aff_lt s' t`,
1225   REWRITE_TAC[aff_lt_def; AFFSIGN_MONO_LEFT]);;
1226
1227 let AFF_LE_MONO_LEFT = prove
1228  (`!s s' t. s SUBSET s' ==> aff_le s t SUBSET aff_le s' t`,
1229   REWRITE_TAC[aff_le_def; AFFSIGN_MONO_LEFT]);;
1230
1231 let AFFSIGN_MONO_RIGHT = prove
1232  (`!sgn s t t':real^N->bool.
1233         sgn(&0) /\ t SUBSET t' /\ DISJOINT s t'
1234         ==> affsign sgn s t SUBSET affsign sgn s t'`,
1235   REPEAT STRIP_TAC THEN
1236   REWRITE_TAC[AFFSIGN; SUBSET; IN_ELIM_THM] THEN
1237   X_GEN_TAC `y:real^N` THEN
1238   DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN
1239   EXISTS_TAC `\x:real^N. if x IN s UNION t then u x else &0` THEN
1240   REWRITE_TAC[COND_RAND; COND_RATOR; VECTOR_MUL_LZERO] THEN
1241   REWRITE_TAC[GSYM SUM_RESTRICT_SET; GSYM VSUM_RESTRICT_SET] THEN
1242   ASM_SIMP_TAC[SET_RULE
1243    `t SUBSET t' ==> {x | x IN s UNION t' /\ x IN s UNION t} = s UNION t`] THEN
1244   ASM SET_TAC[]);;
1245
1246 let AFF_GE_MONO_RIGHT = prove
1247  (`!s t t'. t SUBSET t' /\ DISJOINT s t' ==> aff_ge s t SUBSET aff_ge s t'`,
1248   SIMP_TAC[aff_ge_def; AFFSIGN_MONO_RIGHT; sgn_ge; REAL_POS]);;
1249
1250 let AFF_LE_MONO_RIGHT = prove
1251  (`!s t t'. t SUBSET t' /\ DISJOINT s t' ==> aff_le s t SUBSET aff_le s t'`,
1252   SIMP_TAC[aff_le_def; AFFSIGN_MONO_RIGHT; sgn_le; REAL_LE_REFL]);;
1253
1254 let AFFINE_HULL_SUBSET_AFFSIGN = prove
1255  (`!sgn s t:real^N->bool.
1256         sgn(&0) /\ DISJOINT s t
1257         ==> affine hull s SUBSET affsign sgn s t`,
1258   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN
1259   EXISTS_TAC `affsign sgn (s:real^N->bool) {}` THEN CONJ_TAC THENL
1260    [REWRITE_TAC[AFFSIGN_EQ_AFFINE_HULL; SUBSET_REFL];
1261     MATCH_MP_TAC AFFSIGN_MONO_RIGHT THEN ASM SET_TAC[]]);;
1262
1263 let AFFINE_HULL_SUBSET_AFF_GE = prove
1264  (`!s t. DISJOINT s t ==> affine hull s SUBSET aff_ge s t`,
1265   SIMP_TAC[aff_ge_def; sgn_ge; REAL_LE_REFL; AFFINE_HULL_SUBSET_AFFSIGN]);;
1266
1267 let AFF_GE_AFF_GT_DECOMP = prove
1268  (`!s:real^N->bool.
1269         FINITE s /\ FINITE t /\ DISJOINT s t
1270         ==> aff_ge s t = aff_gt s t UNION
1271                          UNIONS {aff_ge s (t DELETE a) | a | a IN t}`,
1272   REPEAT STRIP_TAC THEN
1273   MATCH_MP_TAC(SET_RULE
1274    `t' SUBSET t /\ (!a. a IN s ==> f(a) SUBSET t) /\
1275     (!y. y IN t ==> y IN t' \/ ?a. a IN s /\ y IN f(a))
1276     ==> t = t' UNION UNIONS {f a | a IN s}`) THEN
1277   REWRITE_TAC[AFF_GT_SUBSET_AFF_GE] THEN
1278   ASM_SIMP_TAC[DELETE_SUBSET; AFF_GE_MONO_RIGHT] THEN
1279   REWRITE_TAC[aff_ge_def; aff_gt_def; AFFSIGN; sgn_ge; sgn_gt] THEN
1280   X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN
1281   DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN
1282   ASM_CASES_TAC `!x:real^N. x IN t ==> &0 < u x` THENL
1283    [DISJ1_TAC THEN EXISTS_TAC `u:real^N->real` THEN ASM_REWRITE_TAC[];
1284     DISJ2_TAC THEN
1285     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN
1286     ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> (&0 < x <=> ~(x = &0))`] THEN
1287     REWRITE_TAC[NOT_IMP] THEN MATCH_MP_TAC MONO_EXISTS THEN
1288     X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
1289     EXISTS_TAC `u:real^N->real` THEN
1290     ASM_SIMP_TAC[SET_RULE
1291      `a IN t /\ DISJOINT s t
1292       ==> s UNION (t DELETE a) = (s UNION t) DELETE a`] THEN
1293     ASM_SIMP_TAC[IN_DELETE; SUM_DELETE; VSUM_DELETE; REAL_SUB_RZERO;
1294                  FINITE_UNION; IN_UNION] THEN
1295     REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_RZERO]]);;
1296
1297 let AFFSIGN_SPECIAL_SCALE = prove
1298  (`!sgn s t a v.
1299         FINITE s /\ FINITE t /\
1300         ~(vec 0 IN t) /\ ~(v IN t) /\ ~((a % v) IN t) /\
1301         (!x. sgn x ==> sgn(x / &2)) /\
1302         (!x y. sgn x /\ sgn y ==> sgn(x + y)) /\
1303         &0 < a
1304         ==> affsign sgn (vec 0 INSERT (a % v) INSERT s) t =
1305             affsign sgn (vec 0 INSERT v INSERT s) t`,
1306   REWRITE_TAC[EXTENSION] THEN REPEAT STRIP_TAC THEN
1307   REWRITE_TAC[AFFSIGN_ALT; IN_ELIM_THM; INSERT_UNION_EQ] THEN
1308   ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN;
1309                RIGHT_EXISTS_AND_THM] THEN
1310   REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN
1311   GEN_REWRITE_TAC BINOP_CONV [SWAP_EXISTS_THM] THEN
1312   GEN_REWRITE_TAC (BINOP_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN
1313   REWRITE_TAC[LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM] THEN
1314   REWRITE_TAC[REAL_ARITH `x = &1 - v - v' <=> v = &1 - (x + v')`] THEN
1315   REWRITE_TAC[EXISTS_REFL] THEN
1316   FIRST_ASSUM(MP_TAC o MATCH_MP(MESON[REAL_LT_IMP_NZ; REAL_DIV_LMUL]
1317    `!a. &0 < a ==> (!y. ?x. a * x = y)`)) THEN
1318   DISCH_THEN(MP_TAC o MATCH_MP QUANTIFY_SURJECTION_THM) THEN
1319   DISCH_THEN(CONV_TAC o RAND_CONV o EXPAND_QUANTS_CONV) THEN
1320   REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_SYM]);;
1321
1322 let AFF_GE_SPECIAL_SCALE = prove
1323  (`!s t a v.
1324         FINITE s /\ FINITE t /\
1325         ~(vec 0 IN t) /\ ~(v IN t) /\ ~((a % v) IN t) /\
1326         &0 < a
1327         ==> aff_ge (vec 0 INSERT (a % v) INSERT s) t =
1328             aff_ge (vec 0 INSERT v INSERT s) t`,
1329   REPEAT STRIP_TAC THEN REWRITE_TAC[aff_ge_def] THEN
1330   MATCH_MP_TAC AFFSIGN_SPECIAL_SCALE THEN
1331   ASM_REWRITE_TAC[sgn_ge] THEN REAL_ARITH_TAC);;
1332
1333 let AFF_LE_SPECIAL_SCALE = prove
1334  (`!s t a v.
1335         FINITE s /\ FINITE t /\
1336         ~(vec 0 IN t) /\ ~(v IN t) /\ ~((a % v) IN t) /\
1337         &0 < a
1338         ==> aff_le (vec 0 INSERT (a % v) INSERT s) t =
1339             aff_le (vec 0 INSERT v INSERT s) t`,
1340   REPEAT STRIP_TAC THEN REWRITE_TAC[aff_le_def] THEN
1341   MATCH_MP_TAC AFFSIGN_SPECIAL_SCALE THEN
1342   ASM_REWRITE_TAC[sgn_le] THEN REAL_ARITH_TAC);;
1343
1344 let AFF_GT_SPECIAL_SCALE = prove
1345  (`!s t a v.
1346         FINITE s /\ FINITE t /\
1347         ~(vec 0 IN t) /\ ~(v IN t) /\ ~((a % v) IN t) /\
1348         &0 < a
1349         ==> aff_gt (vec 0 INSERT (a % v) INSERT s) t =
1350             aff_gt (vec 0 INSERT v INSERT s) t`,
1351   REPEAT STRIP_TAC THEN REWRITE_TAC[aff_gt_def] THEN
1352   MATCH_MP_TAC AFFSIGN_SPECIAL_SCALE THEN
1353   ASM_REWRITE_TAC[sgn_gt] THEN REAL_ARITH_TAC);;
1354
1355 let AFF_LT_SPECIAL_SCALE = prove
1356  (`!s t a v.
1357         FINITE s /\ FINITE t /\
1358         ~(vec 0 IN t) /\ ~(v IN t) /\ ~((a % v) IN t) /\
1359         &0 < a
1360         ==> aff_lt (vec 0 INSERT (a % v) INSERT s) t =
1361             aff_lt (vec 0 INSERT v INSERT s) t`,
1362   REPEAT STRIP_TAC THEN REWRITE_TAC[aff_lt_def] THEN
1363   MATCH_MP_TAC AFFSIGN_SPECIAL_SCALE THEN
1364   ASM_REWRITE_TAC[sgn_lt] THEN REAL_ARITH_TAC);;
1365
1366 let AFF_GE_SCALE_LEMMA = prove
1367  (`!a u v:real^N.
1368         &0 < a /\ ~(v = vec 0)
1369         ==> aff_ge {vec 0} {a % u,v} = aff_ge {vec 0} {u,v}`,
1370   REPEAT STRIP_TAC THEN ASM_CASES_TAC `u:real^N = vec 0` THEN
1371   ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN
1372   ASM_SIMP_TAC[AFF_GE_1_2_0; VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ;
1373    SET_RULE `DISJOINT {a} {b,c} <=> ~(b = a) /\ ~(c = a)`] THEN
1374   REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_GSPEC] THEN
1375   CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`b:real`; `c:real`] THEN
1376   REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THENL
1377    [EXISTS_TAC `a * b:real`; EXISTS_TAC `b / a:real`] THEN
1378   EXISTS_TAC `c:real` THEN
1379   ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_MUL; REAL_LT_IMP_LE] THEN
1380   REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
1381   REPLICATE_TAC 2 (AP_THM_TAC THEN AP_TERM_TAC) THEN
1382   UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD);;
1383
1384 let AFFSIGN_0 = prove
1385  (`!sgn s t.
1386         FINITE s /\ FINITE t /\ (vec 0) IN (s DIFF t)
1387         ==> affsign sgn s t =
1388              { vsum (s UNION t) (\v. f v % v) |f|
1389                !x:real^N. x IN t ==> sgn(f x)}`,
1390   REPEAT STRIP_TAC THEN REWRITE_TAC[AFFSIGN] THEN
1391   FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE
1392    `x IN s DIFF t ==> s UNION t = x INSERT ((s UNION t) DELETE x)`)) THEN
1393   ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; FINITE_UNION; FINITE_DELETE] THEN
1394   REWRITE_TAC[IN_DELETE; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
1395   MATCH_MP_TAC SUBSET_ANTISYM THEN
1396   REWRITE_TAC[FORALL_IN_GSPEC; SUBSET; LEFT_IMP_EXISTS_THM] THEN
1397   REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL
1398    [MAP_EVERY X_GEN_TAC [`y:real^N`; `f:real^N->real`] THEN
1399     STRIP_TAC THEN EXISTS_TAC `f:real^N->real` THEN ASM_REWRITE_TAC[];
1400     X_GEN_TAC `f:real^N->real` THEN DISCH_TAC THEN
1401     EXISTS_TAC
1402      `\x:real^N. if x = vec 0
1403                  then &1 - sum ((s UNION t) DELETE vec 0) (\x. f x)
1404                  else f x` THEN
1405     MP_TAC(SET_RULE
1406      `!x:real^N. x IN (s UNION t) DELETE vec 0 ==> ~(x = vec 0)`) THEN
1407     SIMP_TAC[ETA_AX; REAL_SUB_ADD] THEN DISCH_THEN(K ALL_TAC) THEN
1408     ASM SET_TAC[]]);;
1409
1410 let AFF_GE_0_AFFINE_MULTIPLE_CONVEX = prove
1411  (`!s t:real^N->bool.
1412         FINITE s /\ FINITE t /\ vec 0 IN (s DIFF t) /\ ~(t = {})
1413         ==> aff_ge s t =
1414                {x + c % y | x IN affine hull (s DIFF t) /\
1415                             y IN convex hull t /\ &0 <= c}`,
1416   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[aff_ge_def; AFFSIGN_0; sgn_ge] THEN
1417   ONCE_REWRITE_TAC[SET_RULE `s UNION t = (s DIFF t) UNION t`] THEN
1418   ASM_SIMP_TAC[VSUM_UNION; FINITE_DIFF;
1419                SET_RULE `DISJOINT (s DIFF t) t`] THEN
1420   ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN
1421   ASM_SIMP_TAC[SPAN_FINITE; FINITE_DIFF; CONVEX_HULL_FINITE] THEN
1422   MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN
1423   REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL
1424    [X_GEN_TAC `f:real^N->real` THEN DISCH_TAC THEN
1425     EXISTS_TAC `vsum (s DIFF t) (\x:real^N. f x % x)` THEN
1426     ASM_CASES_TAC `sum t (f:real^N->real) = &0` THENL
1427      [MP_TAC(ISPECL [`f:real^N->real`; `t:real^N->bool`] SUM_POS_EQ_0) THEN
1428       ASM_SIMP_TAC[VECTOR_MUL_LZERO; REAL_MUL_LZERO; VSUM_0] THEN
1429       DISCH_TAC THEN EXISTS_TAC `&0` THEN
1430       REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LE_REFL] THEN
1431       REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL
1432        [EXISTS_TAC `f:real^N->real` THEN REWRITE_TAC[]; ALL_TAC] THEN
1433       ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
1434       REWRITE_TAC[RIGHT_EXISTS_AND_THM; GSYM EXISTS_REFL] THEN
1435       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
1436       DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN
1437       EXISTS_TAC `\x:real^N. if x = a then &1 else &0` THEN
1438       ASM_REWRITE_TAC[SUM_DELTA] THEN MESON_TAC[REAL_POS];
1439       EXISTS_TAC `sum t (f:real^N->real)` THEN
1440       EXISTS_TAC `inv(sum t (f:real^N->real)) % vsum t (\v. f v % v)` THEN
1441       REPEAT CONJ_TAC THENL
1442        [EXISTS_TAC `f:real^N->real` THEN REWRITE_TAC[];
1443         EXISTS_TAC `\x:real^N. f x / sum t (f:real^N->real)` THEN
1444         ASM_SIMP_TAC[REAL_LE_DIV; SUM_POS_LE] THEN
1445         ONCE_REWRITE_TAC[REAL_ARITH `x / y:real = inv y * x`] THEN
1446         ASM_SIMP_TAC[GSYM VECTOR_MUL_ASSOC; SUM_LMUL; VSUM_LMUL] THEN
1447         ASM_SIMP_TAC[REAL_MUL_LINV];
1448         ASM_SIMP_TAC[SUM_POS_LE];
1449         AP_TERM_TAC THEN ASM_CASES_TAC `sum t (f:real^N->real) = &0` THEN
1450         ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID]]];
1451     MAP_EVERY X_GEN_TAC [`x:real^N`; `c:real`; `y:real^N`] THEN
1452     DISCH_THEN(CONJUNCTS_THEN2
1453      (X_CHOOSE_THEN `u:real^N->real` (SUBST1_TAC o SYM)) MP_TAC) THEN
1454     DISCH_THEN(CONJUNCTS_THEN2
1455      (X_CHOOSE_THEN `v:real^N->real`MP_TAC) ASSUME_TAC) THEN
1456     REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
1457     DISCH_THEN(SUBST1_TAC o SYM) THEN
1458     EXISTS_TAC `(\x. if x IN t then c * v x else u x):real^N->real` THEN
1459     ASM_SIMP_TAC[REAL_LE_MUL; VSUM_LMUL; GSYM VECTOR_MUL_ASSOC] THEN
1460     AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN
1461     SIMP_TAC[IN_DIFF]]);;
1462
1463 let AFF_GE_0_MULTIPLE_AFFINE_CONVEX = prove
1464  (`!s t:real^N->bool.
1465         FINITE s /\ FINITE t /\ vec 0 IN (s DIFF t) /\ ~(t = {})
1466         ==> aff_ge s t =
1467                affine hull (s DIFF t) UNION
1468                {c % (x + y) | x IN affine hull (s DIFF t) /\
1469                               y IN convex hull t /\ &0 <= c}`,
1470   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
1471   REWRITE_TAC[UNION_SUBSET] THEN REPEAT CONJ_TAC THENL
1472    [ASM_SIMP_TAC[AFF_GE_0_AFFINE_MULTIPLE_CONVEX;
1473                  AFFINE_HULL_EQ_SPAN; HULL_INC] THEN
1474     REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN
1475     MAP_EVERY X_GEN_TAC [`x:real^N`; `c:real`; `y:real^N`] THEN STRIP_TAC THEN
1476     REWRITE_TAC[IN_ELIM_THM; IN_UNION] THEN ASM_CASES_TAC `c = &0` THENL
1477      [DISJ1_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID];
1478       DISJ2_TAC THEN MAP_EVERY EXISTS_TAC
1479        [`c:real`; `inv(c) % x:real^N`; `y:real^N`] THEN
1480       ASM_SIMP_TAC[SPAN_MUL; VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC;
1481                    REAL_MUL_RINV; VECTOR_MUL_LID]];
1482     REWRITE_TAC[aff_ge_def] THEN ONCE_REWRITE_TAC[AFFSIGN_DISJOINT_DIFF] THEN
1483     REWRITE_TAC[GSYM aff_ge_def] THEN
1484     MATCH_MP_TAC AFFINE_HULL_SUBSET_AFF_GE THEN SET_TAC[];
1485     ASM_SIMP_TAC[AFF_GE_0_AFFINE_MULTIPLE_CONVEX;
1486                  AFFINE_HULL_EQ_SPAN; HULL_INC] THEN
1487     REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN
1488     MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
1489     REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC
1490      [`c % x:real^N`; `c:real`; `y:real^N`] THEN
1491     ASM_SIMP_TAC[SPAN_MUL; VECTOR_ADD_LDISTRIB]]);;
1492
1493 let AFF_GE_0_AFFINE_CONVEX_CONE = prove
1494  (`!s t:real^N->bool.
1495         FINITE s /\ FINITE t /\ vec 0 IN (s DIFF t)
1496         ==> aff_ge s t =
1497                {x + y | x IN affine hull (s DIFF t) /\
1498                         y IN convex_cone hull t}`,
1499   REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL
1500    [ASM_REWRITE_TAC[AFF_GE_EQ_AFFINE_HULL; CONVEX_CONE_HULL_EMPTY] THEN
1501     REWRITE_TAC[IN_SING; DIFF_EMPTY] THEN
1502     REWRITE_TAC[SET_RULE `{x + y:real^N | P x /\ y = a} = {x + a | P x}`] THEN
1503     REWRITE_TAC[VECTOR_ADD_RID] THEN SET_TAC[];
1504     ASM_SIMP_TAC[CONVEX_CONE_HULL_CONVEX_HULL_NONEMPTY;
1505                   AFF_GE_0_AFFINE_MULTIPLE_CONVEX] THEN
1506    SET_TAC[]]);;
1507
1508 let AFF_GE_0_N = prove
1509  (`!s:real^N->bool.
1510         FINITE s /\ ~(vec 0 IN s)
1511         ==> aff_ge {vec 0} s =
1512                 {y | ?u. (!x. x IN s ==> &0 <= u x) /\
1513                          y = vsum s (\x. u x % x)}`,
1514   REPEAT STRIP_TAC THEN REWRITE_TAC[aff_ge_def] THEN
1515   ASM_SIMP_TAC[AFFSIGN_0; IN_DIFF; IN_INSERT; NOT_IN_EMPTY;
1516                FINITE_INSERT; FINITE_EMPTY] THEN
1517   ASM_SIMP_TAC[EXTENSION; sgn_ge; IN_ELIM_THM; INSERT_UNION; UNION_EMPTY] THEN
1518   ASM_SIMP_TAC[VSUM_CLAUSES; VECTOR_MUL_RZERO; VECTOR_ADD_LID]);;
1519
1520 let AFF_GE_0_CONVEX_HULL = prove
1521  (`!s:real^N->bool.
1522         FINITE s /\ ~(s = {}) /\ ~(vec 0 IN s)
1523         ==> aff_ge {vec 0} s = {t % y | &0 <= t /\ y IN convex hull s}`,
1524   REPEAT STRIP_TAC THEN
1525   ASM_SIMP_TAC[AFF_GE_0_AFFINE_MULTIPLE_CONVEX; IN_DIFF;
1526                FINITE_INSERT; FINITE_EMPTY; IN_INSERT] THEN
1527   ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> {a} DIFF s = {a}`] THEN
1528   REWRITE_TAC[AFFINE_HULL_SING; IN_SING] THEN
1529   REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_LID]);;
1530
1531 let AFF_GE_0_CONVEX_HULL_ALT = prove
1532  (`!s:real^N->bool.
1533         FINITE s /\ ~(vec 0 IN s)
1534         ==> aff_ge {vec 0} s =
1535             vec 0 INSERT {t % y | &0 < t /\ y IN convex hull s}`,
1536   REPEAT STRIP_TAC THEN
1537   ASM_CASES_TAC `s:real^N->bool = {}` THENL
1538    [ASM_REWRITE_TAC[AFF_GE_EQ_AFFINE_HULL; CONVEX_HULL_EMPTY] THEN
1539     REWRITE_TAC[AFFINE_HULL_SING; NOT_IN_EMPTY] THEN SET_TAC[];
1540     ASM_SIMP_TAC[AFF_GE_0_CONVEX_HULL; EXTENSION; IN_ELIM_THM; IN_INSERT] THEN
1541     X_GEN_TAC `y:real^N` THEN ASM_CASES_TAC `y:real^N = vec 0` THEN
1542     ASM_REWRITE_TAC[] THENL
1543      [EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_POS; VECTOR_MUL_LZERO] THEN
1544       ASM_REWRITE_TAC[MEMBER_NOT_EMPTY; CONVEX_HULL_EQ_EMPTY];
1545       AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `t:real` THEN
1546       AP_TERM_TAC THEN ABS_TAC THEN
1547       ASM_CASES_TAC `t = &0` THEN
1548       ASM_REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LT_REFL] THEN
1549       ASM_REWRITE_TAC[REAL_LT_LE]]]);;
1550
1551 let AFF_GE_0_CONVEX_CONE_NEGATIONS = prove
1552  (`!s t:real^N->bool.
1553         FINITE s /\ FINITE t /\ vec 0 IN (s DIFF t)
1554         ==> aff_ge s t =
1555             convex_cone hull (s UNION t UNION IMAGE (--) (s DIFF t))`,
1556   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[AFF_GE_0_AFFINE_CONVEX_CONE] THEN
1557   ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN
1558   REWRITE_TAC[SPAN_CONVEX_CONE_ALLSIGNS; GSYM CONVEX_CONE_HULL_UNION] THEN
1559   AP_TERM_TAC THEN SET_TAC[]);;
1560
1561 let CONVEX_HULL_AFF_GE = prove
1562  (`!s. convex hull s = aff_ge {} s`,
1563   SIMP_TAC[aff_ge_def; AFFSIGN; CONVEX_HULL_FINITE; sgn_ge; UNION_EMPTY] THEN
1564   REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN
1565   AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[]);;
1566
1567 let POLYHEDRON_AFF_GE = prove
1568  (`!s t:real^N->bool. FINITE s /\ FINITE t ==> polyhedron(aff_ge s t)`,
1569   REPEAT STRIP_TAC THEN REWRITE_TAC[aff_ge_def] THEN
1570   ONCE_REWRITE_TAC[AFFSIGN_DISJOINT_DIFF] THEN
1571   REWRITE_TAC[GSYM aff_ge_def] THEN
1572   SUBGOAL_THEN `FINITE(s DIFF t) /\ FINITE(t:real^N->bool) /\
1573                 DISJOINT (s DIFF t) t`
1574   MP_TAC THENL [ASM_SIMP_TAC[FINITE_DIFF] THEN ASM SET_TAC[]; ALL_TAC] THEN
1575   POP_ASSUM_LIST(K ALL_TAC) THEN
1576   SPEC_TAC(`s DIFF t:real^N->bool`,`s:real^N->bool`) THEN
1577   MATCH_MP_TAC SET_PROVE_CASES THEN CONJ_TAC THENL
1578    [REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CONVEX_HULL_AFF_GE] THEN
1579     MATCH_MP_TAC POLYTOPE_IMP_POLYHEDRON THEN REWRITE_TAC[polytope] THEN
1580     ASM_MESON_TAC[];
1581     ALL_TAC] THEN
1582   MAP_EVERY X_GEN_TAC [`a:real^N`; `s:real^N->bool`] THEN
1583   GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN
1584   SUBGOAL_THEN `(vec 0:real^N) IN ((vec 0 INSERT s) DIFF t)` ASSUME_TAC THENL
1585    [ASM SET_TAC[]; ALL_TAC] THEN
1586   ASM_SIMP_TAC[AFF_GE_0_CONVEX_CONE_NEGATIONS; FINITE_INSERT] THEN
1587   MATCH_MP_TAC POLYHEDRON_CONVEX_CONE_HULL THEN
1588   ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; FINITE_DIFF; FINITE_IMAGE]);;
1589
1590 let CLOSED_AFF_GE = prove
1591  (`!s t:real^N->bool. FINITE s /\ FINITE t ==> closed(aff_ge s t)`,
1592   SIMP_TAC[POLYHEDRON_AFF_GE; POLYHEDRON_IMP_CLOSED]);;
1593
1594 let CONIC_AFF_GE_0 = prove
1595  (`!s:real^N->bool. FINITE s /\ ~(vec 0 IN s) ==> conic(aff_ge {vec 0} s)`,
1596   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[AFF_GE_0_N; conic] THEN
1597   REWRITE_TAC[IN_ELIM_THM] THEN GEN_TAC THEN X_GEN_TAC `c:real` THEN
1598   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
1599   DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN
1600   EXISTS_TAC `\v. c * (u:real^N->real) v` THEN
1601   REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; VSUM_LMUL] THEN
1602   ASM_MESON_TAC[REAL_LE_MUL]);;
1603
1604 let ANGLES_ADD_AFF_GE = prove
1605  (`!u v w x:real^N.
1606         ~(v = u) /\ ~(w = u) /\ ~(x = u) /\ x IN aff_ge {u} {v,w}
1607         ==> angle(v,u,x) + angle(x,u,w) = angle(v,u,w)`,
1608   GEOM_ORIGIN_TAC `u:real^N` THEN REPEAT GEN_TAC THEN
1609   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
1610   ASM_SIMP_TAC[AFF_GE_1_2_0] THEN
1611   REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
1612   MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN
1613   DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
1614   SUBGOAL_THEN `a = &0 /\ b = &0 \/ &0 < a + b` STRIP_ASSUME_TAC THENL
1615    [ASM_REAL_ARITH_TAC;
1616     ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID];
1617     ALL_TAC] THEN
1618   DISCH_TAC THEN MP_TAC(ISPECL
1619    [`v:real^N`; `w:real^N`; `inv(a + b) % x:real^N`; `vec 0:real^N`]
1620    ANGLES_ADD_BETWEEN) THEN
1621   ASM_REWRITE_TAC[angle; VECTOR_SUB_RZERO] THEN
1622   ASM_SIMP_TAC[VECTOR_ANGLE_RMUL; VECTOR_ANGLE_LMUL;
1623     REAL_INV_EQ_0; REAL_LE_INV_EQ; REAL_LT_IMP_NZ; REAL_LT_IMP_LE] THEN
1624   DISCH_THEN MATCH_MP_TAC THEN
1625   REWRITE_TAC[BETWEEN_IN_SEGMENT; CONVEX_HULL_2; SEGMENT_CONVEX_HULL] THEN
1626   REWRITE_TAC[IN_ELIM_THM] THEN
1627   MAP_EVERY EXISTS_TAC [`a / (a + b):real`; `b / (a + b):real`] THEN
1628   ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_IMP_LE; VECTOR_ADD_LDISTRIB] THEN
1629   REWRITE_TAC[VECTOR_MUL_ASSOC; real_div; REAL_MUL_AC] THEN
1630   UNDISCH_TAC `&0 < a + b` THEN CONV_TAC REAL_FIELD);;
1631
1632 let AFF_GE_2_1_0_DROPOUT_3 = prove
1633  (`!w z:real^3.
1634         ~collinear{vec 0,basis 3,z}
1635         ==> (w IN aff_ge {vec 0,basis 3} {z} <=>
1636              (dropout 3 w) IN aff_ge {vec 0:real^2} {dropout 3 z})`,
1637   REPEAT GEN_TAC THEN
1638   ASM_CASES_TAC `z:real^3 = vec 0` THENL
1639    [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC] THEN
1640   ASM_CASES_TAC `z:real^3 = basis 3` THENL
1641    [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC] THEN
1642   REWRITE_TAC[COLLINEAR_BASIS_3] THEN DISCH_TAC THEN
1643   ASM_SIMP_TAC[AFF_GE_2_1_0; SET_RULE `DISJOINT s {a} <=> ~(a IN s)`;
1644                IN_INSERT; NOT_IN_EMPTY; AFF_GE_1_1_0] THEN
1645   REWRITE_TAC[IN_ELIM_THM] THEN
1646   MATCH_MP_TAC(MESON[]
1647    `(!t. ((?s. P s t) <=> Q t)) ==> ((?s t. P s t) <=> (?t. Q t))`) THEN
1648   X_GEN_TAC `t:real` THEN EQ_TAC THENL
1649    [STRIP_TAC THEN
1650     ASM_REWRITE_TAC[DROPOUT_ADD; DROPOUT_MUL; DROPOUT_BASIS_3] THEN
1651     VECTOR_ARITH_TAC;
1652     STRIP_TAC THEN EXISTS_TAC `(w:real^3)$3 - t * (z:real^3)$3` THEN
1653     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN
1654     ASM_REWRITE_TAC[CART_EQ; FORALL_2; FORALL_3; DIMINDEX_2; DIMINDEX_3] THEN
1655     REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
1656     SIMP_TAC[dropout; LAMBDA_BETA; DIMINDEX_2; ARITH; BASIS_COMPONENT;
1657              DIMINDEX_3] THEN
1658     CONV_TAC REAL_RING]);;
1659
1660 let AFF_GE_2_1_0_SEMIALGEBRAIC = prove
1661  (`!x y z:real^3.
1662         ~collinear {vec 0,x,y} /\ ~collinear {vec 0,x,z}
1663         ==> (z IN aff_ge {vec 0,x} {y} <=>
1664              (x cross y) cross x cross z = vec 0 /\
1665              &0 <= (x cross z) dot (x cross y))`,
1666   let lemma0 = prove
1667    (`~(y = vec 0) ==> ((?s. x = s % y) <=> y cross x = vec 0)`,
1668     REWRITE_TAC[CROSS_EQ_0] THEN SIMP_TAC[COLLINEAR_LEMMA_ALT])
1669   and lemma1 = prove
1670    (`!x y:real^N.
1671           ~(y = vec 0)
1672           ==> ((?t. &0 <= t /\ x = t % y) <=>
1673                (?t. x = t % y) /\ &0 <= x dot y)`,
1674     REPEAT STRIP_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
1675     AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `t:real` THEN
1676     ASM_CASES_TAC `x:real^N = t % y` THEN
1677     ASM_SIMP_TAC[DOT_LMUL; REAL_LE_MUL_EQ; DOT_POS_LT]) in
1678   REPEAT GEN_TAC THEN
1679   MAP_EVERY (fun t -> ASM_CASES_TAC t THENL
1680    [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC])
1681    [`x:real^3 = vec 0`; `y:real^3 = vec 0`; `y:real^3 = x`] THEN
1682   STRIP_TAC THEN
1683   ASM_SIMP_TAC[AFF_GE_2_1_0; IN_ELIM_THM; SET_RULE
1684     `DISJOINT {a,b} {c} <=> ~(a = c) /\ ~(b = c)`] THEN
1685   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
1686   REWRITE_TAC[RIGHT_EXISTS_AND_THM; VECTOR_ARITH
1687     `a:real^N = b + c <=> a - c = b`] THEN
1688   RULE_ASSUM_TAC(REWRITE_RULE[GSYM CROSS_EQ_0]) THEN
1689   ASM_SIMP_TAC[lemma0; lemma1; CROSS_RMUL; CROSS_RSUB; VECTOR_SUB_EQ]);;
1690
1691 (* ------------------------------------------------------------------------- *)
1692 (* Special case of aff_ge {x} {y}, i.e. rays or half-lines.                  *)
1693 (* ------------------------------------------------------------------------- *)
1694
1695 let HALFLINE_REFL = prove
1696  (`!x. aff_ge {x} {x} = {x}`,
1697   ONCE_REWRITE_TAC[AFF_GE_DISJOINT_DIFF] THEN
1698   ASM_REWRITE_TAC[DIFF_EQ_EMPTY; GSYM CONVEX_HULL_AFF_GE; CONVEX_HULL_SING]);;
1699
1700 let HALFLINE_EXPLICIT = prove
1701  (`!x y:real^N.
1702         aff_ge {x} {y} =
1703           {z | ?t1 t2. &0 <= t2 /\ t1 + t2 = &1 /\ z = t1 % x + t2 % y}`,
1704   REPEAT GEN_TAC THEN ASM_CASES_TAC `x:real^N = y` THENL
1705    [ASM_REWRITE_TAC[HALFLINE_REFL]; AFF_TAC] THEN
1706   REWRITE_TAC[REAL_ARITH `x + y = &1 <=> x = &1 - y`] THEN
1707   REWRITE_TAC[VECTOR_ARITH `(&1 - x) % v + x % v:real^N = v`;
1708     MESON[] `(?x y. P y /\ x = f y /\ Q x y) <=> (?y. P y /\ Q (f y) y)`] THEN
1709   REWRITE_TAC[IN_ELIM_THM; IN_SING; EXTENSION] THEN MESON_TAC[REAL_POS]);;
1710
1711 let HALFLINE = prove
1712  (`!x y:real^N.
1713         aff_ge {x} {y} =
1714           {z | ?t. &0 <= t /\ z = (&1 - t) % x + t % y}`,
1715   REWRITE_TAC[HALFLINE_EXPLICIT;  REAL_ARITH `x + y = &1 <=> x = &1 - y`] THEN
1716   SET_TAC[]);;
1717
1718 let CLOSED_HALFLINE = prove
1719  (`!x y. closed(aff_ge {x} {y})`,
1720   SIMP_TAC[CLOSED_AFF_GE; FINITE_SING]);;
1721
1722 let SEGMENT_SUBSET_HALFLINE = prove
1723  (`!x y. segment[x,y] SUBSET aff_ge {x} {y}`,
1724   REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_2; HALFLINE_EXPLICIT] THEN
1725   SET_TAC[]);;
1726
1727 let ENDS_IN_HALFLINE = prove
1728  (`(!x y. x IN aff_ge {x} {y}) /\ (!x y. y IN aff_ge {x} {y})`,
1729   MESON_TAC[SEGMENT_SUBSET_HALFLINE; SUBSET; ENDS_IN_SEGMENT]);;
1730
1731 let HALFLINE_SUBSET_AFFINE_HULL = prove
1732  (`!x y. aff_ge {x} {y} SUBSET affine hull {x,y}`,
1733   REWRITE_TAC[AFF_GE_SUBSET_AFFINE_HULL; SET_RULE `{x,y} = {x} UNION {y}`]);;
1734
1735 let HALFLINE_INTER_COMPACT_SEGMENT = prove
1736  (`!s a b:real^N.
1737         compact s /\ convex s /\ a IN s
1738         ==> ?c. aff_ge {a} {b} INTER s = segment[a,c]`,
1739   REPEAT STRIP_TAC THEN ASM_CASES_TAC `b:real^N = a` THENL
1740    [EXISTS_TAC `a:real^N` THEN
1741     ASM_REWRITE_TAC[SEGMENT_REFL; HALFLINE_REFL] THEN ASM SET_TAC[];
1742     ALL_TAC] THEN
1743   SUBGOAL_THEN
1744    `?u v:real^N. aff_ge {a} {b} INTER s = segment[u,v]`
1745   STRIP_ASSUME_TAC THENL
1746    [MATCH_MP_TAC COMPACT_CONVEX_COLLINEAR_SEGMENT THEN
1747     ASM_SIMP_TAC[CLOSED_INTER_COMPACT; CLOSED_AFF_GE; FINITE_SING] THEN
1748     ASM_SIMP_TAC[CONVEX_INTER; CONVEX_AFF_GE] THEN CONJ_TAC THENL
1749      [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
1750       ASM_MESON_TAC[ENDS_IN_HALFLINE];
1751       MATCH_MP_TAC COLLINEAR_SUBSET THEN
1752       EXISTS_TAC `affine hull {a:real^N,b}` THEN
1753       REWRITE_TAC[COLLINEAR_AFFINE_HULL_COLLINEAR; COLLINEAR_2] THEN
1754       MATCH_MP_TAC(SET_RULE `s SUBSET u ==> (s INTER t) SUBSET u`) THEN
1755       REWRITE_TAC[HALFLINE_SUBSET_AFFINE_HULL]];
1756     ASM_CASES_TAC `u:real^N = a` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
1757     ASM_CASES_TAC `v:real^N = a` THENL
1758      [ASM_MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN
1759     SUBGOAL_THEN `u IN aff_ge {a:real^N} {b} /\ v IN aff_ge {a} {b}`
1760     MP_TAC THENL [ASM_MESON_TAC[IN_INTER; ENDS_IN_SEGMENT]; ALL_TAC] THEN
1761     GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [HALFLINE; IN_ELIM_THM] THEN
1762     DISCH_THEN(CONJUNCTS_THEN2
1763      (X_CHOOSE_THEN `s:real` MP_TAC) (X_CHOOSE_THEN `t:real` MP_TAC)) THEN
1764     MAP_EVERY ASM_CASES_TAC [`s = &0`; `t = &0`] THEN
1765     ASM_REWRITE_TAC[REAL_SUB_RZERO; VECTOR_MUL_LID; VECTOR_MUL_LZERO;
1766                     VECTOR_ADD_RID] THEN
1767     ASM_REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THEN
1768     SUBGOAL_THEN `(a:real^N) IN segment[u,v]` MP_TAC THENL
1769      [ASM_MESON_TAC[IN_INTER; ENDS_IN_HALFLINE]; ALL_TAC] THEN
1770     ASM_REWRITE_TAC[IN_SEGMENT; LEFT_IMP_EXISTS_THM] THEN
1771     X_GEN_TAC `u:real` THEN
1772     REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
1773     REWRITE_TAC[VECTOR_ARITH
1774      `a = (&1 - u) % ((&1 - s) % a + s % b) + u % ((&1 - t) % a + t % b) <=>
1775       ((&1 - u) * s + u * t) % (b - a):real^N = vec 0`] THEN
1776     ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN
1777     ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_LT_IMP_LE; REAL_ARITH
1778      `&0 <= x /\ &0 <= y ==> (x + y = &0 <=> x = &0 /\ y = &0)`] THEN
1779     ASM_SIMP_TAC[REAL_ENTIRE; REAL_LT_IMP_NZ] THEN REAL_ARITH_TAC]);;
1780
1781 (* ------------------------------------------------------------------------- *)
1782 (* Definition and properties of conv0.                                       *)
1783 (* ------------------------------------------------------------------------- *)
1784
1785 let conv0 = new_definition `conv0 S:real^A->bool = affsign sgn_gt {} S`;;
1786
1787 let CONV0_INJECTIVE_LINEAR_IMAGE = prove
1788  (`!f s. linear f /\ (!x y. f x = f y ==> x = y)
1789          ==> conv0(IMAGE f s) = IMAGE f (conv0 s)`,
1790   REPEAT GEN_TAC THEN DISCH_TAC THEN
1791   FIRST_ASSUM(ASSUME_TAC o GSYM o MATCH_MP AFFSIGN_INJECTIVE_LINEAR_IMAGE) THEN
1792   ASM_REWRITE_TAC[conv0; IMAGE_CLAUSES]);;
1793
1794 add_linear_invariants [CONV0_INJECTIVE_LINEAR_IMAGE];;
1795
1796 let CONV0_TRANSLATION = prove
1797  (`!a s. conv0(IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (conv0 s)`,
1798   REWRITE_TAC[conv0; GSYM AFFSIGN_TRANSLATION; IMAGE_CLAUSES]);;
1799
1800 add_translation_invariants [CONV0_TRANSLATION];;
1801
1802 let CONV0_SUBSET_CONVEX_HULL = prove
1803  (`!s. conv0 s SUBSET convex hull s`,
1804   REWRITE_TAC[conv0; AFFSIGN; sgn_gt; CONVEX_HULL_FINITE; UNION_EMPTY] THEN
1805   REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
1806   REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN
1807   MESON_TAC[REAL_LT_IMP_LE]);;
1808
1809 let CONV0_AFF_GT = prove
1810  (`!s. conv0 s = aff_gt {} s`,
1811   REWRITE_TAC[conv0; aff_gt_def]);;
1812
1813 let CONVEX_HULL_CONV0_DECOMP = prove
1814  (`!s:real^N->bool.
1815         FINITE s
1816         ==> convex hull s = conv0 s UNION
1817                             UNIONS {convex hull (s DELETE a) | a | a IN s}`,
1818   REWRITE_TAC[CONV0_AFF_GT; CONVEX_HULL_AFF_GE] THEN
1819   REPEAT STRIP_TAC THEN MATCH_MP_TAC AFF_GE_AFF_GT_DECOMP THEN
1820   ASM_REWRITE_TAC[FINITE_EMPTY] THEN SET_TAC[]);;
1821
1822 let CONVEX_CONV0 = prove
1823  (`!s. convex(conv0 s)`,
1824   REWRITE_TAC[CONV0_AFF_GT; CONVEX_AFF_GT]);;
1825
1826 let BOUNDED_CONV0 = prove
1827  (`!s:real^N->bool. bounded s ==> bounded(conv0 s)`,
1828   REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_SUBSET THEN
1829   EXISTS_TAC `convex hull s:real^N->bool` THEN
1830   ASM_SIMP_TAC[BOUNDED_CONVEX_HULL; CONV0_SUBSET_CONVEX_HULL]);;
1831
1832 let MEASURABLE_CONV0 = prove
1833  (`!s. bounded s ==> measurable(conv0 s)`,
1834   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX THEN
1835   ASM_SIMP_TAC[CONVEX_CONV0; BOUNDED_CONV0]);;
1836
1837 let NEGLIGIBLE_CONVEX_HULL_DIFF_CONV0 = prove
1838  (`!s:real^N->bool.
1839         FINITE s /\ CARD s <= dimindex(:N) + 1
1840         ==> negligible(convex hull s DIFF conv0 s)`,
1841   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONVEX_HULL_CONV0_DECOMP] THEN
1842   REWRITE_TAC[SET_RULE `(s UNION t) DIFF s = t DIFF s`] THEN
1843   MATCH_MP_TAC NEGLIGIBLE_DIFF THEN MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN
1844   ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN
1845   REWRITE_TAC[FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN
1846   MATCH_MP_TAC NEGLIGIBLE_CONVEX_HULL THEN
1847   ASM_SIMP_TAC[FINITE_DELETE; CARD_DELETE] THEN ASM_ARITH_TAC);;
1848
1849 let MEASURE_CONV0_CONVEX_HULL = prove
1850  (`!s:real^N->bool.
1851         FINITE s /\ CARD s <= dimindex(:N) + 1
1852         ==> measure(conv0 s) = measure(convex hull s)`,
1853   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN
1854   ASM_SIMP_TAC[MEASURABLE_CONVEX_HULL; FINITE_IMP_BOUNDED] THEN
1855   MATCH_MP_TAC NEGLIGIBLE_UNION THEN
1856   ASM_SIMP_TAC[NEGLIGIBLE_CONVEX_HULL_DIFF_CONV0] THEN
1857   ASM_SIMP_TAC[CONV0_SUBSET_CONVEX_HULL; NEGLIGIBLE_EMPTY;
1858                SET_RULE `s SUBSET t ==> s DIFF t = {}`]);;
1859
1860 (* ------------------------------------------------------------------------- *)
1861 (* Orthonormal triples of vectors in 3D.                                     *)
1862 (* ------------------------------------------------------------------------- *)
1863
1864 let orthonormal = new_definition
1865   `orthonormal e1 e2 e3 <=>
1866      e1 dot e1 = &1 /\ e2 dot e2 = &1 /\ e3 dot e3 = &1 /\
1867      e1 dot e2 = &0 /\ e1 dot e3 = &0 /\ e2 dot e3 = &0 /\
1868      &0 < (e1 cross e2) dot e3`;;
1869
1870 let ORTHONORMAL_LINEAR_IMAGE = prove
1871  (`!f. linear(f) /\ (!x. norm(f x) = norm x) /\
1872        (2 <= dimindex(:3) ==> det(matrix f) = &1)
1873        ==> !e1 e2 e3. orthonormal (f e1) (f e2) (f e3) <=>
1874                       orthonormal e1 e2 e3`,
1875   SIMP_TAC[DIMINDEX_3; ARITH; CONJ_ASSOC; GSYM ORTHOGONAL_TRANSFORMATION] THEN
1876   SIMP_TAC[orthonormal; CROSS_ORTHOGONAL_TRANSFORMATION] THEN
1877   SIMP_TAC[orthogonal_transformation; VECTOR_MUL_LID]);;
1878
1879 add_linear_invariants [ORTHONORMAL_LINEAR_IMAGE];;
1880
1881 let ORTHONORMAL_PERMUTE = prove
1882  (`!e1 e2 e3. orthonormal e1 e2 e3 ==> orthonormal e2 e3 e1`,
1883   REWRITE_TAC[orthonormal] THEN
1884   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
1885   ONCE_REWRITE_TAC[GSYM CROSS_TRIPLE] THEN ASM_REWRITE_TAC[] THEN
1886   ONCE_REWRITE_TAC[DOT_SYM] THEN ASM_REWRITE_TAC[]);;
1887
1888 let ORTHONORMAL_CROSS = prove
1889  (`!e1 e2 e3.
1890         orthonormal e1 e2 e3
1891         ==> e2 cross e3 = e1 /\ e3 cross e1 = e2 /\ e1 cross e2 = e3`,
1892   SUBGOAL_THEN
1893    `!e1 e2 e3. orthonormal e1 e2 e3 ==> e3 cross e1 = e2`
1894    (fun th -> MESON_TAC[th; ORTHONORMAL_PERMUTE]) THEN
1895   GEOM_BASIS_MULTIPLE_TAC 1 `e1:real^3` THEN X_GEN_TAC `k:real` THEN
1896   REWRITE_TAC[orthonormal; DOT_LMUL; DOT_RMUL] THEN
1897   SIMP_TAC[DOT_BASIS_BASIS; DIMINDEX_3; ARITH; REAL_MUL_RID] THEN
1898   REWRITE_TAC[REAL_RING `k * k = &1 <=> k = &1 \/ k = -- &1`] THEN
1899   ASM_CASES_TAC `k = -- &1` THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
1900   ASM_CASES_TAC `k = &1` THEN
1901   ASM_REWRITE_TAC[VECTOR_MUL_LID; REAL_MUL_LID; REAL_MUL_RID] THEN
1902   SIMP_TAC[cross; DOT_3; VECTOR_3; CART_EQ; FORALL_3; DIMINDEX_3;
1903            BASIS_COMPONENT; DIMINDEX_3; ARITH; REAL_POS] THEN
1904   REWRITE_TAC[REAL_MUL_LZERO; REAL_SUB_RZERO; REAL_ADD_RID;
1905               REAL_MUL_LID] THEN
1906   REPEAT GEN_TAC THEN
1907   ASM_CASES_TAC `(e2:real^3)$1 = &0` THEN ASM_REWRITE_TAC[] THEN
1908   ASM_CASES_TAC `(e3:real^3)$1 = &0` THEN ASM_REWRITE_TAC[] THEN
1909   REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO; REAL_ADD_LID] THEN
1910   REWRITE_TAC[REAL_SUB_LZERO; REAL_MUL_RID] THEN
1911   MATCH_MP_TAC(REAL_ARITH
1912    `(u = &1 /\ v = &1 /\ w = &0 ==> a = b /\ --c = d \/ a = --b /\ c = d) /\
1913     (a = --b /\ c = d ==> x <= &0)
1914     ==> (u = &1 /\ v = &1 /\ w = &0 /\ &0 < x
1915          ==> a:real = b /\ --c:real = d)`) THEN
1916   CONJ_TAC THENL [CONV_TAC REAL_RING; ALL_TAC] THEN
1917   DISCH_THEN(CONJUNCTS_THEN SUBST1_TAC) THEN
1918   MATCH_MP_TAC(REAL_ARITH
1919    `&0 <= x * x /\ &0 <= y * y ==> --x * x + y * -- y <= &0`) THEN
1920   REWRITE_TAC[REAL_LE_SQUARE]);;
1921
1922 let ORTHONORMAL_IMP_NONZERO = prove
1923  (`!e1 e2 e3. orthonormal e1 e2 e3
1924               ==> ~(e1 = vec 0) /\ ~(e2 = vec 0) /\ ~(e3 = vec 0)`,
1925   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
1926   REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN
1927   ASM_REWRITE_TAC[orthonormal; DOT_LZERO] THEN REAL_ARITH_TAC);;
1928
1929 let ORTHONORMAL_IMP_DISTINCT = prove
1930  (`!e1 e2 e3. orthonormal e1 e2 e3 ==> ~(e1 = e2) /\ ~(e1 = e3) /\ ~(e2 = e3)`,
1931   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
1932   REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN
1933   ASM_REWRITE_TAC[orthonormal; DOT_LZERO] THEN REAL_ARITH_TAC);;
1934
1935 let ORTHONORMAL_IMP_INDEPENDENT = prove
1936  (`!e1 e2 e3. orthonormal e1 e2 e3 ==> independent {e1,e2,e3}`,
1937   REPEAT STRIP_TAC THEN MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN
1938   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[ORTHONORMAL_IMP_NONZERO]] THEN
1939   RULE_ASSUM_TAC(REWRITE_RULE[orthonormal]) THEN
1940   REWRITE_TAC[pairwise; IN_INSERT; NOT_IN_EMPTY] THEN
1941   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[orthogonal] THEN
1942   ASM_MESON_TAC[DOT_SYM]);;
1943
1944 let ORTHONORMAL_IMP_SPANNING = prove
1945  (`!e1 e2 e3. orthonormal e1 e2 e3 ==> span {e1,e2,e3} = (:real^3)`,
1946   REPEAT STRIP_TAC THEN
1947   MP_TAC(ISPECL [`(:real^3)`; `{e1:real^3,e2,e3}`] CARD_EQ_DIM) THEN
1948   ASM_SIMP_TAC[ORTHONORMAL_IMP_INDEPENDENT; SUBSET_UNIV] THEN
1949   REWRITE_TAC[DIM_UNIV; DIMINDEX_3; HAS_SIZE; FINITE_INSERT; FINITE_EMPTY] THEN
1950   SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; IN_INSERT] THEN
1951   FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHONORMAL_IMP_DISTINCT) THEN
1952   ASM_REWRITE_TAC[NOT_IN_EMPTY; ARITH] THEN SET_TAC[]);;
1953
1954 let ORTHONORMAL_IMP_INDEPENDENT_EXPLICIT_0 = prove
1955  (`!e1 e2 e3 t1 t2 t3.
1956         orthonormal e1 e2 e3
1957         ==> (t1 % e1 + t2 % e2 + t3 % e3 = vec 0 <=>
1958              t1 = &0 /\ t2 = &0 /\ t3 = &0)`,
1959   REPEAT STRIP_TAC THEN MATCH_MP_TAC INDEPENDENT_3 THEN
1960   ASM_MESON_TAC[ORTHONORMAL_IMP_INDEPENDENT; ORTHONORMAL_IMP_DISTINCT]);;
1961
1962 let ORTHONORMAL_IMP_INDEPENDENT_EXPLICIT = prove
1963  (`!e1 e2 e3 s1 s2 s3 t1 t2 t3.
1964         orthonormal e1 e2 e3
1965         ==> (s1 % e1 + s2 % e2 + s3 % e3 = t1 % e1 + t2 % e2 + t3 % e3 <=>
1966              s1 = t1 /\ s2 = t2 /\ s3 = t3)`,
1967   SIMP_TAC[ORTHONORMAL_IMP_INDEPENDENT_EXPLICIT_0; REAL_SUB_0; VECTOR_ARITH
1968    `a % x + b % y + c % z:real^3 = a' % x + b' % y + c' % z <=>
1969     (a - a') % x + (b - b') % y + (c - c') % z = vec 0`]);;
1970
1971 (* ------------------------------------------------------------------------- *)
1972 (* Flyspeck arcV is the same as angle even in degenerate cases.              *)
1973 (* ------------------------------------------------------------------------- *)
1974
1975 let arcV = new_definition
1976   `arcV u v w = acs (( (v - u) dot (w - u))/((norm (v-u)) * (norm (w-u))))`;;
1977
1978 let ARCV_ANGLE = prove
1979  (`!u v w:real^N. arcV u v w = angle(v,u,w)`,
1980   REPEAT GEN_TAC THEN REWRITE_TAC[arcV; angle; vector_angle] THEN
1981   REWRITE_TAC[VECTOR_SUB_EQ] THEN
1982   ASM_CASES_TAC `v:real^N = u` THEN
1983   ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; DOT_LZERO] THEN
1984   REWRITE_TAC[real_div; REAL_MUL_LZERO; ACS_0] THEN
1985   ASM_CASES_TAC `w:real^N = u` THEN
1986   ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; DOT_RZERO] THEN
1987   REWRITE_TAC[real_div; REAL_MUL_LZERO; ACS_0]);;
1988
1989 let ARCV_LINEAR_IMAGE_EQ = prove
1990  (`!f a b c.
1991         linear f /\ (!x. norm(f x) = norm x)
1992         ==> arcV (f a) (f b) (f c) = arcV a b c`,
1993   REWRITE_TAC[ARCV_ANGLE; ANGLE_LINEAR_IMAGE_EQ]);;
1994
1995 add_linear_invariants [ARCV_LINEAR_IMAGE_EQ];;
1996
1997 let ARCV_TRANSLATION_EQ = prove
1998  (`!a b c d. arcV (a + b) (a + c) (a + d) = arcV b c d`,
1999   REWRITE_TAC[ARCV_ANGLE; ANGLE_TRANSLATION_EQ]);;
2000
2001 add_translation_invariants [ARCV_TRANSLATION_EQ];;
2002
2003 (* ------------------------------------------------------------------------- *)
2004 (* Azimuth angle.                                                            *)
2005 (* ------------------------------------------------------------------------- *)
2006
2007 let AZIM_EXISTS = prove
2008  (`!v w w1 w2.
2009           ?theta. &0 <= theta /\ theta < &2 * pi /\
2010                   ?h1 h2.
2011                      !e1 e2 e3.
2012                         orthonormal e1 e2 e3 /\
2013                         dist(w,v) % e3 = w - v /\
2014                         ~(w = v)
2015                         ==> ?psi r1 r2.
2016                                 w1 - v = (r1 * cos psi) % e1 +
2017                                          (r1 * sin psi) % e2 +
2018                                          h1 % (w - v) /\
2019                                 w2 - v = (r2 * cos (psi + theta)) % e1 +
2020                                          (r2 * sin (psi + theta)) % e2 +
2021                                          h2 % (w - v) /\
2022                                 (~collinear {v, w, w1} ==> &0 < r1) /\
2023                                 (~collinear {v, w, w2} ==> &0 < r2)`,
2024   let lemma = prove
2025    (`cos(p) % e + sin(p) % rotate2d (pi / &2) e = rotate2d p e`,
2026     SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
2027       FORALL_2; rotate2d; LAMBDA_BETA; DIMINDEX_2; ARITH; VECTOR_2] THEN
2028     REWRITE_TAC[SIN_PI2; COS_PI2] THEN REAL_ARITH_TAC) in
2029   GEN_GEOM_ORIGIN_TAC `v:real^3` ["e1"; "e2"; "e3"] THEN
2030   REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN
2031   REPEAT GEN_TAC THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
2032   GEN_REWRITE_TAC I [SWAP_EXISTS_THM] THEN
2033   EXISTS_TAC `(w dot (w1:real^3)) / (w dot w)` THEN
2034   GEN_REWRITE_TAC I [SWAP_EXISTS_THM] THEN
2035   EXISTS_TAC `(w dot (w2:real^3)) / (w dot w)` THEN
2036   GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN
2037   X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV
2038    [REAL_ARITH `&0 <= w <=> w = &0 \/ &0 < w`] THEN
2039   STRIP_TAC THENL
2040    [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_RZERO; NORM_0] THEN
2041     EXISTS_TAC `&0` THEN MP_TAC PI_POS THEN REAL_ARITH_TAC;
2042     ALL_TAC] THEN
2043   SIMP_TAC[DOT_LMUL; NORM_MUL; DIMINDEX_3; ARITH; DOT_RMUL; DOT_BASIS;
2044            VECTOR_MUL_COMPONENT; NORM_BASIS; BASIS_COMPONENT] THEN
2045   REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RID] THEN
2046   ASM_SIMP_TAC[REAL_FIELD `&0 < w ==> (w * x) / (w * w) * w = x`;
2047                REAL_ARITH `&0 < w ==> abs w = w`] THEN
2048   ASM_REWRITE_TAC[VECTOR_ARITH
2049     `a % x:real^3 = a % y <=> a % (x - y) = vec 0`] THEN
2050   ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ; BASIS_NONZERO;
2051                DIMINDEX_3; ARITH; VECTOR_SUB_EQ] THEN
2052   REWRITE_TAC[MESON[] `(!e3. p e3 /\ e3 = a ==> q e3) <=> p a ==> q a`] THEN
2053   ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^3 = a + b + c <=> x - c = a + b`] THEN
2054   REPEAT GEN_TAC THEN
2055   ABBREV_TAC `v1:real^3 = w1 - (w1$3) % basis 3` THEN
2056   ABBREV_TAC `v2:real^3 = w2 - (w2$3) % basis 3` THEN
2057   SUBGOAL_THEN
2058    `(collinear{vec 0, w % basis 3, w1} <=>
2059      w1 - w1$3 % basis 3:real^3 = vec 0) /\
2060     (collinear{vec 0, w % basis 3, w2} <=>
2061      w2 - w2$3 % basis 3:real^3 = vec 0)`
2062    (fun th -> REWRITE_TAC[th])
2063   THENL
2064    [ASM_SIMP_TAC[COLLINEAR_LEMMA; VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ;
2065                  BASIS_NONZERO; DIMINDEX_3; ARITH] THEN
2066     MAP_EVERY EXPAND_TAC ["v1"; "v2"] THEN
2067     SIMP_TAC[CART_EQ; VEC_COMPONENT; VECTOR_ADD_COMPONENT; FORALL_3;
2068              VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_3; ARITH;
2069              VECTOR_SUB_COMPONENT; REAL_MUL_RZERO; REAL_MUL_RID;
2070              REAL_SUB_RZERO] THEN
2071     REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
2072     CONV_TAC(BINOP_CONV(BINOP_CONV(ONCE_DEPTH_CONV SYM_CONV))) THEN
2073     ASM_SIMP_TAC[GSYM REAL_EQ_RDIV_EQ; EXISTS_REFL] THEN REAL_ARITH_TAC;
2074     ALL_TAC] THEN
2075   ASM_REWRITE_TAC[] THEN
2076   SUBGOAL_THEN `(v1:real^3)$3 = &0 /\ (v2:real^3)$3 = &0` MP_TAC THENL
2077    [MAP_EVERY EXPAND_TAC ["v1"; "v2"] THEN
2078     REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_SUB_EQ] THEN
2079     SIMP_TAC[BASIS_COMPONENT; DIMINDEX_3; ARITH] THEN REAL_ARITH_TAC;
2080     ALL_TAC] THEN
2081   MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`v2:real^3`; `v1:real^3`] THEN
2082   POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[orthonormal] THEN
2083   SIMP_TAC[DOT_BASIS; BASIS_COMPONENT; DIMINDEX_3; ARITH] THEN
2084   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e /\ f <=>
2085                          d /\ e /\ a /\ b /\ c /\ f`] THEN
2086   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
2087   PAD2D3D_TAC THEN REPEAT STRIP_TAC THEN
2088   SIMP_TAC[cross; VECTOR_3; pad2d3d; LAMBDA_BETA; DIMINDEX_3; ARITH] THEN
2089   REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
2090   ASM_CASES_TAC `v1:real^2 = vec 0` THEN ASM_REWRITE_TAC[NORM_POS_LT] THENL
2091    [MP_TAC(ISPECL [`basis 1:real^2`; `v2:real^2`]
2092       ROTATION_ROTATE2D_EXISTS_GEN) THEN
2093     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real` THEN
2094     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
2095     MP_TAC(ISPECL [`e1:real^2`; `basis 1:real^2`]
2096       ROTATION_ROTATE2D_EXISTS_GEN) THEN
2097     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:real` THEN STRIP_TAC THEN
2098     MAP_EVERY EXISTS_TAC [`&0`; `norm(v2:real^2)`] THEN
2099     ASM_REWRITE_TAC[NORM_POS_LT] THEN
2100     REWRITE_TAC[REAL_MUL_LZERO; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN
2101     SUBGOAL_THEN `norm(e1:real^2) = &1 /\ norm(e2:real^2) = &1`
2102     STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[NORM_EQ_1]; ALL_TAC] THEN
2103     SUBGOAL_THEN `e2 = rotate2d (pi / &2) e1` SUBST1_TAC THENL
2104      [MATCH_MP_TAC ROTATION_ROTATE2D_EXISTS_ORTHOGONAL_ORIENTED THEN
2105       ASM_REWRITE_TAC[NORM_EQ_1; orthogonal];
2106       ALL_TAC] THEN
2107     REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_LDISTRIB] THEN
2108     REWRITE_TAC[lemma] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
2109     REWRITE_TAC[ROTATE2D_ADD] THEN ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN
2110     MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN
2111     EXISTS_TAC `norm(basis 1:real^2)` THEN
2112     ASM_SIMP_TAC[NORM_EQ_0; BASIS_NONZERO; DIMINDEX_2; ARITH] THEN
2113     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN
2114     ONCE_REWRITE_TAC[VECTOR_ARITH `a % b % x:real^2 = b % a % x`] THEN
2115     AP_TERM_TAC THEN
2116     SIMP_TAC[GSYM(MATCH_MP LINEAR_CMUL (SPEC_ALL LINEAR_ROTATE2D))] THEN
2117     AP_TERM_TAC THEN
2118     ASM_SIMP_TAC[LINEAR_CMUL; LINEAR_ROTATE2D; VECTOR_MUL_LID];
2119     MP_TAC(ISPECL [`v1:real^2`; `v2:real^2`] ROTATION_ROTATE2D_EXISTS_GEN) THEN
2120     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real` THEN
2121     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
2122     MP_TAC(ISPECL [`e1:real^2`; `v1:real^2`] ROTATION_ROTATE2D_EXISTS_GEN) THEN
2123     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:real` THEN STRIP_TAC THEN
2124     MAP_EVERY EXISTS_TAC [`norm(v1:real^2)`; `norm(v2:real^2)`] THEN
2125     ASM_REWRITE_TAC[NORM_POS_LT] THEN
2126     SUBGOAL_THEN `norm(e1:real^2) = &1 /\ norm(e2:real^2) = &1`
2127     STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[NORM_EQ_1]; ALL_TAC] THEN
2128     SUBGOAL_THEN `e2 = rotate2d (pi / &2) e1` SUBST1_TAC THENL
2129      [MATCH_MP_TAC ROTATION_ROTATE2D_EXISTS_ORTHOGONAL_ORIENTED THEN
2130       ASM_REWRITE_TAC[NORM_EQ_1; orthogonal];
2131       ALL_TAC] THEN
2132     REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_LDISTRIB] THEN
2133     REWRITE_TAC[lemma] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
2134     REWRITE_TAC[ROTATE2D_ADD] THEN ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN
2135     MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `norm(v1:real^2)` THEN
2136     ASM_REWRITE_TAC[NORM_EQ_0] THEN
2137     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN
2138     ONCE_REWRITE_TAC[VECTOR_ARITH `a % b % x:real^2 = b % a % x`] THEN
2139     AP_TERM_TAC THEN
2140     SIMP_TAC[GSYM(MATCH_MP LINEAR_CMUL (SPEC_ALL LINEAR_ROTATE2D))] THEN
2141     AP_TERM_TAC THEN
2142     ASM_SIMP_TAC[LINEAR_CMUL; LINEAR_ROTATE2D; VECTOR_MUL_LID]]);;
2143
2144 let azim_spec =
2145    (REWRITE_RULE[SKOLEM_THM]
2146     (REWRITE_RULE[RIGHT_EXISTS_IMP_THM] AZIM_EXISTS));;
2147
2148 let azim_def = new_definition
2149   `azim v w w1 w2 =
2150         if collinear {v,w,w1} \/ collinear {v,w,w2} then &0
2151         else @theta. &0 <= theta /\ theta < &2 * pi /\
2152                      ?h1 h2.
2153                          !e1 e2 e3.
2154                             orthonormal e1 e2 e3 /\
2155                             dist(w,v) % e3 = w - v /\
2156                             ~(w = v)
2157                             ==> ?psi r1 r2.
2158                                     w1 - v = (r1 * cos psi) % e1 +
2159                                              (r1 * sin psi) % e2 +
2160                                              h1 % (w - v) /\
2161                                     w2 - v = (r2 * cos (psi + theta)) % e1 +
2162                                              (r2 * sin (psi + theta)) % e2 +
2163                                              h2 % (w - v) /\
2164                                     &0 < r1 /\ &0 < r2`;;
2165
2166 let azim = prove
2167  (`!v w w1 w2:real^3.
2168         &0 <= azim v w w1 w2 /\ azim v w w1 w2 < &2 * pi /\
2169         ?h1 h2.
2170            !e1 e2 e3.
2171               orthonormal e1 e2 e3 /\
2172               dist(w,v) % e3 = w - v /\
2173               ~(w = v)
2174               ==> ?psi r1 r2.
2175                       w1 - v = (r1 * cos psi) % e1 +
2176                                (r1 * sin psi) % e2 +
2177                                h1 % (w - v) /\
2178                       w2 - v = (r2 * cos (psi + azim v w w1 w2)) % e1 +
2179                                (r2 * sin (psi + azim v w w1 w2)) % e2 +
2180                                h2 % (w - v) /\
2181                       (~collinear {v, w, w1} ==> &0 < r1) /\
2182                       (~collinear {v, w, w2} ==> &0 < r2)`,
2183   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[azim_def] THEN
2184   COND_CASES_TAC THENL
2185    [ALL_TAC;
2186     RULE_ASSUM_TAC(REWRITE_RULE[DE_MORGAN_THM]) THEN ASM_REWRITE_TAC[] THEN
2187     CONV_TAC SELECT_CONV THEN
2188     MP_TAC(ISPECL [`v:real^3`; `w:real^3`; `w1:real^3`; `w2:real^3`]
2189         AZIM_EXISTS) THEN
2190     ASM_REWRITE_TAC[]] THEN
2191   SIMP_TAC[PI_POS; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH; REAL_LE_REFL] THEN
2192   FIRST_X_ASSUM DISJ_CASES_TAC THENL
2193    [MP_TAC(ISPECL [`v:real^3`; `w:real^3`; `w2:real^3`; `w1:real^3`]
2194      AZIM_EXISTS) THEN
2195     DISCH_THEN(CHOOSE_THEN(MP_TAC o CONJUNCT2 o CONJUNCT2)) THEN
2196     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
2197     MAP_EVERY X_GEN_TAC [`h2:real`; `h1:real`] THEN
2198     DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`h1:real`; `h2:real`] THEN
2199     MAP_EVERY X_GEN_TAC [`e1:real^3`; `e2:real^3`; `e3:real^3`] THEN
2200     STRIP_TAC THEN
2201     FIRST_X_ASSUM(MP_TAC o SPECL [`e1:real^3`; `e2:real^3`; `e3:real^3`]) THEN
2202     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
2203     X_GEN_TAC `psi:real` THEN
2204     REWRITE_TAC[LEFT_IMP_EXISTS_THM; REAL_ADD_RID] THEN
2205     MAP_EVERY X_GEN_TAC [`r2:real`; `r1:real`] THEN STRIP_TAC THEN
2206     MAP_EVERY EXISTS_TAC [`&0`; `r2:real`];
2207     MP_TAC(ISPECL [`v:real^3`; `w:real^3`; `w1:real^3`; `w2:real^3`]
2208        AZIM_EXISTS) THEN
2209     DISCH_THEN(CHOOSE_THEN(MP_TAC o CONJUNCT2 o CONJUNCT2)) THEN
2210     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
2211     MAP_EVERY X_GEN_TAC [`h1:real`; `h2:real`] THEN
2212     DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`h1:real`; `h2:real`] THEN
2213     MAP_EVERY X_GEN_TAC [`e1:real^3`; `e2:real^3`; `e3:real^3`] THEN
2214     STRIP_TAC THEN
2215     FIRST_X_ASSUM(MP_TAC o SPECL [`e1:real^3`; `e2:real^3`; `e3:real^3`]) THEN
2216     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
2217     X_GEN_TAC `psi:real` THEN
2218     REWRITE_TAC[LEFT_IMP_EXISTS_THM; REAL_ADD_RID] THEN
2219     MAP_EVERY X_GEN_TAC [`r1:real`; `r2:real`] THEN STRIP_TAC THEN
2220     MAP_EVERY EXISTS_TAC [`r1:real`; `&0`]] THEN
2221   ASM_REWRITE_TAC[] THEN
2222   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV
2223    [SET_RULE `{v,w,x} = {w,v,x}`]) THEN
2224   ONCE_REWRITE_TAC[COLLINEAR_3] THEN ASM_REWRITE_TAC[] THEN
2225   UNDISCH_THEN `dist(w:real^3,v) % e3 = w - v` (SUBST1_TAC o SYM) THEN
2226   REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL] THEN
2227   RULE_ASSUM_TAC(REWRITE_RULE[orthonormal]) THEN
2228   ASM_REWRITE_TAC[DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL; REAL_MUL_RZERO] THEN
2229   ONCE_REWRITE_TAC[DOT_SYM] THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN
2230   REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_RID] THEN
2231   REWRITE_TAC[REAL_ARITH `(r * c) * (r * c):real = r pow 2 * c pow 2`] THEN
2232   REWRITE_TAC[REAL_ARITH `r * c + r * s + f:real = r * (s + c) + f`] THEN
2233   REWRITE_TAC[SIN_CIRCLE] THEN REWRITE_TAC[REAL_RING
2234    `(d * h * d) pow 2 = (d * d) * (r * &1 + h * d * h * d) <=>
2235     d = &0 \/ r = &0`] THEN
2236   ASM_REWRITE_TAC[DIST_EQ_0; REAL_POW_EQ_0; ARITH] THEN
2237   DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; DOT_LZERO]);;
2238
2239 let AZIM_UNIQUE = prove
2240  (`!v w w1 w2 h1 h2 r1 r2 e1 e2 e3 psi theta.
2241         &0 <= theta /\
2242         theta < &2 * pi /\
2243         orthonormal e1 e2 e3 /\
2244         dist(w,v) % e3 = w - v /\
2245         ~(w = v) /\
2246         &0 < r1 /\ &0 < r2 /\
2247         w1 - v = (r1 * cos psi) % e1 +
2248                  (r1 * sin psi) % e2 +
2249                  h1 % (w - v) /\
2250         w2 - v = (r2 * cos (psi + theta)) % e1 +
2251                  (r2 * sin (psi + theta)) % e2 +
2252                  h2 % (w - v)
2253         ==> azim v w w1 w2 = theta`,
2254   REPEAT STRIP_TAC THEN
2255   SUBGOAL_THEN `~collinear{v:real^3,w,w2} /\ ~collinear {v,w,w1}`
2256   STRIP_ASSUME_TAC THENL
2257    [ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,a,c}`] THEN
2258     ONCE_REWRITE_TAC[COLLINEAR_3] THEN REWRITE_TAC[COLLINEAR_LEMMA] THEN
2259     ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[VECTOR_SUB_EQ] THEN
2260     UNDISCH_THEN `dist(w:real^3,v) % e3 = w - v` (SUBST1_TAC o SYM) THEN
2261     REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH
2262      `a + b + c % x:real^N = d % x <=> a + b + (c - d) % x = vec 0`] THEN
2263     ASM_SIMP_TAC[ORTHONORMAL_IMP_INDEPENDENT_EXPLICIT_0] THEN
2264     ASM_SIMP_TAC[CONJ_ASSOC; REAL_LT_IMP_NZ; SIN_CIRCLE; REAL_RING
2265      `s pow 2 + c pow 2 = &1 ==> (r * c = &0 /\ r * s = &0 <=> r = &0)`];
2266     ALL_TAC] THEN
2267   SUBGOAL_THEN `(azim v w w1 w2 - theta) / (&2 * pi) = &0` MP_TAC THENL
2268    [ALL_TAC; MP_TAC PI_POS THEN CONV_TAC REAL_FIELD] THEN
2269   MATCH_MP_TAC REAL_EQ_INTEGERS_IMP THEN
2270   ASM_SIMP_TAC[REAL_SUB_RZERO; REAL_ABS_DIV; REAL_ABS_MUL; REAL_ABS_NUM;
2271        REAL_ABS_PI; REAL_LT_LDIV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH;
2272        PI_POS; INTEGER_CLOSED; REAL_MUL_LID] THEN
2273   MP_TAC(ISPECL [`v:real^3`; `w:real^3`; `w1:real^3`; `w2:real^3`] azim) THEN
2274   ASM_REWRITE_TAC[] THEN
2275   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
2276   ASM_SIMP_TAC[REAL_ARITH
2277    `&0 <= x /\ x < k /\ &0 <= y /\ y < k ==> abs(x - y) < k`] THEN
2278   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
2279   MAP_EVERY X_GEN_TAC [`k1:real`; `k2:real`] THEN
2280   DISCH_THEN(MP_TAC o SPECL [`e1:real^3`; `e2:real^3`; `e3:real^3`]) THEN
2281   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
2282   MAP_EVERY X_GEN_TAC [`phi:real`; `s1:real`; `s2:real`] THEN
2283   UNDISCH_THEN `dist(w:real^3,v) % e3 = w - v` (SUBST1_TAC o SYM) THEN
2284   REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
2285   ASM_SIMP_TAC[ORTHONORMAL_IMP_INDEPENDENT_EXPLICIT] THEN
2286   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> (c /\ d) /\ a /\ b`] THEN
2287   DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
2288   DISCH_THEN(CONJUNCTS_THEN (MP_TAC o MATCH_MP (REAL_FIELD
2289    `r * c = r' * c' /\ r * s = r' * s' /\ u:real = v
2290     ==> s pow 2 + c pow 2 = &1 /\ s' pow 2 + c' pow 2 = &1 /\
2291         &0 < r /\ (r pow 2 = r' pow 2 ==> r = r')
2292         ==> s = s' /\ c = c'`))) THEN
2293   ASM_REWRITE_TAC[SIN_CIRCLE; GSYM REAL_EQ_SQUARE_ABS] THEN
2294   ASM_SIMP_TAC[REAL_ARITH
2295    `&0 < x /\ &0 < y ==> (abs x = abs y <=> x = y)`] THEN
2296   REWRITE_TAC[SIN_COS_EQ] THEN
2297   REWRITE_TAC[REAL_ARITH
2298    `psi + theta = (phi + az) + x:real <=> psi = phi + x + (az - theta)`] THEN
2299   DISCH_THEN(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN
2300   ASM_REWRITE_TAC[REAL_EQ_ADD_LCANCEL] THEN
2301   REWRITE_TAC[REAL_ARITH
2302    `&2 * m * pi + x = &2 * n * pi <=> x = (n - m) * &2 * pi`] THEN
2303   DISCH_THEN(X_CHOOSE_THEN `n:real` STRIP_ASSUME_TAC) THEN
2304   ASM_SIMP_TAC[PI_POS; REAL_FIELD `&0 < pi ==> (x * &2 * pi) / (&2 * pi) = x`;
2305                INTEGER_CLOSED]);;
2306
2307 let AZIM_TRANSLATION = prove
2308  (`!a v w w1 w2. azim (a + v) (a + w) (a + w1) (a + w2) = azim v w w1 w2`,
2309   REPEAT GEN_TAC THEN REWRITE_TAC[azim_def] THEN
2310   REWRITE_TAC[VECTOR_ARITH `(a + w) - (a + v):real^3 = w - v`;
2311               VECTOR_ARITH `a + w:real^3 = a + v <=> w = v`;
2312               NORM_ARITH `dist(a + v,a + w) = dist(v,w)`] THEN
2313   REWRITE_TAC[SET_RULE
2314    `{a + x,a + y,a + z} = IMAGE (\x:real^3. a + x) {x,y,z}`] THEN
2315   REWRITE_TAC[COLLINEAR_TRANSLATION_EQ]);;
2316
2317 add_translation_invariants [AZIM_TRANSLATION];;
2318
2319 let AZIM_LINEAR_IMAGE = prove
2320  (`!f. linear f /\ (!x. norm(f x) = norm x) /\
2321        (2 <= dimindex(:3) ==> det(matrix f) = &1)
2322        ==> !v w w1 w2. azim (f v) (f w) (f w1) (f w2) = azim v w w1 w2`,
2323   REPEAT STRIP_TAC THEN REWRITE_TAC[azim_def] THEN
2324   ASM_SIMP_TAC[GSYM LINEAR_SUB; dist] THEN
2325   MP_TAC(ISPEC `f:real^3->real^3` QUANTIFY_SURJECTION_THM) THEN
2326   ANTS_TAC THENL
2327    [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION;
2328                   ORTHOGONAL_TRANSFORMATION_SURJECTIVE];
2329     ALL_TAC] THEN
2330   DISCH_THEN(CONV_TAC o LAND_CONV o EXPAND_QUANTS_CONV) THEN
2331   ASM_SIMP_TAC[ORTHONORMAL_LINEAR_IMAGE] THEN
2332   ASM_SIMP_TAC[GSYM LINEAR_CMUL; GSYM LINEAR_ADD] THEN
2333   SUBGOAL_THEN `!x y. (f:real^3->real^3) x = f y <=> x = y` ASSUME_TAC THENL
2334    [ASM_MESON_TAC[PRESERVES_NORM_INJECTIVE]; ALL_TAC] THEN
2335   ASM_REWRITE_TAC[] THEN
2336   REWRITE_TAC[SET_RULE `{f x,f y,f z} = IMAGE f {x,y,z}`] THEN
2337   ASM_SIMP_TAC[COLLINEAR_LINEAR_IMAGE_EQ]);;
2338
2339 add_linear_invariants [AZIM_LINEAR_IMAGE];;
2340
2341 let AZIM_DEGENERATE = prove
2342  (`(!v w w1 w2. v = w ==> azim v w w1 w2 = &0) /\
2343    (!v w w1 w2. collinear{v,w,w1} ==> azim v w w1 w2 = &0) /\
2344    (!v w w1 w2. collinear{v,w,w2} ==> azim v w w1 w2 = &0)`,
2345   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[azim_def] THEN
2346   ASM_REWRITE_TAC[] THEN REWRITE_TAC[INSERT_AC; COLLINEAR_2]);;
2347
2348 let AZIM_REFL_ALT = prove
2349  (`!v x y. azim v v x y = &0`,
2350   REPEAT GEN_TAC THEN MATCH_MP_TAC(last(CONJUNCTS AZIM_DEGENERATE)) THEN
2351   REWRITE_TAC[COLLINEAR_2; INSERT_AC]);;
2352
2353 let AZIM_SPECIAL_SCALE = prove
2354  (`!a v w1 w2.
2355         &0 < a
2356         ==> azim (vec 0) (a % v) w1 w2 = azim (vec 0) v w1 w2`,
2357   REPEAT STRIP_TAC THEN REWRITE_TAC[azim_def] THEN
2358   REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN
2359   FIRST_ASSUM(MP_TAC o MATCH_MP(MESON[REAL_LT_IMP_NZ; REAL_DIV_LMUL]
2360    `!a. &0 < a ==> (!y. ?x. a * x = y)`)) THEN
2361   DISCH_THEN(MP_TAC o MATCH_MP QUANTIFY_SURJECTION_THM) THEN
2362   DISCH_THEN(CONV_TAC o RAND_CONV o
2363     PARTIAL_EXPAND_QUANTS_CONV ["psi"; "r1"; "r2"]) THEN
2364   REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_SYM] THEN
2365   ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN
2366   ASM_SIMP_TAC[NORM_MUL; REAL_ARITH `&0 < a ==> abs a = a`] THEN
2367   REWRITE_TAC[GSYM VECTOR_MUL_ASSOC] THEN
2368   REWRITE_TAC[VECTOR_ARITH `a % x:real^3 = a % y <=> a % (x - y) = vec 0`] THEN
2369   ASM_SIMP_TAC[REAL_LT_IMP_NZ; VECTOR_MUL_EQ_0] THEN
2370   REWRITE_TAC[VECTOR_SUB_EQ] THEN
2371   ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE; REAL_LT_IMP_NZ]);;
2372
2373 let AZIM_SCALE_ALL = prove
2374  (`!a v w1 w2.
2375         &0 < a /\ &0 < b /\ &0 < c
2376         ==> azim (vec 0) (a % v) (b % w1) (c % w2) = azim (vec 0) v w1 w2`,
2377   let lemma = MESON[REAL_LT_IMP_NZ; REAL_DIV_LMUL]
2378    `!a. &0 < a ==> (!y. ?x. a * x = y)` in
2379   let SCALE_QUANT_TAC side asm avoid =
2380     MP_TAC(MATCH_MP lemma (ASSUME asm)) THEN
2381     DISCH_THEN(MP_TAC o MATCH_MP QUANTIFY_SURJECTION_THM) THEN
2382     DISCH_THEN(CONV_TAC o side o PARTIAL_EXPAND_QUANTS_CONV avoid) in
2383   REPEAT STRIP_TAC THEN
2384   ASM_SIMP_TAC[azim_def; COLLINEAR_SCALE_ALL; REAL_LT_IMP_NZ] THEN
2385   COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_SUB_RZERO] THEN
2386   ASM_SIMP_TAC[DIST_0; NORM_MUL; GSYM VECTOR_MUL_ASSOC] THEN
2387   ASM_SIMP_TAC[REAL_ARITH `&0 < a ==> abs a = a`; VECTOR_MUL_LCANCEL] THEN
2388   ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN
2389   SCALE_QUANT_TAC RAND_CONV `&0 < a`  ["psi"; "r1"; "r2"] THEN
2390   SCALE_QUANT_TAC LAND_CONV `&0 < b`  ["psi"; "h2"; "r2"] THEN
2391   SCALE_QUANT_TAC LAND_CONV `&0 < c`  ["psi"; "h1"; "r1"] THEN
2392   ASM_SIMP_TAC[GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_LDISTRIB;
2393                VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; REAL_LT_MUL_EQ] THEN
2394   REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_AC]);;
2395
2396 let AZIM_ARG = prove
2397  (`!x y:real^3. azim (vec 0) (basis 3) x y = Arg(dropout 3 y / dropout 3 x)`,
2398   let lemma = prove
2399    (`(r * cos t) % basis 1 + (r * sin t) % basis 2 = Cx r * cexp(ii * Cx t)`,
2400     REWRITE_TAC[CEXP_EULER; COMPLEX_BASIS; GSYM CX_SIN; GSYM CX_COS;
2401                 COMPLEX_CMUL; CX_MUL] THEN
2402     CONV_TAC COMPLEX_RING) in
2403   REPEAT STRIP_TAC THEN
2404   ASM_CASES_TAC `collinear {vec 0:real^3,basis 3,x}` THENL
2405    [ASM_SIMP_TAC[AZIM_DEGENERATE] THEN
2406     RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN
2407     ASM_REWRITE_TAC[COMPLEX_VEC_0; complex_div; COMPLEX_INV_0;
2408                     COMPLEX_MUL_RZERO; ARG_0];
2409     ALL_TAC] THEN
2410   ASM_CASES_TAC `collinear {vec 0:real^3,basis 3,y}` THENL
2411    [ASM_SIMP_TAC[AZIM_DEGENERATE] THEN
2412     RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN
2413     ASM_REWRITE_TAC[COMPLEX_VEC_0; complex_div; COMPLEX_MUL_LZERO; ARG_0];
2414     ALL_TAC] THEN
2415   MP_TAC(ISPECL [`vec 0:real^3`; `basis 3:real^3`; `x:real^3`; `y:real^3`]
2416         azim) THEN
2417   ABBREV_TAC `a = azim (vec 0) (basis 3) x (y:real^3)` THEN
2418   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
2419   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; VECTOR_SUB_RZERO; DIST_0] THEN
2420   MAP_EVERY X_GEN_TAC [`h1:real`; `h2:real`] THEN
2421   DISCH_THEN(MP_TAC o SPECL
2422    [`basis 1:real^3`; `basis 2:real^3`; `basis 3:real^3`]) THEN
2423   SIMP_TAC[orthonormal; DOT_BASIS_BASIS; CROSS_BASIS; DIMINDEX_3; NORM_BASIS;
2424     ARITH; VECTOR_MUL_LID; BASIS_NONZERO; REAL_LT_01; LEFT_IMP_EXISTS_THM] THEN
2425   MAP_EVERY X_GEN_TAC [`psi:real`; `r1:real`; `r2:real`] THEN
2426   DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
2427   REWRITE_TAC[DROPOUT_ADD; DROPOUT_MUL; DROPOUT_BASIS_3] THEN
2428   REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID; lemma] THEN
2429   REWRITE_TAC[complex_div; COMPLEX_INV_MUL] THEN
2430   ONCE_REWRITE_TAC[COMPLEX_RING
2431    `(a * b) * (c * d):complex = (a * c) * b * d`] THEN
2432   REWRITE_TAC[GSYM complex_div; GSYM CX_DIV; GSYM CEXP_SUB] THEN
2433   CONV_TAC SYM_CONV THEN MATCH_MP_TAC ARG_UNIQUE THEN
2434   EXISTS_TAC `r2 / r1:real` THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN
2435   AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CX_ADD] THEN
2436   CONV_TAC COMPLEX_RING);;
2437
2438 let REAL_CONTINUOUS_AT_AZIM_SHARP = prove
2439  (`!v w w1 w2.
2440         ~collinear{v,w,w1} /\ ~(w2 IN aff_ge {v,w} {w1})
2441         ==> (azim v w w1) real_continuous at w2`,
2442   GEOM_ORIGIN_TAC `v:real^3` THEN
2443   GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN
2444   X_GEN_TAC `w:real` THEN ASM_CASES_TAC `w = &0` THENL
2445    [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
2446   ASM_SIMP_TAC[REAL_LE_LT; COLLINEAR_SPECIAL_SCALE] THEN
2447   DISCH_TAC THEN REPEAT GEN_TAC THEN
2448   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
2449   W(MP_TAC o PART_MATCH (lhs o rand) AFF_GE_SPECIAL_SCALE o
2450     rand o rand o lhand o snd) THEN
2451   ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; IN_SING] THEN ANTS_TAC THENL
2452    [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
2453     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM] THEN
2454     DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THENL
2455      [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC];
2456       ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC];
2457       ASM_SIMP_TAC[COLLINEAR_LEMMA_ALT; BASIS_NONZERO; DIMINDEX_3; ARITH] THEN
2458       MESON_TAC[]];
2459     DISCH_THEN SUBST1_TAC THEN DISCH_TAC] THEN
2460   ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; AZIM_ARG] THEN
2461   MATCH_MP_TAC(REWRITE_RULE[o_DEF]
2462     REAL_CONTINUOUS_CONTINUOUS_AT_COMPOSE) THEN
2463   CONJ_TAC THENL
2464    [REWRITE_TAC[complex_div] THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_MUL THEN
2465     REWRITE_TAC[CONTINUOUS_CONST; ETA_AX] THEN
2466     SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_DROPOUT; DIMINDEX_3; DIMINDEX_2;
2467              ARITH];
2468     ALL_TAC] THEN
2469   MATCH_MP_TAC REAL_CONTINUOUS_AT_WITHIN THEN
2470   MATCH_MP_TAC REAL_CONTINUOUS_AT_ARG THEN
2471   MP_TAC(ISPECL [`w2:real^3`; `w1:real^3`] AFF_GE_2_1_0_DROPOUT_3) THEN
2472   ASM_REWRITE_TAC[] THEN
2473   REPEAT(FIRST_X_ASSUM(MP_TAC o
2474     GEN_REWRITE_RULE RAND_CONV [COLLINEAR_BASIS_3])) THEN
2475   SPEC_TAC(`(dropout 3:real^3->real^2) w2`,`v2:real^2`) THEN
2476   SPEC_TAC(`(dropout 3:real^3->real^2) w1`,`v1:real^2`) THEN
2477   POP_ASSUM_LIST(K ALL_TAC) THEN
2478   GEOM_BASIS_MULTIPLE_TAC 1 `v1:complex` THEN
2479   X_GEN_TAC `w:real` THEN ASM_CASES_TAC `w = &0` THEN
2480   ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
2481   GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_REWRITE_TAC[] THEN
2482   DISCH_TAC THEN X_GEN_TAC `z:complex` THEN
2483   DISCH_THEN(K ALL_TAC) THEN
2484   REWRITE_TAC[CONTRAPOS_THM; COMPLEX_BASIS; COMPLEX_CMUL] THEN
2485   REWRITE_TAC[COMPLEX_MUL_RID; RE_DIV_CX; IM_DIV_CX; real] THEN
2486   ASM_SIMP_TAC[REAL_DIV_EQ_0; REAL_LE_RDIV_EQ; REAL_MUL_LZERO] THEN
2487   STRIP_TAC THEN
2488   W(MP_TAC o PART_MATCH (lhs o rand) AFF_GE_1_1_0 o rand o snd) THEN
2489   ASM_REWRITE_TAC[COMPLEX_VEC_0; CX_INJ] THEN DISCH_THEN SUBST1_TAC THEN
2490   REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `Re z / w` THEN
2491   ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_IMP_LE; COMPLEX_EQ] THEN
2492   ASM_SIMP_TAC[COMPLEX_CMUL; CX_DIV; COMPLEX_DIV_RMUL; CX_INJ] THEN
2493   REWRITE_TAC[RE_CX; IM_CX]);;
2494
2495 let REAL_CONTINUOUS_AT_AZIM = prove
2496  (`!v w w1 w2. ~coplanar{v,w,w1,w2} ==> (azim v w w1) real_continuous at w2`,
2497   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_AT_AZIM_SHARP THEN
2498   CONJ_TAC THENL
2499    [ASM_MESON_TAC[NOT_COPLANAR_NOT_COLLINEAR; INSERT_AC];
2500     DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET]
2501        AFF_GE_SUBSET_AFFINE_HULL)) THEN
2502     POP_ASSUM MP_TAC THEN REWRITE_TAC[coplanar; CONTRAPOS_THM] THEN
2503     REWRITE_TAC[SET_RULE `{a,b} UNION {c} = {a,b,c}`] THEN
2504     DISCH_TAC THEN MAP_EVERY EXISTS_TAC
2505      [`v:real^3`; `w:real^3`; `w1:real^3`] THEN
2506     SIMP_TAC[SET_RULE `{a,b,c,d} SUBSET s <=> {a,b,c} SUBSET s /\ d IN s`] THEN
2507     ASM_REWRITE_TAC[HULL_SUBSET]]);;
2508
2509 let AZIM_REFL = prove
2510  (`!v0 v1 w. azim v0 v1 w w = &0`,
2511   GEOM_ORIGIN_TAC `v0:real^3` THEN
2512   GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN
2513   GEN_TAC THEN
2514   GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN
2515   STRIP_TAC THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO; AZIM_DEGENERATE] THEN
2516   ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; AZIM_ARG; ARG_EQ_0] THEN
2517   X_GEN_TAC `w:real^3` THEN
2518   ASM_CASES_TAC `(dropout 3 :real^3->real^2) w = Cx(&0)` THEN
2519   ASM_SIMP_TAC[COMPLEX_DIV_REFL; REAL_CX; RE_CX; REAL_POS] THEN
2520   ASM_SIMP_TAC[complex_div; COMPLEX_MUL_LZERO; REAL_CX; RE_CX; REAL_POS]);;
2521
2522 let AZIM_EQ = prove
2523  (`!v0 v1 w x y.
2524         ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x} /\ ~collinear{v0,v1,y}
2525         ==> (azim v0 v1 w x = azim v0 v1 w y <=> y IN aff_gt {v0,v1} {x})`,
2526   GEOM_ORIGIN_TAC `v0:real^3` THEN
2527   GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN
2528   GEN_TAC THEN
2529   GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN
2530   STRIP_TAC THENL
2531    [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
2532   ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; REAL_LT_IMP_NZ; COLLINEAR_SPECIAL_SCALE] THEN
2533   REPEAT STRIP_TAC THEN
2534   W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_SPECIAL_SCALE o
2535     rand o rand o snd) THEN
2536   ANTS_TAC THENL
2537    [ASM_REWRITE_TAC[IN_INSERT; FINITE_INSERT; FINITE_EMPTY; NOT_IN_EMPTY] THEN
2538     REPEAT CONJ_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
2539     TRY(RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC; COLLINEAR_2]) THEN
2540         FIRST_X_ASSUM CONTR_TAC) THEN
2541     UNDISCH_TAC `~collinear {vec 0:real^3, basis 3, v1 % basis 3}` THEN
2542     REWRITE_TAC[COLLINEAR_LEMMA] THEN MESON_TAC[];
2543     DISCH_THEN SUBST1_TAC] THEN
2544   REWRITE_TAC[AZIM_ARG] THEN CONV_TAC(LAND_CONV SYM_CONV) THEN
2545   W(MP_TAC o PART_MATCH (lhs o rand) ARG_EQ o lhand o snd) THEN
2546   RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN
2547   ASM_REWRITE_TAC[complex_div; COMPLEX_ENTIRE; COMPLEX_INV_EQ_0] THEN
2548   ASM_REWRITE_TAC[GSYM complex_div; GSYM COMPLEX_VEC_0] THEN
2549   DISCH_THEN SUBST1_TAC THEN
2550   ASM_SIMP_TAC[GSYM COMPLEX_VEC_0; COMPLEX_FIELD
2551     `~(w = Cx(&0)) ==> (y / w = x * u / w <=> y = x * u)`] THEN
2552   W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_2_1 o rand o rand o snd) THEN
2553   ANTS_TAC THENL
2554    [REWRITE_TAC[SET_RULE `DISJOINT {a,b} {x} <=> ~(x = a) /\ ~(x = b)`] THEN
2555     ASM_MESON_TAC[DROPOUT_BASIS_3; DROPOUT_0];
2556     DISCH_THEN SUBST1_TAC] THEN
2557   REWRITE_TAC[IN_ELIM_THM; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
2558   ONCE_REWRITE_TAC[MESON[]
2559    `(?a b c. p c /\ q a b c /\ r b c) <=>
2560     (?c. p c /\ ?b. r b c /\ ?a. q a b c)`] THEN
2561   SIMP_TAC[REAL_ARITH `a + b + c = &1 <=> a = &1 - b - c`; EXISTS_REFL] THEN
2562   AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN
2563   X_GEN_TAC `t:real` THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN
2564   REWRITE_TAC[GSYM COMPLEX_CMUL] THEN
2565   SIMP_TAC[CART_EQ; FORALL_2; FORALL_3; DIMINDEX_2; DIMINDEX_3;
2566            dropout; LAMBDA_BETA; BASIS_COMPONENT; ARITH; REAL_MUL_RID;
2567            VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RZERO; UNWIND_THM1;
2568            VECTOR_ADD_COMPONENT; REAL_ADD_LID; RIGHT_EXISTS_AND_THM] THEN
2569   REWRITE_TAC[REAL_ARITH `y:real = t + z <=> t = y - z`; EXISTS_REFL]);;
2570
2571 let AZIM_EQ_ALT = prove
2572  (`!v0 v1 w x y.
2573         ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x} /\ ~collinear{v0,v1,y}
2574         ==> (azim v0 v1 w x = azim v0 v1 w y <=> x IN aff_gt {v0,v1} {y})`,
2575   ASM_SIMP_TAC[GSYM AZIM_EQ] THEN MESON_TAC[]);;
2576
2577 let AZIM_EQ_0 = prove
2578  (`!v0 v1 w x.
2579         ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x}
2580         ==> (azim v0 v1 w x = &0 <=> w IN aff_gt {v0,v1} {x})`,
2581   REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
2582   EXISTS_TAC `azim v0 v1 w x = azim v0 v1 w w` THEN CONJ_TAC THENL
2583    [REWRITE_TAC[AZIM_REFL];
2584     ASM_SIMP_TAC[AZIM_EQ]]);;
2585
2586 let AZIM_EQ_0_ALT = prove
2587  (`!v0 v1 w x.
2588         ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x}
2589         ==> (azim v0 v1 w x = &0 <=> x IN aff_gt {v0,v1} {w})`,
2590   REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
2591   EXISTS_TAC `azim v0 v1 w x = azim v0 v1 w w` THEN CONJ_TAC THENL
2592    [REWRITE_TAC[AZIM_REFL];
2593     ASM_SIMP_TAC[AZIM_EQ_ALT]]);;
2594
2595 let AZIM_EQ_0_GE = prove
2596  (`!v0 v1 w x.
2597         ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x}
2598         ==> (azim v0 v1 w x = &0 <=> w IN aff_ge {v0,v1} {x})`,
2599   REPEAT GEN_TAC THEN
2600   ASM_CASES_TAC `v1:real^3 = v0` THENL
2601    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; STRIP_TAC] THEN
2602   W(MP_TAC o PART_MATCH (lhs o rand) AFF_GE_AFF_GT_DECOMP o
2603       rand o rand o snd) THEN
2604   ANTS_TAC THENL
2605    [SIMP_TAC[FINITE_INSERT; FINITE_EMPTY; DISJOINT_INSERT; DISJOINT_EMPTY] THEN
2606     REWRITE_TAC[IN_SING] THEN
2607     CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN
2608     RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_2; INSERT_AC]) THEN
2609     FIRST_ASSUM CONTR_TAC;
2610     DISCH_THEN SUBST1_TAC] THEN
2611   ASM_SIMP_TAC[AZIM_EQ_0] THEN
2612   REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; UNIONS_1] THEN
2613   REWRITE_TAC[SET_RULE `{x} DELETE x = {}`] THEN
2614   REWRITE_TAC[AFF_GE_EQ_AFFINE_HULL; IN_UNION] THEN
2615   ASM_SIMP_TAC[GSYM COLLINEAR_3_AFFINE_HULL]);;
2616
2617 let AZIM_COMPL_EQ_0 = prove
2618  (`!z w w1 w2.
2619         ~collinear {z,w,w1} /\ ~collinear {z,w,w2} /\ azim z w w1 w2 = &0
2620         ==> azim z w w2 w1 = &0`,
2621   REWRITE_TAC[IMP_CONJ] THEN
2622   GEOM_ORIGIN_TAC `z:real^3` THEN
2623   GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN
2624   X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN
2625   ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[] THENL
2626    [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
2627   DISCH_TAC THEN REPEAT GEN_TAC THEN
2628   ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE; AZIM_ARG] THEN
2629   REWRITE_TAC[ARG_EQ_0; real; IM_COMPLEX_DIV_EQ_0; RE_COMPLEX_DIV_GE_0] THEN
2630   REWRITE_TAC[complex_mul; RE; IM; cnj] THEN REAL_ARITH_TAC);;
2631
2632 let AZIM_COMPL = prove
2633  (`!z w w1 w2.
2634         ~collinear {z,w,w1} /\ ~collinear {z,w,w2}
2635         ==> azim z w w2 w1 = if azim z w w1 w2 = &0 then &0
2636                              else &2 * pi - azim z w w1 w2`,
2637   REPEAT GEN_TAC THEN COND_CASES_TAC THENL
2638    [ASM_MESON_TAC[AZIM_COMPL_EQ_0]; ALL_TAC] THEN
2639   DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN MP_TAC th) THEN
2640   GEOM_ORIGIN_TAC `z:real^3` THEN
2641   GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN
2642   X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN
2643   ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[] THENL
2644    [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
2645   DISCH_TAC THEN REPEAT GEN_TAC THEN
2646   ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE; AZIM_ARG] THEN
2647   REWRITE_TAC[COLLINEAR_BASIS_3] THEN REWRITE_TAC[ARG_EQ_0] THEN
2648   REPEAT STRIP_TAC THEN
2649   MP_TAC(ISPEC `(dropout 3:real^3->real^2) w2 /
2650                 (dropout 3:real^3->real^2) w1` ARG_INV) THEN
2651   ASM_REWRITE_TAC[COMPLEX_INV_DIV]);;
2652
2653 let AZIM_EQ_PI_SYM = prove
2654  (`!z w w1 w2.
2655         ~collinear {z, w, w1} /\ ~collinear {z, w, w2}
2656         ==> (azim z w w1 w2 = pi <=> azim z w w2 w1 = pi)`,
2657   REPEAT STRIP_TAC THEN
2658   W(MP_TAC o PART_MATCH (lhs o rand) AZIM_COMPL o lhand o rand o snd) THEN
2659   ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);;
2660
2661 let AZIM_EQ_0_SYM = prove
2662  (`!z w w1 w2.
2663         ~collinear {z, w, w1} /\ ~collinear {z, w, w2}
2664         ==> (azim z w w1 w2 = &0 <=> azim z w w2 w1 = &0)`,
2665   MESON_TAC[AZIM_COMPL_EQ_0]);;
2666
2667 let AZIM_EQ_0_GE_ALT = prove
2668  (`!v0 v1 w x.
2669         ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x}
2670         ==> (azim v0 v1 w x = &0 <=> x IN aff_ge {v0,v1} {w})`,
2671   ASM_MESON_TAC[AZIM_EQ_0_SYM; AZIM_EQ_0_GE]);;
2672
2673 let AZIM_EQ_PI = prove
2674  (`!v0 v1 w x.
2675         ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x}
2676         ==> (azim v0 v1 w x = pi <=> w IN aff_lt {v0,v1} {x})`,
2677   GEOM_ORIGIN_TAC `v0:real^3` THEN
2678   GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN
2679   GEN_TAC THEN
2680   GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN
2681   STRIP_TAC THENL
2682    [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
2683   ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; REAL_LT_IMP_NZ;
2684                COLLINEAR_SPECIAL_SCALE] THEN
2685   REPEAT STRIP_TAC THEN
2686   W(MP_TAC o PART_MATCH (lhs o rand) AFF_LT_SPECIAL_SCALE o
2687     rand o rand o snd) THEN
2688   ANTS_TAC THENL
2689    [ASM_REWRITE_TAC[IN_INSERT; FINITE_INSERT; FINITE_EMPTY; NOT_IN_EMPTY] THEN
2690     REPEAT CONJ_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
2691     TRY(RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC; COLLINEAR_2]) THEN
2692         FIRST_X_ASSUM CONTR_TAC) THEN
2693     UNDISCH_TAC `~collinear {vec 0:real^3, basis 3, v1 % basis 3}` THEN
2694     REWRITE_TAC[COLLINEAR_LEMMA] THEN MESON_TAC[];
2695     DISCH_THEN SUBST1_TAC] THEN
2696   REWRITE_TAC[AZIM_ARG] THEN CONV_TAC(LAND_CONV SYM_CONV) THEN
2697   CONV_TAC(LAND_CONV SYM_CONV) THEN REWRITE_TAC[ARG_EQ_PI] THEN
2698   MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
2699   `(dropout 3 (w:real^3)) IN aff_lt {vec 0:real^2} {dropout 3 (x:real^3)}` THEN
2700   CONJ_TAC THENL
2701    [REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[COLLINEAR_BASIS_3] THEN
2702     SPEC_TAC(`(dropout 3:real^3->real^2) x`,`y:complex`) THEN
2703     SPEC_TAC(`(dropout 3:real^3->real^2) w`,`v:complex`) THEN
2704     GEOM_BASIS_MULTIPLE_TAC 1 `v:complex` THEN
2705     X_GEN_TAC `v:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN
2706     ASM_CASES_TAC `v = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
2707     REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN
2708     SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID] THEN
2709     REWRITE_TAC[real; RE_DIV_CX; IM_DIV_CX; CX_INJ] THEN
2710     ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_EQ_LDIV_EQ; REAL_MUL_LZERO] THEN
2711     REPEAT STRIP_TAC THEN
2712     W(MP_TAC o PART_MATCH (lhs o rand) AFF_LT_1_1 o rand o rand o snd) THEN
2713     ASM_REWRITE_TAC[DISJOINT_INSERT; DISJOINT_EMPTY; IN_SING] THEN
2714     DISCH_THEN SUBST1_TAC THEN
2715     REWRITE_TAC[COMPLEX_CMUL; IN_ELIM_THM; COMPLEX_MUL_RZERO] THEN
2716     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
2717     REWRITE_TAC[REAL_ARITH `t1 + t2 = &1 <=> t1 = &1 - t2`] THEN
2718     REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2; COMPLEX_ADD_LID] THEN
2719     EQ_TAC THENL
2720      [REWRITE_TAC[GSYM real; REAL] THEN
2721       DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) ASSUME_TAC) THEN
2722       EXISTS_TAC `v / Re y` THEN REWRITE_TAC[GSYM CX_MUL; CX_INJ] THEN
2723       CONJ_TAC THENL
2724        [ALL_TAC; REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD];
2725       DISCH_THEN(X_CHOOSE_THEN `t:real`
2726        (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
2727       ASM_SIMP_TAC[CX_INJ; REAL_ARITH `x < &0 ==> ~(x = &0)`; COMPLEX_FIELD
2728         `~(t = Cx(&0)) ==> (v = t * y <=> y = v / t)`] THEN
2729       DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM CX_DIV] THEN
2730       REWRITE_TAC[RE_CX; IM_CX]] THEN
2731     REWRITE_TAC[REAL_ARITH `x < &0 <=> &0 < --x`] THEN
2732     REWRITE_TAC[real_div; GSYM REAL_MUL_RNEG; GSYM REAL_INV_NEG] THEN
2733     MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN
2734     ASM_REAL_ARITH_TAC;
2735     W(MP_TAC o PART_MATCH (lhs o rand) AFF_LT_2_1 o rand o rand o snd) THEN
2736     ANTS_TAC THENL
2737      [REWRITE_TAC[SET_RULE `DISJOINT {a,b} {x} <=> ~(x = a) /\ ~(x = b)`] THEN
2738       CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN
2739       RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_2; INSERT_AC]) THEN
2740       FIRST_ASSUM CONTR_TAC;
2741       DISCH_THEN SUBST1_TAC] THEN
2742     W(MP_TAC o PART_MATCH (lhs o rand) AFF_LT_1_1 o rand o lhand o snd) THEN
2743     ANTS_TAC THENL
2744      [REWRITE_TAC[SET_RULE `DISJOINT {a} {x} <=> ~(x = a)`] THEN
2745       ASM_MESON_TAC[COLLINEAR_BASIS_3];
2746       DISCH_THEN SUBST1_TAC] THEN
2747     REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; IN_ELIM_THM] THEN
2748     ONCE_REWRITE_TAC[REAL_ARITH `s + t = &1 <=> s = &1- t`] THEN
2749     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
2750     REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN
2751     GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN
2752     REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN
2753     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN AP_TERM_TAC THEN
2754     REWRITE_TAC[FUN_EQ_THM; RIGHT_EXISTS_AND_THM] THEN X_GEN_TAC `t:real` THEN
2755     AP_TERM_TAC THEN
2756     SIMP_TAC[CART_EQ; FORALL_2; FORALL_3; DIMINDEX_2; DIMINDEX_3;
2757              dropout; LAMBDA_BETA; BASIS_COMPONENT; ARITH; REAL_MUL_RID;
2758              VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RZERO; UNWIND_THM1;
2759              VECTOR_ADD_COMPONENT; REAL_ADD_LID; RIGHT_EXISTS_AND_THM] THEN
2760     REWRITE_TAC[REAL_ARITH `x:real = t + y <=> t = x - y`] THEN
2761     REWRITE_TAC[EXISTS_REFL]]);;
2762
2763 let AZIM_EQ_PI_ALT = prove
2764  (`!v0 v1 w x.
2765         ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x}
2766         ==> (azim v0 v1 w x = pi <=> x IN aff_lt {v0,v1} {w})`,
2767   REPEAT GEN_TAC THEN DISCH_TAC THEN
2768   FIRST_ASSUM(SUBST1_TAC o MATCH_MP AZIM_EQ_PI_SYM) THEN
2769   ASM_SIMP_TAC[AZIM_EQ_PI]);;
2770
2771 let AZIM_EQ_0_PI_IMP_COPLANAR = prove
2772  (`!v0 v1 w1 w2.
2773         azim v0 v1 w1 w2 = &0 \/ azim v0 v1 w1 w2 = pi
2774         ==> coplanar {v0,v1,w1,w2}`,
2775   REPEAT GEN_TAC THEN ASM_CASES_TAC `collinear {v0:real^3,v1,w1}` THENL
2776    [MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w1:real^3`; `w2:real^3`]
2777                 NOT_COPLANAR_NOT_COLLINEAR) THEN
2778     ASM_REWRITE_TAC[] THEN CONV_TAC TAUT;
2779     POP_ASSUM MP_TAC] THEN
2780   ASM_CASES_TAC `collinear {v0:real^3,v1,w2}` THENL
2781    [MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w2:real^3`; `w1:real^3`]
2782                 NOT_COPLANAR_NOT_COLLINEAR) THEN
2783     ASM_REWRITE_TAC[] THEN REWRITE_TAC[INSERT_AC] THEN CONV_TAC TAUT;
2784     POP_ASSUM MP_TAC] THEN
2785   MAP_EVERY (fun t -> SPEC_TAC(t,t))
2786    [`w2:real^3`; `w1:real^3`; `v1:real^3`; `v0:real^3`] THEN
2787   GEOM_ORIGIN_TAC `v0:real^3` THEN
2788   GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN
2789   X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN
2790   ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[] THENL
2791    [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
2792   SIMP_TAC[AZIM_SPECIAL_SCALE] THEN
2793   ASM_SIMP_TAC[AZIM_ARG; COLLINEAR_SPECIAL_SCALE] THEN
2794   REWRITE_TAC[COLLINEAR_BASIS_3; ARG_EQ_0_PI] THEN
2795   REWRITE_TAC[real; IM_COMPLEX_DIV_EQ_0] THEN
2796   REWRITE_TAC[complex_mul; cnj; IM; RE] THEN
2797   REWRITE_TAC[REAL_ARITH `x * --y + a * b = &0 <=> x * y = a * b`] THEN
2798   REWRITE_TAC[RE_DEF; IM_DEF] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
2799   DISCH_TAC THEN DISCH_TAC THEN
2800   SIMP_TAC[dropout; LAMBDA_BETA; DIMINDEX_3; ARITH; DIMINDEX_2] THEN
2801   DISCH_TAC THEN REWRITE_TAC[coplanar] THEN
2802   MAP_EVERY EXISTS_TAC [`vec 0:real^3`; `w % basis 3:real^3`; `w1:real^3`] THEN
2803   ONCE_REWRITE_TAC[SET_RULE `{a,b,c,d} = d INSERT {a,b,c}`] THEN
2804   ONCE_REWRITE_TAC[INSERT_SUBSET] THEN REWRITE_TAC[HULL_SUBSET] THEN
2805   SIMP_TAC[AFFINE_HULL_EQ_SPAN; IN_INSERT; HULL_INC] THEN
2806   REWRITE_TAC[SPAN_BREAKDOWN_EQ; SPAN_EMPTY; IN_SING] THEN
2807   REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN
2808   REPEAT(POP_ASSUM MP_TAC) THEN
2809   SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; FORALL_3; dropout; LAMBDA_BETA;
2810            DIMINDEX_2; DIMINDEX_3; ARITH; VEC_COMPONENT; ARITH;
2811            VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN
2812   REPEAT STRIP_TAC THEN
2813   REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO] THEN
2814   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
2815   REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
2816   ASM_SIMP_TAC[EXISTS_REFL; REAL_FIELD
2817    `&0 < w ==> (x - k * w * &1 - y = &0 <=> k = (x - y) / w)`] THEN
2818   SUBGOAL_THEN `~((w1:real^3)$2 = &0) \/ ~((w2:real^3)$1 = &0)`
2819   STRIP_ASSUME_TAC THENL
2820    [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_RING;
2821     EXISTS_TAC `(w2:real^3)$2 / (w1:real^3)$2` THEN
2822     REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD;
2823     EXISTS_TAC `(w2:real^3)$1 / (w1:real^3)$1` THEN
2824     REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]);;
2825
2826 let AZIM_SAME_WITHIN_AFF_GE = prove
2827  (`!a u v w z.
2828         v IN aff_ge {a} {u,w} /\ ~collinear{a,u,v} /\ ~collinear{a,u,w}
2829         ==> azim a u v z = azim a u w z`,
2830   GEOM_ORIGIN_TAC `a:real^3` THEN
2831   GEOM_BASIS_MULTIPLE_TAC 3 `u:real^3` THEN
2832   X_GEN_TAC `u:real` THEN ASM_CASES_TAC `u = &0` THEN
2833   ASM_SIMP_TAC[AZIM_DEGENERATE; VECTOR_MUL_LZERO; REAL_LE_LT] THEN
2834   ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE] THEN
2835   DISCH_TAC THEN REPEAT GEN_TAC THEN
2836   ASM_CASES_TAC `w:real^3 = vec 0` THENL
2837    [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC] THEN
2838   ASM_SIMP_TAC[AFF_GE_SCALE_LEMMA] THEN
2839   REWRITE_TAC[COLLINEAR_BASIS_3; AZIM_ARG] THEN
2840   ASM_SIMP_TAC[AFF_GE_1_2_0; BASIS_NONZERO; ARITH; DIMINDEX_3;
2841    SET_RULE `DISJOINT {a} {b,c} <=> ~(b = a) /\ ~(c = a)`] THEN
2842   REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN
2843   MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN DISCH_TAC THEN DISCH_TAC THEN
2844   DISCH_THEN(MP_TAC o AP_TERM `dropout 3:real^3->real^2`) THEN
2845   REWRITE_TAC[DROPOUT_ADD; DROPOUT_MUL; DROPOUT_BASIS_3] THEN
2846   REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
2847   DISCH_THEN SUBST1_TAC THEN REPEAT DISCH_TAC THEN
2848   REWRITE_TAC[COMPLEX_CMUL] THEN
2849   REWRITE_TAC[complex_div; COMPLEX_INV_MUL; GSYM CX_INV] THEN
2850   ONCE_REWRITE_TAC[COMPLEX_RING `a * b * c:complex = b * a * c`] THEN
2851   MATCH_MP_TAC ARG_MUL_CX THEN REWRITE_TAC[REAL_LT_INV_EQ] THEN
2852   ASM_REWRITE_TAC[REAL_LT_LE] THEN ASM_MESON_TAC[VECTOR_MUL_LZERO]);;
2853
2854 let AZIM_SAME_WITHIN_AFF_GE_ALT = prove
2855  (`!a u v w z.
2856         v IN aff_ge {a} {u,w} /\ ~collinear{a,u,v} /\ ~collinear{a,u,w}
2857         ==> azim a u z v = azim a u z w`,
2858   REPEAT GEN_TAC THEN DISCH_TAC THEN
2859   FIRST_ASSUM(ASSUME_TAC o MATCH_MP AZIM_SAME_WITHIN_AFF_GE) THEN
2860   ASM_CASES_TAC `collinear {a:real^3,u,z}` THEN
2861   ASM_SIMP_TAC[AZIM_DEGENERATE] THEN
2862   W(MP_TAC o PART_MATCH (lhs o rand) AZIM_COMPL o lhand o snd) THEN
2863   ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
2864   W(MP_TAC o PART_MATCH (lhs o rand) AZIM_COMPL o rand o snd) THEN
2865   ASM_SIMP_TAC[]);;
2866
2867 let COLLINEAR_WITHIN_AFF_GE_COLLINEAR = prove
2868  (`!a u v w:real^N.
2869         v IN aff_ge {a} {u,w} /\ collinear{a,u,w} ==> collinear{a,v,w}`,
2870   GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT GEN_TAC THEN
2871   ASM_CASES_TAC `w:real^N = vec 0` THENL
2872    [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC] THEN
2873   ASM_CASES_TAC `u:real^N = vec 0` THENL
2874    [ONCE_REWRITE_TAC[AFF_GE_DISJOINT_DIFF] THEN
2875     ASM_REWRITE_TAC[SET_RULE `{a} DIFF {a,b} = {}`] THEN
2876     REWRITE_TAC[GSYM CONVEX_HULL_AFF_GE] THEN
2877     ONCE_REWRITE_TAC[SET_RULE `{z,v,w} = {z,w,v}`] THEN
2878     ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN
2879     MESON_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL; SUBSET];
2880     ONCE_REWRITE_TAC[SET_RULE `{z,v,w} = {z,w,v}`] THEN
2881     ASM_REWRITE_TAC[COLLINEAR_LEMMA_ALT] THEN
2882     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `a:real`)) THEN
2883     ASM_SIMP_TAC[AFF_GE_1_2_0; SET_RULE
2884      `DISJOINT {a} {b,c} <=> ~(b = a) /\ ~(c = a)`] THEN
2885     REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
2886     MAP_EVERY X_GEN_TAC [`b:real`; `c:real`] THEN STRIP_TAC THEN
2887     ASM_REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; VECTOR_MUL_ASSOC] THEN
2888     MESON_TAC[]]);;
2889
2890 let AZIM_EQ_IMP = prove
2891  (`!v0 v1 w x y.
2892      ~collinear {v0, v1, w} /\
2893      ~collinear {v0, v1, y} /\
2894      x IN aff_gt {v0, v1} {y}
2895      ==> azim v0 v1 w x = azim v0 v1 w y`,
2896   REPEAT GEN_TAC THEN ASM_CASES_TAC `v1:real^3 = v0` THENL
2897    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
2898   ASM_CASES_TAC `collinear {v0:real^3,v1,x}` THENL
2899    [ALL_TAC; ASM_SIMP_TAC[AZIM_EQ_ALT]] THEN
2900   UNDISCH_TAC `collinear {v0:real^3,v1,x}` THEN
2901   MATCH_MP_TAC(TAUT
2902    `(s /\ p ==> r) ==> p ==> ~q /\ ~r /\ s ==> t`) THEN
2903   ASM_SIMP_TAC[COLLINEAR_3_IN_AFFINE_HULL] THEN
2904   ASM_CASES_TAC `y:real^3 = v0` THEN
2905   ASM_SIMP_TAC[HULL_INC; IN_INSERT] THEN
2906   ASM_CASES_TAC `y:real^3 = v1` THEN
2907   ASM_SIMP_TAC[HULL_INC; IN_INSERT] THEN
2908   ASM_SIMP_TAC[AFF_GT_2_1; SET_RULE
2909    `DISJOINT {a,b} {c} <=> ~(c = a) /\ ~(c = b)`] THEN
2910   REWRITE_TAC[AFFINE_HULL_2; IN_ELIM_THM; LEFT_AND_EXISTS_THM] THEN
2911   REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
2912   MAP_EVERY X_GEN_TAC
2913    [`t1:real`; `t2:real`; `t3:real`; `s1:real`; `s2:real`] THEN
2914   DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
2915   FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv t3) :real^3->real^3`) THEN
2916   ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_MUL_LINV;
2917                REAL_LT_IMP_NZ; VECTOR_ARITH
2918                 `x:real^N = y + z + &1 % w <=> w = x - (y + z)`] THEN
2919   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2920   EXISTS_TAC `inv t3 * s1 - inv t3 * t1:real` THEN
2921   EXISTS_TAC `inv t3 * s2 - inv t3 * t2:real` THEN CONJ_TAC THENL
2922    [ASM_SIMP_TAC[REAL_FIELD
2923      `&0 < t ==> (inv t * a - inv t * b + inv t * c - inv t * d = &1 <=>
2924                   (a + c) - (b + d) = t)`] THEN
2925     ASM_REAL_ARITH_TAC;
2926     VECTOR_ARITH_TAC]);;
2927
2928 let AZIM_EQ_0_GE_IMP = prove
2929  (`!v0 v1 w x. x IN aff_ge {v0, v1} {w} ==> azim v0 v1 w x = &0`,
2930   REPEAT STRIP_TAC THEN ASM_CASES_TAC `collinear {v0:real^3,v1,w}` THEN
2931   ASM_SIMP_TAC[AZIM_DEGENERATE] THEN
2932   ASM_CASES_TAC `collinear {v0:real^3,v1,x}` THEN
2933   ASM_SIMP_TAC[AZIM_DEGENERATE] THEN ASM_MESON_TAC[AZIM_EQ_0_GE_ALT]);;
2934
2935 let REAL_SGN_SIN_AZIM = prove
2936  (`!v w x y. real_sgn(sin(azim v w x y)) =
2937              real_sgn(((w - v) cross (x - v)) dot (y - v))`,
2938   GEOM_ORIGIN_TAC `v:real^3` THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN
2939   GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN
2940   X_GEN_TAC `w:real` THEN ASM_CASES_TAC `w = &0` THEN
2941   ASM_REWRITE_TAC[VECTOR_MUL_LZERO; CROSS_LZERO; DOT_LZERO; REAL_SGN_0;
2942                   AZIM_REFL_ALT; SIN_0] THEN
2943   ASM_REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THEN
2944   ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; CROSS_LMUL; DOT_LMUL] THEN
2945   REWRITE_TAC[REAL_SGN_MUL] THEN
2946   GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [real_sgn] THEN
2947   ASM_REWRITE_TAC[REAL_MUL_LID; AZIM_ARG] THEN
2948   MATCH_MP_TAC EQ_TRANS THEN
2949   EXISTS_TAC `real_sgn(Im(dropout 3 (y:real^3) / dropout 3 (x:real^3)))` THEN
2950   CONJ_TAC THENL
2951    [ALL_TAC;
2952     REWRITE_TAC[REAL_SGN_IM_COMPLEX_DIV] THEN AP_TERM_TAC THEN
2953     SIMP_TAC[CART_EQ; DIMINDEX_3; FORALL_3; cross; VECTOR_3; DOT_3; dropout;
2954              LAMBDA_BETA; ARITH; cnj; complex_mul; RE_DEF; IM_DEF; DIMINDEX_2;
2955              complex; VECTOR_2; BASIS_COMPONENT] THEN REAL_ARITH_TAC] THEN
2956
2957   SPEC_TAC(`(dropout 3:real^3->real^2) x`,`z:complex`) THEN
2958   SPEC_TAC(`(dropout 3:real^3->real^2) y`,`w:complex`) THEN
2959   POP_ASSUM_LIST(K ALL_TAC) THEN GEOM_BASIS_MULTIPLE_TAC 1 `z:complex` THEN
2960   REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_MUL_RID] THEN
2961   X_GEN_TAC `x:real` THEN DISCH_TAC THEN X_GEN_TAC `z:complex` THEN
2962   ASM_CASES_TAC `x = &0` THENL
2963    [ASM_REWRITE_TAC[complex_div; COMPLEX_INV_0; COMPLEX_MUL_RZERO] THEN
2964     REWRITE_TAC[ARG_0; SIN_0; IM_CX; REAL_SGN_0];
2965     SUBGOAL_THEN `&0 < x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]] THEN
2966   ASM_SIMP_TAC[ARG_DIV_CX; IM_DIV_CX; REAL_SGN_DIV] THEN
2967   GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [real_sgn] THEN
2968   ASM_REWRITE_TAC[REAL_DIV_1] THEN ASM_CASES_TAC `z = Cx(&0)` THEN
2969   ASM_REWRITE_TAC[IM_CX; ARG_0; SIN_0] THEN
2970   GEN_REWRITE_TAC (funpow 3 RAND_CONV) [ARG] THEN
2971   REWRITE_TAC[IM_MUL_CX; REAL_SGN_MUL] THEN
2972   GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [real_sgn] THEN
2973   ASM_REWRITE_TAC[COMPLEX_NORM_NZ; REAL_MUL_LID] THEN
2974   REWRITE_TAC[IM_CEXP; RE_MUL_II; IM_MUL_II; RE_CX; REAL_SGN_MUL] THEN
2975   GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [real_sgn] THEN
2976   REWRITE_TAC[REAL_EXP_POS_LT; REAL_MUL_LID]);;
2977
2978 let AZIM_IN_UPPER_HALFSPACE = prove
2979  (`!v w x y. azim v w x y <= pi <=>
2980              &0 <= ((w - v) cross (x - v)) dot (y - v)`,
2981   REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
2982   EXISTS_TAC `&0 <= sin(azim v w x y)` THEN CONJ_TAC THENL
2983    [EQ_TAC THEN SIMP_TAC[SIN_POS_PI_LE; azim] THEN
2984     MP_TAC(ISPEC `azim v w x y - pi` SIN_POS_PI) THEN
2985     REWRITE_TAC[SIN_SUB; SIN_PI; COS_PI; azim;
2986                 REAL_ARITH `x - pi < pi <=> x < &2 * pi`] THEN
2987     REAL_ARITH_TAC;
2988     ONCE_REWRITE_TAC[GSYM REAL_SGN_INEQS] THEN
2989     REWRITE_TAC[REAL_SGN_SIN_AZIM]]);;
2990
2991 (* ------------------------------------------------------------------------- *)
2992 (* Dihedral angle and relation to azimuth angle.                             *)
2993 (* ------------------------------------------------------------------------- *)
2994
2995 let dihV = new_definition
2996   `dihV w0 w1 w2 w3 =
2997      let va = w2 - w0 in
2998      let vb = w3 - w0 in
2999      let vc = w1 - w0 in
3000      let vap = ( vc dot vc) % va - ( va dot vc) % vc in
3001      let vbp = ( vc dot vc) % vb - ( vb dot vc) % vc in
3002      arcV (vec 0) vap vbp`;;
3003
3004 let DIHV = prove
3005  (`dihV (w0:real^N) w1 w2 w3 =
3006      let va = w2 - w0 in
3007      let vb = w3 - w0 in
3008      let vc = w1 - w0 in
3009      let vap = (vc dot vc) % va - (va dot vc) % vc in
3010      let vbp = (vc dot vc) % vb - (vb dot vc) % vc in
3011      angle(vap,vec 0,vbp)`,
3012   REWRITE_TAC[dihV; ARCV_ANGLE]);;
3013
3014 let DIHV_TRANSLATION_EQ = prove
3015  (`!a w0 w1 w2 w3:real^N.
3016         dihV (a + w0) (a + w1) (a + w2) (a + w3) = dihV w0 w1 w2 w3`,
3017   REWRITE_TAC[DIHV; VECTOR_ARITH `(a + x) - (a + y):real^N = x - y`]);;
3018
3019 add_translation_invariants [DIHV_TRANSLATION_EQ];;
3020
3021 let DIHV_LINEAR_IMAGE = prove
3022  (`!f:real^M->real^N w0 w1 w2 w3.
3023         linear f /\ (!x. norm(f x) = norm x)
3024         ==> dihV (f w0) (f w1) (f w2) (f w3) = dihV w0 w1 w2 w3`,
3025   REPEAT STRIP_TAC THEN REWRITE_TAC[DIHV] THEN
3026   ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN
3027   CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN
3028   ASM_SIMP_TAC[PRESERVES_NORM_PRESERVES_DOT] THEN
3029   ASM_SIMP_TAC[GSYM LINEAR_CMUL; GSYM LINEAR_SUB] THEN
3030   REWRITE_TAC[angle; VECTOR_SUB_RZERO] THEN
3031   ASM_SIMP_TAC[VECTOR_ANGLE_LINEAR_IMAGE_EQ]);;
3032
3033 add_linear_invariants [DIHV_LINEAR_IMAGE];;
3034
3035 let DIHV_SPECIAL_SCALE = prove
3036  (`!a v w1 w2:real^N.
3037         ~(a = &0)
3038         ==> dihV (vec 0) (a % v) w1 w2 = dihV (vec 0) v w1 w2`,
3039   REPEAT STRIP_TAC THEN REWRITE_TAC[DIHV; VECTOR_SUB_RZERO] THEN
3040   CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN
3041   REWRITE_TAC[DOT_LMUL; DOT_RMUL; GSYM VECTOR_MUL_ASSOC] THEN
3042   REWRITE_TAC[VECTOR_ARITH `a % a % x - a % b % a % y:real^N =
3043                             (a * a) % (x - b % y)`] THEN
3044   REWRITE_TAC[angle; VECTOR_SUB_RZERO] THEN
3045   REWRITE_TAC[VECTOR_ANGLE_LMUL; VECTOR_ANGLE_RMUL] THEN
3046   ASM_REWRITE_TAC[REAL_LE_SQUARE; REAL_ENTIRE]);;
3047
3048 let DIHV_RANGE = prove
3049  (`!w0 w1 w2 w3. &0 <= dihV w0 w1 w2 w3 /\ dihV w0 w1 w2 w3 <= pi`,
3050   REWRITE_TAC[DIHV] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN
3051   REWRITE_TAC[ANGLE_RANGE]);;
3052
3053 let COS_AZIM_DIHV = prove
3054  (`!v w v1 v2:real^3.
3055         ~collinear {v,w,v1} /\ ~collinear {v,w,v2}
3056         ==> cos(azim v w v1 v2) = cos(dihV v w v1 v2)`,
3057   REPEAT GEN_TAC THEN ASM_CASES_TAC `w:real^3 = v` THENL
3058    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; POP_ASSUM MP_TAC] THEN
3059   REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
3060   GEOM_ORIGIN_TAC `v:real^3` THEN GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN
3061   X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN
3062   ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
3063   ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; DIHV_SPECIAL_SCALE; REAL_LT_IMP_NZ;
3064                COLLINEAR_SPECIAL_SCALE; COLLINEAR_BASIS_3] THEN
3065   DISCH_TAC THEN POP_ASSUM_LIST(K ALL_TAC) THEN
3066   MAP_EVERY X_GEN_TAC [`w1:real^3`; `w2:real^3`] THEN
3067   DISCH_THEN(STRIP_ASSUME_TAC o CONJUNCT2) THEN
3068   REWRITE_TAC[DIHV; VECTOR_SUB_RZERO] THEN
3069   CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN
3070   SIMP_TAC[DOT_BASIS_BASIS; DIMINDEX_3; ARITH] THEN
3071   SIMP_TAC[DOT_BASIS; DIMINDEX_3; ARITH; VECTOR_MUL_LID] THEN
3072   MP_TAC(ISPECL [`vec 0:real^3`; `basis 3:real^3`; `w1:real^3`; `w2:real^3`]
3073         azim) THEN
3074   ABBREV_TAC `a = azim (vec 0) (basis 3) w1 (w2:real^3)` THEN
3075   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
3076   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; VECTOR_SUB_RZERO; DIST_0] THEN
3077   MAP_EVERY X_GEN_TAC [`h1:real`; `h2:real`] THEN
3078   DISCH_THEN(MP_TAC o SPECL
3079    [`basis 1:real^3`; `basis 2:real^3`; `basis 3:real^3`]) THEN
3080   SIMP_TAC[orthonormal; DOT_BASIS_BASIS; CROSS_BASIS; DIMINDEX_3; NORM_BASIS;
3081     ARITH; VECTOR_MUL_LID; BASIS_NONZERO; REAL_LT_01; LEFT_IMP_EXISTS_THM] THEN
3082   ASM_REWRITE_TAC[COLLINEAR_BASIS_3] THEN
3083   MAP_EVERY X_GEN_TAC [`psi:real`; `r1:real`; `r2:real`] THEN
3084   DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
3085   REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
3086   SIMP_TAC[BASIS_COMPONENT; DIMINDEX_3; ARITH; REAL_MUL_RZERO] THEN
3087   REWRITE_TAC[REAL_MUL_RID; REAL_ADD_LID] THEN
3088   REWRITE_TAC[VECTOR_ARITH `(a + b + c) - c:real^N = a + b`] THEN
3089   REWRITE_TAC[COS_ANGLE; VECTOR_SUB_RZERO] THEN
3090   REWRITE_TAC[vector_norm; GSYM DOT_EQ_0; DIMINDEX_3; FORALL_3; DOT_3] THEN
3091   REWRITE_TAC[VEC_COMPONENT; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
3092   SIMP_TAC[BASIS_COMPONENT; DIMINDEX_3; ARITH; REAL_MUL_RZERO] THEN
3093   REWRITE_TAC[REAL_MUL_RID; REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_RZERO] THEN
3094   REWRITE_TAC[REAL_ARITH `(r * c) * (r * c) + (r * s) * (r * s):real =
3095                           r pow 2 * (s pow 2 + c pow 2)`] THEN
3096   ASM_SIMP_TAC[SIN_CIRCLE; REAL_MUL_RID; REAL_POW_EQ_0; REAL_LT_IMP_NZ] THEN
3097   ASM_SIMP_TAC[POW_2_SQRT; REAL_LT_IMP_LE] THEN
3098   REWRITE_TAC[REAL_ARITH `(r1 * c1) * (r2 * c2) + (r1 * s1) * (r2 * s2):real =
3099                           (r1 * r2) * (c1 * c2 + s1 * s2)`] THEN
3100   ASM_SIMP_TAC[REAL_FIELD
3101    `&0 < r1 /\ &0 < r2 ==> ((r1 * r2) * x) / (r1 * r2) = x`] THEN
3102   ONCE_REWRITE_TAC[REAL_ARITH `a:real = b + c * d <=> b - --c * d = a`] THEN
3103   GEN_REWRITE_TAC (funpow 3 LAND_CONV) [GSYM COS_NEG] THEN
3104   REWRITE_TAC[GSYM SIN_NEG; GSYM COS_ADD] THEN AP_TERM_TAC THEN
3105   REAL_ARITH_TAC);;
3106
3107 let AZIM_DIHV_SAME = prove
3108  (`!v w v1 v2:real^3.
3109         ~collinear {v,w,v1} /\ ~collinear {v,w,v2} /\
3110         azim v w v1 v2 < pi
3111         ==> azim v w v1 v2 = dihV v w v1 v2`,
3112   REPEAT STRIP_TAC THEN MATCH_MP_TAC COS_INJ_PI THEN
3113   ASM_SIMP_TAC[COS_AZIM_DIHV; azim; REAL_LT_IMP_LE; DIHV_RANGE]);;
3114
3115 let AZIM_DIHV_COMPL = prove
3116  (`!v w v1 v2:real^3.
3117         ~collinear {v,w,v1} /\ ~collinear {v,w,v2} /\
3118         pi <= azim v w v1 v2
3119         ==> azim v w v1 v2 = &2 * pi - dihV v w v1 v2`,
3120   REPEAT STRIP_TAC THEN
3121   ONCE_REWRITE_TAC[REAL_ARITH `x = &2 * pi - y <=> y = &2 * pi - x`] THEN
3122   MATCH_MP_TAC COS_INJ_PI THEN
3123   REWRITE_TAC[COS_SUB; SIN_NPI; COS_NPI; REAL_MUL_LZERO] THEN
3124   CONV_TAC REAL_RAT_REDUCE_CONV THEN
3125   ASM_SIMP_TAC[COS_AZIM_DIHV; REAL_ADD_RID; REAL_MUL_LID] THEN
3126   ASM_REWRITE_TAC[DIHV_RANGE] THEN MATCH_MP_TAC(REAL_ARITH
3127    `p <= x /\ x < &2 * p ==> &0 <= &2 * p - x /\ &2 * p - x <= p`) THEN
3128   ASM_SIMP_TAC[azim]);;
3129
3130 let AZIM_DIVH = prove
3131  (`!v w v1 v2:real^3.
3132         ~collinear {v,w,v1} /\ ~collinear {v,w,v2}
3133         ==> azim v w v1 v2 = if azim v w v1 v2 < pi then dihV v w v1 v2
3134                              else &2 * pi - dihV v w v1 v2`,
3135   REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
3136   RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN
3137   ASM_SIMP_TAC[AZIM_DIHV_SAME; AZIM_DIHV_COMPL]);;
3138
3139 let AZIM_DIHV_EQ_0 = prove
3140  (`!v0 v1 w1 w2.
3141         ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2}
3142         ==> (azim v0 v1 w1 w2 = &0 <=> dihV v0 v1 w1 w2 = &0)`,
3143   REPEAT STRIP_TAC THEN
3144   W(MP_TAC o PART_MATCH (lhs o rand) AZIM_DIVH o lhs o lhs o snd) THEN
3145   ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN
3146   ONCE_REWRITE_TAC[REAL_ARITH `a:real = p - b <=> b = p - a`] THEN
3147   DISCH_THEN SUBST1_TAC THEN
3148   REWRITE_TAC[REAL_ARITH `&2 * p - (&2 * p - a) = &0 <=> a = &0`] THEN
3149   MATCH_MP_TAC(REAL_ARITH
3150    `a < &2 * pi /\ ~(a < pi) ==> (a = &0 <=> &2 * pi - a = &0)`) THEN
3151   ASM_REWRITE_TAC[azim]);;
3152
3153 let AZIM_DIHV_EQ_PI = prove
3154  (`!v0 v1 w1 w2.
3155         ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2}
3156         ==> (azim v0 v1 w1 w2 = pi <=> dihV v0 v1 w1 w2 = pi)`,
3157   REPEAT STRIP_TAC THEN
3158   W(MP_TAC o PART_MATCH (lhs o rand) AZIM_DIVH o lhs o lhs o snd) THEN
3159   ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);;
3160
3161 let AZIM_EQ_0_PI_EQ_COPLANAR = prove
3162  (`!v0 v1 w1 w2.
3163         ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2}
3164         ==> (azim v0 v1 w1 w2 = &0 \/ azim v0 v1 w1 w2 = pi <=>
3165              coplanar {v0,v1,w1,w2})`,
3166   REWRITE_TAC[TAUT `(a <=> b) <=> (a ==> b) /\ (b ==> a)`] THEN
3167   REWRITE_TAC[AZIM_EQ_0_PI_IMP_COPLANAR] THEN
3168   SIMP_TAC[GSYM IMP_CONJ_ALT; COPLANAR; DIMINDEX_3; ARITH] THEN
3169   REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN
3170   MAP_EVERY X_GEN_TAC
3171    [`v0:real^3`; `v1:real^3`; `v2:real^3`; `v3:real^3`; `p:real^3->bool`] THEN
3172   GEOM_HORIZONTAL_PLANE_TAC `p:real^3->bool` THEN
3173   REWRITE_TAC[INSERT_SUBSET; IN_ELIM_THM; IMP_CONJ; RIGHT_FORALL_IMP_THM;
3174               EMPTY_SUBSET] THEN
3175   SIMP_TAC[AZIM_DIHV_EQ_0; AZIM_DIHV_EQ_PI] THEN
3176   REWRITE_TAC[DIHV] THEN
3177   CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN
3178   DISCH_THEN(K ALL_TAC) THEN PAD2D3D_TAC THEN
3179   REWRITE_TAC[angle; VECTOR_SUB_RZERO] THEN
3180   GEOM_ORIGIN_TAC `v0:real^2` THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN
3181   REPEAT STRIP_TAC THEN
3182   W(MP_TAC o PART_MATCH (rand o rand) COLLINEAR_VECTOR_ANGLE o snd) THEN
3183   ANTS_TAC THENL
3184    [REPEAT(POP_ASSUM MP_TAC); DISCH_THEN(SUBST1_TAC o SYM)] THEN
3185   REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL] THEN
3186   REWRITE_TAC[DOT_2; CART_EQ; FORALL_2; DIMINDEX_2; VEC_COMPONENT;
3187               VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN
3188   CONV_TAC REAL_RING);;
3189
3190 let DIHV_EQ_0_PI_EQ_COPLANAR = prove
3191  (`!v0 v1 w1 w2:real^3.
3192         ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2}
3193         ==> (dihV v0 v1 w1 w2 = &0 \/ dihV v0 v1 w1 w2 = pi <=>
3194              coplanar {v0,v1,w1,w2})`,
3195   SIMP_TAC[GSYM AZIM_DIHV_EQ_0; GSYM AZIM_DIHV_EQ_PI;
3196            AZIM_EQ_0_PI_EQ_COPLANAR]);;
3197
3198 let DIHV_SYM = prove
3199  (`!v0 v1 v2 v3:real^N.
3200         dihV v0 v1 v3 v2 = dihV v0 v1 v2 v3`,
3201   REPEAT GEN_TAC THEN REWRITE_TAC[DIHV] THEN
3202   CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN
3203   REWRITE_TAC[DOT_SYM; ANGLE_SYM]);;
3204
3205 let DIHV_NEG = prove
3206  (`!v0 v1 v2 v3. dihV (--v0) (--v1) (--v2) (--v3) = dihV v0 v1 v2 v3`,
3207   REWRITE_TAC[DIHV; VECTOR_ARITH `--a - --b:real^N = --(a - b)`] THEN
3208   CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN
3209   REWRITE_TAC[DOT_RNEG; DOT_LNEG; REAL_NEG_NEG] THEN
3210   REWRITE_TAC[VECTOR_MUL_RNEG] THEN
3211   REWRITE_TAC[angle; VECTOR_ARITH `--a - --b:real^N = --(a - b)`] THEN
3212   REWRITE_TAC[VECTOR_SUB_RZERO; VECTOR_ANGLE_NEG2]);;
3213
3214 let DIHV_NEG_0 = prove
3215  (`!v1 v2 v3. dihV (vec 0) (--v1) (--v2) (--v3) = dihV (vec 0) v1 v2 v3`,
3216   REPEAT GEN_TAC THEN
3217   GEN_REWRITE_TAC RAND_CONV [GSYM DIHV_NEG] THEN
3218   REWRITE_TAC[VECTOR_NEG_0]);;
3219
3220 let DIHV_ARCV = prove
3221  (`!e u v w:real^N.
3222       orthogonal (e - u) (v - u) /\ orthogonal (e - u) (w - u) /\ ~(e = u)
3223       ==> dihV u e v w = arcV u v w`,
3224   GEOM_ORIGIN_TAC `u:real^N` THEN
3225   REWRITE_TAC[dihV; orthogonal; VECTOR_SUB_RZERO] THEN
3226   CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN
3227   SIMP_TAC[DOT_SYM; VECTOR_MUL_LZERO; VECTOR_SUB_RZERO] THEN
3228   REWRITE_TAC[ARCV_ANGLE; angle; VECTOR_SUB_RZERO] THEN
3229   REWRITE_TAC[VECTOR_ANGLE_LMUL; VECTOR_ANGLE_RMUL] THEN
3230   SIMP_TAC[DOT_POS_LE; DOT_EQ_0]);;
3231
3232 let AZIM_DIHV_SAME_STRONG = prove
3233  (`!v w v1 v2:real^3.
3234         ~collinear {v,w,v1} /\ ~collinear {v,w,v2} /\
3235         azim v w v1 v2 <= pi
3236         ==> azim v w v1 v2 = dihV v w v1 v2`,
3237   REWRITE_TAC[REAL_LE_LT] THEN
3238   MESON_TAC[AZIM_DIHV_SAME; AZIM_DIHV_EQ_PI]);;
3239
3240 let AZIM_ARCV = prove
3241  (`!e u v w:real^3.
3242         orthogonal (e - u) (v - u) /\ orthogonal (e - u) (w - u) /\
3243         ~collinear{u,e,v} /\ ~collinear{u,e,w} /\
3244         azim u e v w <= pi
3245         ==> azim u e v w = arcV u v w`,
3246   REPEAT GEN_TAC THEN ASM_CASES_TAC `u:real^3 = e` THENL
3247    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
3248   STRIP_TAC THEN ASM_SIMP_TAC[GSYM DIHV_ARCV] THEN
3249   MATCH_MP_TAC AZIM_DIHV_SAME_STRONG THEN ASM_REWRITE_TAC[]);;
3250
3251 let COLLINEAR_AZIM_0_OR_PI = prove
3252  (`!u e v w. collinear {u,v,w} ==> azim u e v w = &0 \/ azim u e v w = pi`,
3253   REPEAT STRIP_TAC THEN
3254   ASM_CASES_TAC `collinear{u:real^3,e,v}` THEN
3255   ASM_SIMP_TAC[AZIM_DEGENERATE] THEN
3256   ASM_CASES_TAC `collinear{u:real^3,e,w}` THEN
3257   ASM_SIMP_TAC[AZIM_DEGENERATE] THEN
3258   ASM_SIMP_TAC[AZIM_EQ_0_PI_EQ_COPLANAR] THEN
3259   ONCE_REWRITE_TAC[SET_RULE `{u,e,v,w} = {u,v,w,e}`] THEN
3260   ASM_MESON_TAC[NOT_COPLANAR_NOT_COLLINEAR]);;
3261
3262 let REAL_CONTINUOUS_WITHIN_DIHV_COMPOSE = prove
3263  (`!f:real^M->real^N g h k x s.
3264       ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\
3265       f continuous (at x within s) /\ g continuous (at x within s) /\
3266       h continuous (at x within s) /\ k continuous (at x within s)
3267       ==> (\x. dihV (f x) (g x) (h x) (k x)) real_continuous (at x within s)`,
3268   REPEAT STRIP_TAC THEN REWRITE_TAC[dihV] THEN
3269   CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN
3270   REWRITE_TAC[ARCV_ANGLE; angle; REAL_CONTINUOUS_CONTINUOUS; o_DEF] THEN
3271   REWRITE_TAC[VECTOR_SUB_RZERO] THEN
3272   MATCH_MP_TAC CONTINUOUS_WITHIN_CX_VECTOR_ANGLE_COMPOSE THEN
3273   ASM_REWRITE_TAC[VECTOR_SUB_EQ; GSYM COLLINEAR_3_DOT_MULTIPLES] THEN
3274   CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THEN
3275   MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF] THEN
3276   ASM_SIMP_TAC[CONTINUOUS_LIFT_DOT2; o_DEF; CONTINUOUS_SUB]);;
3277
3278 let REAL_CONTINUOUS_AT_DIHV_COMPOSE = prove
3279  (`!f:real^M->real^N g h k x.
3280       ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\
3281       f continuous (at x) /\ g continuous (at x) /\
3282       h continuous (at x) /\ k continuous (at x)
3283       ==> (\x. dihV (f x) (g x) (h x) (k x)) real_continuous (at x)`,
3284   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
3285   REWRITE_TAC[REAL_CONTINUOUS_WITHIN_DIHV_COMPOSE]);;
3286
3287 let REAL_CONTINUOUS_WITHINREAL_DIHV_COMPOSE = prove
3288  (`!f:real->real^N g h k x s.
3289       ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\
3290       f continuous (atreal x within s) /\ g continuous (atreal x within s) /\
3291       h continuous (atreal x within s) /\ k continuous (atreal x within s)
3292       ==> (\x. dihV (f x) (g x) (h x) (k x)) real_continuous
3293           (atreal x within s)`,
3294   REWRITE_TAC[CONTINUOUS_CONTINUOUS_WITHINREAL;
3295               REAL_CONTINUOUS_REAL_CONTINUOUS_WITHINREAL] THEN
3296   SIMP_TAC[o_DEF; REAL_CONTINUOUS_WITHIN_DIHV_COMPOSE; LIFT_DROP]);;
3297
3298 let REAL_CONTINUOUS_ATREAL_DIHV_COMPOSE = prove
3299  (`!f:real->real^N g h k x.
3300       ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\
3301       f continuous (atreal x) /\ g continuous (atreal x) /\
3302       h continuous (atreal x) /\ k continuous (atreal x)
3303       ==> (\x. dihV (f x) (g x) (h x) (k x)) real_continuous (atreal x)`,
3304   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
3305   REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL_DIHV_COMPOSE]);;
3306
3307 let REAL_CONTINUOUS_AT_DIHV = prove
3308  (`!v w w1 w2:real^N.
3309         ~collinear {v, w, w2} ==> dihV v w w1 real_continuous at w2`,
3310   REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN
3311   REWRITE_TAC[dihV] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN
3312   GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
3313   MATCH_MP_TAC REAL_CONTINUOUS_CONTINUOUS_AT_COMPOSE THEN CONJ_TAC THENL
3314    [MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THEN
3315     MATCH_MP_TAC CONTINUOUS_MUL THEN
3316     SIMP_TAC[CONTINUOUS_CONST; o_DEF; CONTINUOUS_SUB; CONTINUOUS_AT_ID;
3317              CONTINUOUS_LIFT_DOT2];
3318     GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN
3319     REWRITE_TAC[ARCV_ANGLE; angle] THEN
3320     REWRITE_TAC[VECTOR_SUB_RZERO; ETA_AX] THEN
3321     MATCH_MP_TAC REAL_CONTINUOUS_WITHIN_VECTOR_ANGLE THEN
3322     POP_ASSUM MP_TAC THEN GEOM_ORIGIN_TAC `v:real^N` THEN
3323     REWRITE_TAC[VECTOR_SUB_RZERO; CONTRAPOS_THM; VECTOR_SUB_EQ] THEN
3324     MAP_EVERY X_GEN_TAC [`z:real^N`; `w:real^N`] THEN
3325     ASM_CASES_TAC `w:real^N = vec 0` THEN
3326     ASM_REWRITE_TAC[COLLINEAR_LEMMA_ALT] THEN DISCH_THEN(MP_TAC o AP_TERM
3327      `(%) (inv((w:real^N) dot w)):real^N->real^N`) THEN
3328     ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; DOT_EQ_0] THEN
3329     MESON_TAC[VECTOR_MUL_LID]]);;
3330
3331 let REAL_CONTINUOUS_WITHIN_AZIM_COMPOSE = prove
3332  (`!f:real^M->real^3 g h k x s.
3333       ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\
3334       ~(k x IN aff_ge {f x,g x} {h x}) /\
3335       f continuous (at x within s) /\ g continuous (at x within s) /\
3336       h continuous (at x within s) /\ k continuous (at x within s)
3337       ==> (\x. azim (f x) (g x) (h x) (k x)) real_continuous (at x within s)`,
3338   let lemma = prove
3339    (`!s t u f:real^M->real^N g h.
3340           (closed s /\ closed t) /\ s UNION t = UNIV /\
3341           (g continuous_on (u INTER s) /\ h continuous_on (u INTER t)) /\
3342           (!x. x IN u INTER s ==> g x = f x) /\
3343           (!x. x IN u INTER t ==> h x = f x)
3344           ==> f continuous_on u`,
3345     REPEAT STRIP_TAC THEN
3346     SUBGOAL_THEN `u:real^M->bool = (u INTER s) UNION (u INTER t)`
3347     SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
3348     MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL THEN
3349     REWRITE_TAC[CLOSED_IN_CLOSED] THEN REPEAT CONJ_TAC THENL
3350      [EXISTS_TAC `s:real^M->bool` THEN ASM SET_TAC[];
3351       EXISTS_TAC `t:real^M->bool` THEN ASM SET_TAC[];
3352       ASM_MESON_TAC[CONTINUOUS_ON_EQ];
3353       ASM_MESON_TAC[CONTINUOUS_ON_EQ]]) in
3354   REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS; o_DEF] THEN
3355   SUBGOAL_THEN
3356    `(\x:real^M. Cx(azim (f x) (g x) (h x) (k x))) =
3357     (\z. Cx(azim (vec 0) (fstcart z)
3358                  (fstcart(sndcart z)) (sndcart(sndcart z)))) o
3359     (\x. pastecart (g x - f x) (pastecart (h x - f x) (k x - f x)))`
3360   SUBST1_TAC THENL
3361    [REWRITE_TAC[FUN_EQ_THM; o_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
3362     X_GEN_TAC `y:real^M` THEN
3363     SUBST1_TAC(VECTOR_ARITH `vec 0 = (f:real^M->real^3) y - f y`) THEN
3364     SIMP_TAC[ONCE_REWRITE_RULE[VECTOR_ADD_SYM] AZIM_TRANSLATION; VECTOR_SUB];
3365     MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN
3366     ASM_SIMP_TAC[CONTINUOUS_PASTECART; CONTINUOUS_SUB]] THEN
3367   MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN
3368   SUBGOAL_THEN
3369    `!z. ~collinear {vec 0,fstcart z,fstcart(sndcart z)} /\
3370         ~collinear {vec 0,fstcart z,sndcart(sndcart z)} /\
3371         ~(sndcart(sndcart z) IN aff_ge {vec 0,fstcart z} {fstcart(sndcart z)})
3372         ==> (\z. Cx(azim (vec 0) (fstcart z) (fstcart(sndcart z))
3373                                              (sndcart(sndcart z))))
3374             continuous (at z)`
3375   MATCH_MP_TAC THENL
3376    [ALL_TAC;
3377     ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; GSYM COLLINEAR_3] THEN
3378     REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[INSERT_AC]; ALL_TAC]) THEN
3379     SUBST1_TAC(VECTOR_ARITH `vec 0 = (f:real^M->real^3) x - f x`) THEN
3380     ONCE_REWRITE_TAC[SET_RULE `{a,b} = {a} UNION {b}`] THEN
3381     REWRITE_TAC[GSYM IMAGE_UNION; SET_RULE
3382      `{a - b:real^3} = IMAGE (\x. x - b) {a}`] THEN
3383     REWRITE_TAC[ONCE_REWRITE_RULE[VECTOR_ADD_SYM] AFF_GE_TRANSLATION;
3384                 VECTOR_SUB] THEN
3385     ASM_REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `a + x:real^3 = b + x <=> a = b`;
3386                     UNWIND_THM1; SET_RULE `{a} UNION {b} = {a,b}`]] THEN
3387   ONCE_REWRITE_TAC[SET_RULE
3388    `(!x. ~P x /\ ~Q x /\ ~R x ==> J x) <=>
3389     (!x. x IN UNIV DIFF (({x | P x} UNION {x | Q x}) UNION {x | R x})
3390          ==> J x)`] THEN
3391   MATCH_MP_TAC(MESON[CONTINUOUS_ON_EQ_CONTINUOUS_AT]
3392    `open s /\ f continuous_on s ==> !z. z IN s ==> f continuous at z`) THEN
3393   CONJ_TAC THENL
3394    [REWRITE_TAC[GSYM closed] THEN
3395     MATCH_MP_TAC(MESON[]
3396      `!t'. s UNION t = s UNION t' /\ closed(s UNION t')
3397            ==> closed(s UNION t)`) THEN
3398     EXISTS_TAC
3399       `{z | (fstcart z cross fstcart(sndcart z)) cross
3400              fstcart z cross sndcart(sndcart z) = vec 0 /\
3401             &0 <= (fstcart z cross sndcart(sndcart z)) dot
3402                   (fstcart z cross fstcart(sndcart z))}` THEN
3403     CONJ_TAC THENL
3404      [MATCH_MP_TAC(SET_RULE
3405        `(!x. ~(x IN s) ==> (x IN t <=> x IN t'))
3406         ==> s UNION t = s UNION t'`) THEN
3407       REWRITE_TAC[AFF_GE_2_1_0_SEMIALGEBRAIC; IN_UNION; IN_ELIM_THM;
3408                   DE_MORGAN_THM];
3409       ALL_TAC] THEN
3410     MATCH_MP_TAC CLOSED_UNION THEN CONJ_TAC THENL
3411      [MATCH_MP_TAC CLOSED_UNION THEN CONJ_TAC THEN
3412       REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL] THEN
3413       ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
3414       REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN
3415       SIMP_TAC[SET_RULE `{x | f x = a} = {x | x IN UNIV /\ f x IN {a}}`] THEN
3416       MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
3417       SIMP_TAC[CLOSED_UNIV; CLOSED_SING; LIFT_SUB; REAL_POW_2; LIFT_CMUL] THEN
3418       MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
3419       CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
3420       REWRITE_TAC[o_DEF] THEN REPEAT CONJ_TAC THEN
3421       MATCH_MP_TAC CONTINUOUS_ON_LIFT_DOT2 THEN CONJ_TAC;
3422       ONCE_REWRITE_TAC[MESON[LIFT_DROP; real_ge]
3423        `&0 <= x <=> drop(lift x) >= &0`] THEN
3424       REWRITE_TAC[SET_RULE
3425        `{z | f z = vec 0 /\ drop(g z) >= &0} =
3426         {z | z IN UNIV /\ f z IN {vec 0}} INTER
3427         {z | z IN UNIV /\ g z IN {k | drop(k) >= &0}}`] THEN
3428       MATCH_MP_TAC CLOSED_INTER THEN
3429       CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
3430       REWRITE_TAC[CLOSED_SING; drop; CLOSED_UNIV;
3431                   CLOSED_HALFSPACE_COMPONENT_GE] THEN
3432       REPEAT((MATCH_MP_TAC CONTINUOUS_ON_CROSS ORELSE
3433               MATCH_MP_TAC CONTINUOUS_ON_LIFT_DOT2) THEN CONJ_TAC)] THEN
3434     TRY(GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF]) THEN
3435     SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON;
3436              LINEAR_FSTCART; LINEAR_SNDCART];
3437     MATCH_MP_TAC lemma THEN
3438     MAP_EVERY EXISTS_TAC
3439      [`{z | z IN UNIV /\ lift((fstcart z cross (fstcart(sndcart z))) dot
3440                               (sndcart(sndcart z))) IN {x | x$1 >= &0}}`;
3441       `{z | z IN UNIV /\ lift((fstcart z cross (fstcart(sndcart z))) dot
3442                               (sndcart(sndcart z))) IN {x | x$1 <= &0}}`;
3443       `\z. Cx(dihV (vec 0:real^3) (fstcart z)
3444                    (fstcart(sndcart z)) (sndcart(sndcart z)))`;
3445       `\z. Cx(&2 * pi - dihV (vec 0:real^3) (fstcart z)
3446                              (fstcart(sndcart z)) (sndcart(sndcart z)))`] THEN
3447     CONJ_TAC THENL
3448      [CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
3449       REWRITE_TAC[CLOSED_UNIV; CLOSED_HALFSPACE_COMPONENT_GE;
3450                   CLOSED_HALFSPACE_COMPONENT_LE] THEN
3451       MATCH_MP_TAC CONTINUOUS_ON_LIFT_DOT2 THEN
3452       (CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_CROSS; ALL_TAC]) THEN
3453       ONCE_REWRITE_TAC[GSYM o_DEF] THEN
3454       SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON;
3455                LINEAR_FSTCART; LINEAR_SNDCART];
3456       ALL_TAC] THEN
3457     CONJ_TAC THENL
3458      [REWRITE_TAC[EXTENSION; IN_UNION; IN_UNIV; IN_ELIM_THM] THEN
3459       REAL_ARITH_TAC;
3460       ALL_TAC] THEN
3461     CONJ_TAC THENL
3462      [CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
3463       REWRITE_TAC[FORALL_PASTECART; IN_DIFF; IN_UNIV; IN_UNION; IN_INTER;
3464         FSTCART_PASTECART; SNDCART_PASTECART; IN_ELIM_THM; DE_MORGAN_THM] THEN
3465       MAP_EVERY X_GEN_TAC [`x:real^3`; `y:real^3`; `z:real^3`] THEN
3466       REPEAT STRIP_TAC THEN REWRITE_TAC[CX_SUB] THEN
3467       TRY(MATCH_MP_TAC CONTINUOUS_SUB THEN REWRITE_TAC[CONTINUOUS_CONST]) THEN
3468       GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
3469       REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS] THEN
3470       MATCH_MP_TAC REAL_CONTINUOUS_AT_DIHV_COMPOSE THEN
3471       ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART;
3472                       CONTINUOUS_CONST] THEN
3473       ONCE_REWRITE_TAC[GSYM o_DEF] THEN
3474       SIMP_TAC[CONTINUOUS_AT_COMPOSE; LINEAR_CONTINUOUS_AT;
3475                LINEAR_FSTCART; LINEAR_SNDCART];
3476       ALL_TAC] THEN
3477     REWRITE_TAC[FORALL_PASTECART; IN_DIFF; IN_UNIV; IN_UNION; IN_INTER; CX_INJ;
3478         FSTCART_PASTECART; SNDCART_PASTECART; IN_ELIM_THM; DE_MORGAN_THM] THEN
3479     CONJ_TAC THENL
3480      [REWRITE_TAC[GSYM drop; LIFT_DROP; real_ge] THEN
3481       MAP_EVERY X_GEN_TAC [`x:real^3`; `y:real^3`; `z:real^3`] THEN
3482       REPEAT STRIP_TAC THEN MATCH_MP_TAC(GSYM AZIM_DIHV_SAME_STRONG) THEN
3483       ASM_REWRITE_TAC[AZIM_IN_UPPER_HALFSPACE; VECTOR_SUB_RZERO];
3484       REWRITE_TAC[GSYM drop; LIFT_DROP] THEN
3485       MAP_EVERY X_GEN_TAC [`x:real^3`; `y:real^3`; `z:real^3`] THEN
3486       REPEAT STRIP_TAC THEN MATCH_MP_TAC(GSYM AZIM_DIHV_COMPL) THEN
3487       ASM_REWRITE_TAC[] THEN
3488       MATCH_MP_TAC(REAL_ARITH
3489        `(x <= pi ==> x = pi) ==> pi <= x`) THEN
3490       ASM_REWRITE_TAC[AZIM_IN_UPPER_HALFSPACE; VECTOR_SUB_RZERO] THEN
3491       ASM_SIMP_TAC[REAL_ARITH `x <= &0 ==> (&0 <= x <=> x = &0)`] THEN
3492       REWRITE_TAC[REWRITE_RULE[VECTOR_SUB_RZERO]
3493          (SPEC `vec 0:real^3` (GSYM COPLANAR_CROSS_DOT))] THEN
3494       ASM_SIMP_TAC[GSYM AZIM_EQ_0_PI_EQ_COPLANAR; AZIM_EQ_0_GE_ALT]]]);;
3495
3496 let REAL_CONTINUOUS_AT_AZIM_COMPOSE = prove
3497  (`!f:real^M->real^3 g h k x.
3498       ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\
3499       ~(k x IN aff_ge {f x,g x} {h x}) /\
3500       f continuous (at x) /\ g continuous (at x) /\
3501       h continuous (at x) /\ k continuous (at x)
3502       ==> (\x. azim (f x) (g x) (h x) (k x)) real_continuous (at x)`,
3503   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
3504   REWRITE_TAC[REAL_CONTINUOUS_WITHIN_AZIM_COMPOSE]);;
3505
3506 let REAL_CONTINUOUS_WITHINREAL_AZIM_COMPOSE = prove
3507  (`!f:real->real^3 g h k x s.
3508       ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\
3509       ~(k x IN aff_ge {f x,g x} {h x}) /\
3510       f continuous (atreal x within s) /\ g continuous (atreal x within s) /\
3511       h continuous (atreal x within s) /\ k continuous (atreal x within s)
3512       ==> (\x. azim (f x) (g x) (h x) (k x)) real_continuous
3513           (atreal x within s)`,
3514   REWRITE_TAC[CONTINUOUS_CONTINUOUS_WITHINREAL;
3515               REAL_CONTINUOUS_REAL_CONTINUOUS_WITHINREAL] THEN
3516   SIMP_TAC[o_DEF; REAL_CONTINUOUS_WITHIN_AZIM_COMPOSE; LIFT_DROP]);;
3517
3518 let REAL_CONTINUOUS_ATREAL_AZIM_COMPOSE = prove
3519  (`!f:real->real^3 g h k x.
3520       ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\
3521       ~(k x IN aff_ge {f x,g x} {h x}) /\
3522       f continuous (atreal x) /\ g continuous (atreal x) /\
3523       h continuous (atreal x) /\ k continuous (atreal x)
3524       ==> (\x. azim (f x) (g x) (h x) (k x)) real_continuous (atreal x)`,
3525   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
3526   REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL_AZIM_COMPOSE]);;
3527
3528 (* ------------------------------------------------------------------------- *)
3529 (* Can consider angle as defined by arcV a zenith angle.                     *)
3530 (* ------------------------------------------------------------------------- *)
3531
3532 let ZENITH_EXISTS = prove
3533  (`!u v w:real^3.
3534        ~(u = v) /\ ~(w = v)
3535        ==> (?u' r phi e3.
3536                 phi = arcV v u w /\
3537                 r = dist(u,v) /\
3538                 dist(w,v) % e3 = w - v /\
3539                 u' dot e3 = &0 /\
3540                 u = v + u' + (r * cos phi) % e3)`,
3541   ONCE_REWRITE_TAC[VECTOR_ARITH
3542    `u:real^3 = v + u' + x <=> u - v = u' + x`] THEN
3543   GEN_GEOM_ORIGIN_TAC `v:real^3` ["u'"; "e3"] THEN
3544   REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN
3545   ONCE_REWRITE_TAC[VECTOR_ARITH
3546    `u:real^3 = u' + x <=> u - u' = x`] THEN
3547   GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN
3548   X_GEN_TAC `w:real` THEN ASM_CASES_TAC `w = &0` THEN
3549   ASM_REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LE_LT] THEN DISCH_TAC THEN
3550   SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_3; ARITH] THEN
3551   ASM_SIMP_TAC[REAL_ARITH `&0 < w ==> abs w * &1 = w`] THEN
3552   ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ] THEN
3553   REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN
3554   REWRITE_TAC[ARCV_ANGLE; angle; VECTOR_SUB_RZERO] THEN
3555   ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN REPEAT STRIP_TAC THEN
3556   MP_TAC(ISPECL [`u:real^3`; `w % basis 3:real^3`] VECTOR_ANGLE) THEN
3557   REWRITE_TAC[DOT_RMUL; NORM_MUL] THEN
3558   ASM_SIMP_TAC[REAL_ARITH
3559    `&0 < w ==> n * ((abs w) * x) * y = w * n * x * y`] THEN
3560   ASM_REWRITE_TAC[REAL_EQ_MUL_LCANCEL] THEN
3561   SIMP_TAC[NORM_BASIS; DIMINDEX_3; ARITH; REAL_MUL_LID] THEN
3562   DISCH_THEN(SUBST1_TAC o SYM) THEN
3563   REWRITE_TAC[VECTOR_ARITH `u - u':real^3 = x <=> u' = u - x`] THEN
3564   ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM2] THEN
3565   REWRITE_TAC[DOT_LSUB; DOT_RMUL; DOT_LMUL] THEN
3566   SIMP_TAC[DOT_BASIS_BASIS; DIMINDEX_3; ARITH] THEN REAL_ARITH_TAC);;
3567
3568 (* ------------------------------------------------------------------------- *)
3569 (* Spherical coordinates.                                                    *)
3570 (* ------------------------------------------------------------------------- *)
3571
3572 let SPHERICAL_COORDINATES = prove
3573  (`!u v w u' e1 e2 e3 r phi theta.
3574        ~collinear {v, w, u} /\
3575        ~collinear {v, w, u'} /\
3576        orthonormal e1 e2 e3 /\
3577        dist(w,v) % e3 = w - v /\
3578        (v + e1) IN aff_gt {v, w} {u} /\
3579        r = dist(v,u') /\
3580        phi = arcV v u' w /\
3581        theta = azim v w u u'
3582        ==> u' = v + (r * cos theta * sin phi) % e1 +
3583                     (r * sin theta * sin phi) % e2 +
3584                     (r * cos phi) % e3`,
3585   ONCE_REWRITE_TAC[VECTOR_ARITH
3586    `u':real^3 = u + v + w <=> u' - u = v + w`] THEN
3587   GEN_GEOM_ORIGIN_TAC `v:real^3` ["e1"; "e2"; "e3"] THEN
3588   REWRITE_TAC[VECTOR_ADD_RID; VECTOR_ADD_LID] THEN
3589   REWRITE_TAC[TRANSLATION_INVARIANTS `v:real^3`] THEN
3590   GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN
3591   REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN
3592   X_GEN_TAC `w:real` THEN ASM_CASES_TAC `w = &0` THENL
3593    [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
3594   ASM_REWRITE_TAC[REAL_LE_LT] THEN DISCH_TAC THEN
3595   MAP_EVERY X_GEN_TAC
3596    [`u:real^3`; `v:real^3`; `e1:real^3`; `e2:real^3`; `e3:real^3`;
3597     `r:real`; `phi:real`; `theta:real`] THEN
3598   ASM_CASES_TAC `u:real^3 = w % basis 3` THENL
3599    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
3600   ASM_CASES_TAC `v:real^3 = w % basis 3` THENL
3601    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
3602   DISCH_THEN(MP_TAC o GSYM) THEN
3603   ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE] THEN
3604   SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_3; ARITH] THEN
3605   ASM_SIMP_TAC[REAL_ARITH `&0 < w ==> abs w * &1 = w`] THEN
3606   ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL] THEN
3607   ASM_CASES_TAC `e3:real^3 = basis 3` THEN ASM_REWRITE_TAC[] THEN
3608   REWRITE_TAC[ARCV_ANGLE; angle; VECTOR_SUB_RZERO] THEN
3609   ASM_SIMP_TAC[VECTOR_ANGLE_RMUL; REAL_LT_IMP_LE] THEN
3610   ASM_CASES_TAC `u:real^3 = vec 0` THENL
3611    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
3612   ASM_CASES_TAC `v:real^3 = vec 0` THENL
3613    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
3614   ASM_CASES_TAC `u:real^3 = basis 3` THENL
3615    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
3616   ASM_CASES_TAC `v:real^3 = basis 3` THENL
3617    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
3618   STRIP_TAC THEN
3619   MP_TAC(ISPECL [`v:real^3`; `basis 3:real^3`] VECTOR_ANGLE) THEN
3620   ASM_SIMP_TAC[DOT_BASIS; NORM_BASIS; DIMINDEX_3; ARITH; REAL_MUL_LID] THEN
3621   DISCH_TAC THEN
3622   MP_TAC(ISPECL
3623    [`vec 0:real^3`; `w % basis 3:real^3`; `u:real^3`; `e1:real^3`]
3624         AZIM_EQ_0_ALT) THEN
3625   ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE] THEN
3626   ANTS_TAC THENL
3627    [SIMP_TAC[COLLINEAR_LEMMA; BASIS_NONZERO; DIMINDEX_3; ARITH] THEN
3628     STRIP_TAC THEN UNDISCH_TAC `orthonormal e1 e2 (basis 3)` THEN
3629     ASM_REWRITE_TAC[orthonormal; DOT_LZERO; REAL_OF_NUM_EQ; ARITH_EQ] THEN
3630     ASM_CASES_TAC `c = &0` THEN
3631     ASM_SIMP_TAC[VECTOR_MUL_LZERO; CROSS_LZERO; DOT_LZERO; REAL_LT_REFL;
3632                  DOT_LMUL; DOT_BASIS_BASIS; DIMINDEX_3; ARITH; REAL_MUL_RID];
3633     DISCH_TAC] THEN
3634   SUBGOAL_THEN
3635    `dropout 3 (v:real^3):real^2 =
3636     norm(dropout 3 (v:real^3):real^2) %
3637     (cos theta % (dropout 3 (e1:real^3)) +
3638      sin theta % (dropout 3 (e2:real^3)))`
3639   MP_TAC THENL
3640    [ALL_TAC;
3641     SUBGOAL_THEN `norm((dropout 3:real^3->real^2) v) = r * sin phi`
3642     SUBST1_TAC THENL
3643      [REWRITE_TAC[NORM_EQ_SQUARE] THEN CONJ_TAC THENL
3644        [ASM_MESON_TAC[REAL_LE_MUL; NORM_POS_LE; SIN_VECTOR_ANGLE_POS];
3645         ALL_TAC] THEN
3646       UNDISCH_TAC `(v:real^3)$3 = r * cos phi` THEN
3647       MATCH_MP_TAC(REAL_RING
3648        `x + a pow 2 = y + b pow 2 ==> a:real = b ==> x = y`) THEN
3649       REWRITE_TAC[REAL_POW_MUL; GSYM REAL_ADD_LDISTRIB] THEN
3650       REWRITE_TAC[SIN_CIRCLE; REAL_MUL_RID] THEN
3651       UNDISCH_THEN `norm(v:real^3) = r` (SUBST1_TAC o SYM) THEN
3652       REWRITE_TAC[NORM_POW_2; DOT_2; DOT_3] THEN
3653       SIMP_TAC[dropout; LAMBDA_BETA; DIMINDEX_2; ARITH] THEN
3654       REAL_ARITH_TAC;
3655       ALL_TAC] THEN
3656     REWRITE_TAC[CART_EQ; DIMINDEX_3; DIMINDEX_2; FORALL_3; FORALL_2] THEN
3657     SIMP_TAC[dropout; LAMBDA_BETA; DIMINDEX_2; ARITH; VECTOR_ADD_COMPONENT;
3658              VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_3] THEN
3659     REPEAT STRIP_TAC THEN TRY REAL_ARITH_TAC THEN
3660     ASM_REWRITE_TAC[] THEN
3661     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [orthonormal]) THEN
3662     SIMP_TAC[DOT_BASIS; DIMINDEX_3; ARITH] THEN CONV_TAC REAL_RING] THEN
3663   REPEAT(FIRST_X_ASSUM(MP_TAC o
3664     GEN_REWRITE_RULE LAND_CONV [AZIM_ARG])) THEN
3665   REPEAT(FIRST_X_ASSUM(MP_TAC o
3666     GEN_REWRITE_RULE RAND_CONV [COLLINEAR_BASIS_3])) THEN
3667   SUBGOAL_THEN `norm((dropout 3:real^3->real^2) e1) = &1 /\
3668                 norm((dropout 3:real^3->real^2) e2) = &1 /\
3669                 dropout 3 (e2:real^3) / dropout 3 (e1:real^3) = ii`
3670   MP_TAC THENL
3671    [MATCH_MP_TAC(TAUT `(a /\ b) /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN
3672     CONJ_TAC THENL
3673      [REWRITE_TAC[NORM_EQ_1] THEN
3674       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [orthonormal]) THEN
3675       SIMP_TAC[DOT_BASIS; DIMINDEX_3; ARITH; dropout; LAMBDA_BETA;
3676                DOT_2; DIMINDEX_2; DOT_3] THEN
3677       CONV_TAC REAL_RING;
3678       ALL_TAC] THEN
3679     ASM_CASES_TAC `dropout 3 (e1:real^3) = Cx(&0)` THEN
3680     ASM_SIMP_TAC[COMPLEX_NORM_CX; REAL_OF_NUM_EQ; ARITH_EQ; REAL_ABS_NUM] THEN
3681     ASM_SIMP_TAC[COMPLEX_FIELD
3682      `~(x = Cx(&0)) ==> (y / x = ii <=> y = ii * x)`] THEN
3683     DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORTHONORMAL_CROSS) THEN
3684     SIMP_TAC[CART_EQ; DIMINDEX_2; DIMINDEX_3; FORALL_2; FORALL_3;
3685              cross; VECTOR_3; BASIS_COMPONENT; ARITH; dropout; LAMBDA_BETA;
3686              complex_mul; ii; complex; RE_DEF; IM_DEF; VECTOR_2] THEN
3687     CONV_TAC REAL_RING;
3688     ALL_TAC] THEN
3689   SPEC_TAC(`(dropout 3:real^3->real^2) e2`,`d2:real^2`) THEN
3690   SPEC_TAC(`(dropout 3:real^3->real^2) e1`,`d1:real^2`) THEN
3691   SPEC_TAC(`(dropout 3:real^3->real^2) v`,`z:real^2`) THEN
3692   SPEC_TAC(`(dropout 3:real^3->real^2) u`,`w:real^2`) THEN
3693   POP_ASSUM_LIST(K ALL_TAC) THEN
3694   GEOM_BASIS_MULTIPLE_TAC 1 `w:real^2` THEN
3695   X_GEN_TAC `k:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN
3696   ASM_CASES_TAC `k = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
3697   REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN
3698   SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
3699   ASM_CASES_TAC `d1 = Cx(&1)` THENL
3700    [ASM_SIMP_TAC[COMPLEX_DIV_1; COMPLEX_MUL_LID] THEN
3701     REPEAT STRIP_TAC THEN MP_TAC(SPEC `z:complex` ARG) THEN
3702     ASM_REWRITE_TAC[CEXP_EULER; CX_SIN; CX_COS; COMPLEX_MUL_RID] THEN
3703     CONV_TAC COMPLEX_RING;
3704     ASM_REWRITE_TAC[ARG_EQ_0] THEN
3705     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [COMPLEX_EQ]) THEN
3706     REWRITE_TAC[RE_CX; IM_CX;real] THEN
3707     ASM_CASES_TAC `Im d1 = &0` THEN ASM_REWRITE_TAC[] THEN
3708     ASM_SIMP_TAC[REAL_NORM; real] THEN REAL_ARITH_TAC]);;
3709
3710 (* ------------------------------------------------------------------------- *)
3711 (* Definition of a wedge and invariance theorems.                            *)
3712 (* ------------------------------------------------------------------------- *)
3713
3714 let wedge = new_definition
3715  `wedge v0 v1 w1 w2 = {y | ~collinear {v0,v1,y} /\
3716                          &0 < azim v0 v1 w1 y /\
3717                          azim v0 v1 w1 y < azim v0 v1 w1 w2}`;;
3718
3719 let WEDGE_ALT = prove
3720  (`!v0 v1 w1 w2.
3721         ~(v0 = v1)
3722         ==> wedge v0 v1 w1 w2 = {y | ~(y IN affine hull {v0,v1}) /\
3723                                      &0 < azim v0 v1 w1 y /\
3724                                      azim v0 v1 w1 y < azim v0 v1 w1 w2}`,
3725   SIMP_TAC[wedge; COLLINEAR_3_AFFINE_HULL]);;
3726
3727 let WEDGE_TRANSLATION = prove
3728  (`!a v w w1 w2. wedge (a + v) (a + w) (a + w1) (a + w2) =
3729                  IMAGE (\x. a + x) (wedge v w w1 w2)`,
3730   REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN
3731   MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL
3732    [MESON_TAC[VECTOR_ARITH `a + (x - a):real^3 = x`]; ALL_TAC] THEN
3733   REWRITE_TAC[wedge; IN_ELIM_THM; AZIM_TRANSLATION] THEN
3734   REWRITE_TAC[SET_RULE
3735    `{a + x,a + y,a + z} = IMAGE (\x:real^N. a + x) {x,y,z}`] THEN
3736   REWRITE_TAC[COLLINEAR_TRANSLATION_EQ]);;
3737
3738 add_translation_invariants [WEDGE_TRANSLATION];;
3739
3740 let WEDGE_LINEAR_IMAGE = prove
3741  (`!f. linear f /\ (!x. norm(f x) = norm x) /\
3742        (2 <= dimindex(:3) ==> det(matrix f) = &1)
3743        ==> !v w w1 w2. wedge (f v) (f w) (f w1) (f w2) =
3744                        IMAGE f (wedge v w w1 w2)`,
3745   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
3746   MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL
3747    [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE;
3748                   ORTHOGONAL_TRANSFORMATION];
3749     ALL_TAC] THEN
3750   X_GEN_TAC `y:real^3` THEN REWRITE_TAC[wedge; IN_ELIM_THM] THEN
3751   BINOP_TAC THEN ASM_SIMP_TAC[AZIM_LINEAR_IMAGE] THEN
3752   SUBST1_TAC(SET_RULE `{f v,f w,f y} = IMAGE (f:real^3->real^3) {v,w,y}`) THEN
3753   ASM_MESON_TAC[COLLINEAR_LINEAR_IMAGE_EQ; PRESERVES_NORM_INJECTIVE]);;
3754
3755 add_linear_invariants [WEDGE_LINEAR_IMAGE];;
3756
3757 let WEDGE_SPECIAL_SCALE = prove
3758  (`!a v w1 w2.
3759         &0 < a /\
3760         ~collinear{vec 0,a % v,w1} /\
3761         ~collinear{vec 0,a % v,w2}
3762         ==> wedge (vec 0) (a % v) w1 w2 = wedge (vec 0) v w1 w2`,
3763   SIMP_TAC[wedge; AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE;
3764            REAL_LT_IMP_NZ]);;
3765
3766 let WEDGE_DEGENERATE = prove
3767  (`(!z w w1 w2. z = w ==> wedge z w w1 w2 = {}) /\
3768    (!z w w1 w2. collinear{z,w,w1} ==> wedge z w w1 w2 = {}) /\
3769    (!z w w1 w2. collinear{z,w,w2} ==> wedge z w w1 w2 = {})`,
3770   REWRITE_TAC[wedge] THEN SIMP_TAC[AZIM_DEGENERATE] THEN
3771   REWRITE_TAC[REAL_LT_REFL; REAL_LT_ANTISYM; EMPTY_GSPEC]);;
3772
3773 (* ------------------------------------------------------------------------- *)
3774 (* Basic relation between wedge and aff, so Tarski-type characterization.    *)
3775 (* ------------------------------------------------------------------------- *)
3776
3777 let AFF_GT_LEMMA = prove
3778  (`!v1 v2:real^N.
3779         &0 < t1 /\ ~(v2 = vec 0)
3780         ==> aff_gt {vec 0} {t1 % basis 1, v2} =
3781                 {a % basis 1 + b % v2 | &0 < a /\ &0 < b}`,
3782   REWRITE_TAC[AFFSIGN_ALT; aff_gt_def; sgn_gt; IN_ELIM_THM] THEN
3783   REWRITE_TAC[SET_RULE `{a} UNION {b,c} = {a,b,c}`] THEN
3784   REWRITE_TAC[SET_RULE `x IN {a} <=> a = x`] THEN
3785   ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN;
3786                RIGHT_EXISTS_AND_THM; REAL_LT_ADD; REAL_HALF; FINITE_EMPTY] THEN
3787   ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN
3788   REWRITE_TAC[IN_INSERT; VECTOR_ARITH `vec 0 = a % x <=> a % x = vec 0`] THEN
3789   ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ; BASIS_NONZERO;
3790                DIMINDEX_GE_1; LE_REFL] THEN
3791   REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN
3792   REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN
3793   REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
3794   REWRITE_TAC[REAL_ARITH `&1 - v - v' - v'' = &0 <=> v = &1 - v' - v''`] THEN
3795   ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?b c a. P a b c)`] THEN
3796   REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN
3797   REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
3798   AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `b:real` THEN
3799   REWRITE_TAC[VECTOR_ARITH `y - a - b:real^N = vec 0 <=> y = a + b`] THEN
3800   EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `a:real` STRIP_ASSUME_TAC) THENL
3801    [EXISTS_TAC `a * t1:real`; EXISTS_TAC `a / t1:real`] THEN
3802   ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; VECTOR_MUL_ASSOC] THEN
3803   ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ]);;
3804
3805 let WEDGE_LUNE_GT = prove
3806  (`!v0 v1 w1 w2.
3807         ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} /\
3808         &0 < azim v0 v1 w1 w2 /\ azim v0 v1 w1 w2 < pi
3809         ==> wedge v0 v1 w1 w2 = aff_gt {v0,v1} {w1,w2}`,
3810   let lemma = prove
3811    (`!a x:real^3. (?a. x = a % basis 3) <=> dropout 3 x:real^2 = vec 0`,
3812     SIMP_TAC[CART_EQ; FORALL_2; FORALL_3; DIMINDEX_2; DIMINDEX_3;
3813         dropout; LAMBDA_BETA; BASIS_COMPONENT; ARITH; REAL_MUL_RID;
3814         VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RZERO; UNWIND_THM1] THEN
3815     MESON_TAC[]) in
3816   REWRITE_TAC[wedge] THEN GEOM_ORIGIN_TAC `v0:real^3` THEN
3817   GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN
3818   X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN
3819   ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[] THENL
3820    [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
3821   ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE] THEN
3822   POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC THEN
3823   MAP_EVERY X_GEN_TAC [`w1:real^3`; `w2:real^3`] THEN
3824   REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
3825   ONCE_REWRITE_TAC[TAUT `~a /\ b /\ c <=> ~(~a ==> ~(b /\ c))`] THEN
3826   ASM_SIMP_TAC[AZIM_ARG] THEN REWRITE_TAC[COLLINEAR_BASIS_3] THEN
3827   RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN STRIP_TAC THEN
3828   REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN
3829   W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_SPECIAL_SCALE o rand o snd) THEN
3830   SUBGOAL_THEN
3831    `~(w1:real^3 = vec 0) /\ ~(w2:real^3 = vec 0) /\
3832     ~(w1 = basis 3) /\ ~(w2 = basis 3)`
3833   STRIP_ASSUME_TAC THENL
3834    [REPEAT STRIP_TAC THEN
3835     REPEAT(FIRST_X_ASSUM(MP_TAC o check (is_neg o concl))) THEN
3836     ASM_REWRITE_TAC[DROPOUT_BASIS_3; DROPOUT_0; DROPOUT_MUL; VECTOR_MUL_RZERO];
3837     ALL_TAC] THEN
3838   ANTS_TAC THENL
3839    [ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN
3840     DISCH_THEN(DISJ_CASES_THEN (SUBST_ALL_TAC o SYM)) THEN
3841     REPEAT(FIRST_X_ASSUM(MP_TAC o check (is_neg o concl))) THEN
3842     ASM_REWRITE_TAC[DROPOUT_BASIS_3; DROPOUT_0; DROPOUT_MUL; VECTOR_MUL_RZERO];
3843     DISCH_THEN SUBST1_TAC] THEN
3844   REWRITE_TAC[AFFSIGN_ALT; aff_gt_def; sgn_gt; IN_ELIM_THM] THEN
3845   REWRITE_TAC[SET_RULE `{a,b} UNION {c,d} = {a,b,d,c}`] THEN
3846   REWRITE_TAC[SET_RULE `x IN {a} <=> a = x`] THEN
3847   ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN;
3848                RIGHT_EXISTS_AND_THM; REAL_LT_ADD; REAL_HALF; FINITE_EMPTY] THEN
3849   ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN
3850   REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN
3851   MATCH_MP_TAC EQ_TRANS THEN
3852   EXISTS_TAC `{y | (dropout 3:real^3->real^2) y IN
3853                    aff_gt {vec 0}
3854                    {dropout 3 (w1:real^3),dropout 3 (w2:real^3)}}` THEN
3855   CONJ_TAC THENL
3856    [ALL_TAC;
3857     REWRITE_TAC[AFFSIGN_ALT; aff_gt_def; sgn_gt; IN_ELIM_THM] THEN
3858     REWRITE_TAC[SET_RULE `{a} UNION {b,c} = {a,b,c}`] THEN
3859     REWRITE_TAC[SET_RULE `x IN {a} <=> a = x`] THEN
3860     ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN;
3861                RIGHT_EXISTS_AND_THM; REAL_LT_ADD; REAL_HALF; FINITE_EMPTY] THEN
3862     ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN
3863     REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN
3864     REWRITE_TAC[REAL_EQ_SUB_RADD; RIGHT_AND_EXISTS_THM] THEN
3865     REWRITE_TAC[REAL_ARITH `&1 = x + v <=> v = &1 - x`] THEN
3866     ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> c /\ d /\ a /\ b`] THEN
3867     ONCE_REWRITE_TAC[MESON[]
3868       `(?a b c d. P a b c d) <=> (?b c d a. P a b c d)`] THEN
3869     REWRITE_TAC[UNWIND_THM2] THEN
3870     ONCE_REWRITE_TAC[MESON[]
3871       `(?a b c. P a b c) <=> (?c b a. P a b c)`] THEN
3872     REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[VECTOR_ARITH
3873      `y - a - b - c:real^N = vec 0 <=> y - b - c = a`] THEN
3874     REWRITE_TAC[LEFT_EXISTS_AND_THM; lemma] THEN
3875     REWRITE_TAC[DROPOUT_SUB; DROPOUT_MUL] THEN
3876     REWRITE_TAC[VECTOR_ARITH `y - a - b:real^2 = vec 0 <=> y = a + b`] THEN
3877     REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_SYM]] THEN
3878   MATCH_MP_TAC(SET_RULE
3879    `{x | P x} = s ==> {y | P(dropout 3 y)} = {y | dropout 3 y IN s}`) THEN
3880   MP_TAC(CONJ (ASSUME `~((dropout 3:real^3->real^2) w1 = vec 0)`)
3881               (ASSUME `~((dropout 3:real^3->real^2) w2 = vec 0)`)) THEN
3882   UNDISCH_TAC `Arg(dropout 3 (w2:real^3) / dropout 3 (w1:real^3)) < pi` THEN
3883   UNDISCH_TAC `&0 < Arg(dropout 3 (w2:real^3) / dropout 3 (w1:real^3))` THEN
3884   SPEC_TAC(`(dropout 3:real^3->real^2) w2`,`v2:complex`) THEN
3885   SPEC_TAC(`(dropout 3:real^3->real^2) w1`,`v1:complex`) THEN
3886   POP_ASSUM_LIST(K ALL_TAC) THEN GEOM_BASIS_MULTIPLE_TAC 1 `v1:complex` THEN
3887   X_GEN_TAC `v1:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN
3888   ASM_CASES_TAC `v1 = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
3889   SIMP_TAC[AFF_GT_LEMMA] THEN
3890   REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN
3891   ASM_SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID; CX_INJ] THEN DISCH_TAC THEN
3892   POP_ASSUM_LIST(K ALL_TAC) THEN X_GEN_TAC `z:complex` THEN
3893   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
3894   REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM] THEN CONJ_TAC THENL
3895    [X_GEN_TAC `w:complex` THEN STRIP_TAC THEN
3896     MP_TAC(SPECL [`\t. Arg(Cx t + Cx(&1 - t) * z)`;
3897                   `&0`; `&1`; `Arg w`] REAL_IVT_DECREASING) THEN
3898     REWRITE_TAC[REAL_POS; REAL_SUB_REFL; COMPLEX_MUL_LZERO] THEN
3899     REWRITE_TAC[REAL_SUB_RZERO; COMPLEX_ADD_LID; COMPLEX_MUL_LID] THEN
3900     ASM_SIMP_TAC[COMPLEX_ADD_RID; ARG_NUM; REAL_LT_IMP_LE] THEN ANTS_TAC THENL
3901      [REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
3902       REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS; IN_REAL_INTERVAL] THEN
3903       X_GEN_TAC `t:real` THEN STRIP_TAC THEN
3904       ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[o_ASSOC] THEN
3905       MATCH_MP_TAC CONTINUOUS_WITHINREAL_COMPOSE THEN
3906       REWRITE_TAC[] THEN CONJ_TAC THENL
3907        [MATCH_MP_TAC CONTINUOUS_ADD THEN CONJ_TAC THENL
3908          [GEN_REWRITE_TAC LAND_CONV [SYM(CONJUNCT2(SPEC_ALL I_O_ID))] THEN
3909           REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS] THEN
3910           REWRITE_TAC[I_DEF; REAL_CONTINUOUS_WITHIN_ID];
3911           MATCH_MP_TAC CONTINUOUS_COMPLEX_MUL THEN
3912           REWRITE_TAC[CONTINUOUS_CONST] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN
3913           REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS] THEN
3914           SIMP_TAC[REAL_CONTINUOUS_SUB; REAL_CONTINUOUS_CONST;
3915                    REAL_CONTINUOUS_WITHIN_ID]];
3916         MATCH_MP_TAC CONTINUOUS_WITHIN_SUBSET THEN
3917         EXISTS_TAC `{z | &0 <= Im z}` THEN CONJ_TAC THENL
3918          [MATCH_MP_TAC CONTINUOUS_WITHIN_UPPERHALF_ARG THEN
3919           ASM_CASES_TAC `t = &1` THENL
3920            [ASM_REWRITE_TAC[REAL_SUB_REFL] THEN CONV_TAC COMPLEX_RING;
3921             ALL_TAC] THEN
3922           DISCH_THEN(MP_TAC o AP_TERM `Im`) THEN
3923           REWRITE_TAC[IM_ADD; IM_CX; IM_MUL_CX; REAL_ADD_LID; REAL_ENTIRE] THEN
3924           ASM_REWRITE_TAC[REAL_SUB_0] THEN
3925           ASM_MESON_TAC[ARG_LT_PI; REAL_LT_IMP_NZ; REAL_LT_TRANS];
3926           REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; IN_REAL_INTERVAL] THEN
3927           REWRITE_TAC[IN_ELIM_THM; IM_ADD; IM_CX; IM_MUL_CX] THEN
3928           REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ADD_LID] THEN
3929           MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[GSYM ARG_LE_PI] THEN
3930           ASM_REAL_ARITH_TAC]];
3931       REWRITE_TAC[IN_REAL_INTERVAL] THEN
3932       DISCH_THEN(X_CHOOSE_THEN `t:real` MP_TAC) THEN
3933       ASM_CASES_TAC `t = &0` THENL
3934        [ASM_REWRITE_TAC[REAL_SUB_RZERO; COMPLEX_ADD_LID; COMPLEX_MUL_LID] THEN
3935         ASM_MESON_TAC[REAL_LT_REFL];
3936         ALL_TAC] THEN
3937       ASM_CASES_TAC `t = &1` THENL
3938        [ASM_REWRITE_TAC[REAL_SUB_REFL; COMPLEX_MUL_LZERO] THEN
3939         REWRITE_TAC[COMPLEX_ADD_RID; ARG_NUM] THEN ASM_MESON_TAC[REAL_LT_REFL];
3940         ALL_TAC] THEN
3941       GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_LE_LT] THEN
3942       ASM_REWRITE_TAC[] THEN ABBREV_TAC `u = Cx t + Cx(&1 - t) * z` THEN
3943       ASM_CASES_TAC `u = Cx(&0)` THENL
3944        [ASM_MESON_TAC[ARG_0; REAL_LT_REFL]; ALL_TAC] THEN
3945       STRIP_TAC THEN
3946       EXISTS_TAC `norm(w:complex) / norm(u:complex) * t` THEN
3947       EXISTS_TAC `norm(w:complex) / norm(u:complex) * (&1 - t)` THEN
3948       ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; COMPLEX_NORM_NZ; REAL_SUB_LT] THEN
3949       SIMP_TAC[CX_MUL; GSYM COMPLEX_MUL_ASSOC; GSYM COMPLEX_ADD_LDISTRIB] THEN
3950       ASM_REWRITE_TAC[CX_DIV] THEN
3951       ASM_SIMP_TAC[CX_INJ; COMPLEX_NORM_ZERO; COMPLEX_FIELD
3952         `~(nu = Cx(&0)) ==> (w = nw / nu * u <=> nu * w = nw * u)`] THEN
3953       GEN_REWRITE_TAC (BINOP_CONV o RAND_CONV) [ARG] THEN
3954       ASM_REWRITE_TAC[COMPLEX_MUL_AC]];
3955     MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN
3956     SUBGOAL_THEN `Cx a + Cx b * z = complex(a + b * Re z,b * Im z)`
3957     SUBST1_TAC THENL
3958      [REWRITE_TAC[COMPLEX_EQ; RE; IM; RE_ADD; IM_ADD; RE_CX; IM_CX;
3959                   RE_MUL_CX; IM_MUL_CX] THEN
3960       REAL_ARITH_TAC;
3961       ALL_TAC] THEN
3962     REWRITE_TAC[COMPLEX_EQ; IM; IM_CX] THEN
3963     SUBGOAL_THEN `&0 < Im z` ASSUME_TAC THENL
3964      [ASM_REWRITE_TAC[GSYM ARG_LT_PI]; ALL_TAC] THEN
3965     ASM_SIMP_TAC[ARG_ATAN_UPPERHALF; REAL_LT_MUL; REAL_LT_IMP_NZ; IM] THEN
3966     REWRITE_TAC[RE; REAL_SUB_LT; ATN_BOUNDS] THEN
3967     REWRITE_TAC[REAL_ARITH `pi / &2 - x < pi / &2 - y <=> y < x`] THEN
3968     REWRITE_TAC[ATN_MONO_LT_EQ] THEN
3969     ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_MUL] THEN
3970     ASM_SIMP_TAC[REAL_FIELD `&0 < z ==> w / z * b * z = b * w`] THEN
3971     ASM_REAL_ARITH_TAC]);;
3972
3973 let WEDGE_LUNE_GE = prove
3974  (`!v0 v1 w1 w2.
3975         ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} /\
3976         &0 < azim v0 v1 w1 w2 /\ azim v0 v1 w1 w2 < pi
3977         ==> {x | &0 <= azim v0 v1 w1 x /\
3978                  azim v0 v1 w1 x <= azim v0 v1 w1 w2} =
3979             aff_ge {v0,v1} {w1,w2}`,
3980   REPEAT GEN_TAC THEN
3981   MAP_EVERY (fun t -> ASM_CASES_TAC t THENL
3982        [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC] THEN NO_TAC; ALL_TAC])
3983    [`v1:real^3 = v0`; `w1:real^3 = v0`; `w2:real^3 = v0`;
3984     `w1:real^3 = v1`; `w2:real^3 = v1`] THEN
3985   ASM_CASES_TAC `w1:real^3 = w2` THEN
3986   ASM_REWRITE_TAC[AZIM_REFL; REAL_LT_REFL] THEN
3987   STRIP_TAC THEN ASM_SIMP_TAC[REAL_ARITH
3988    `&0 < a
3989     ==> (&0 <= x /\ x <= a <=> x = &0 \/ x = a \/ &0 < x /\ x < a)`] THEN
3990   MATCH_MP_TAC(SET_RULE
3991    `!c. c SUBSET {x | p x} /\ c SUBSET s /\
3992         ({x | ~(~c x ==> ~p x)} UNION {x | ~(~c x ==> ~q x)} UNION
3993          ({x | ~c x /\ r x} DIFF c) = s DIFF c)
3994         ==> {x | p x \/ q x \/ r x} = s`) THEN
3995   EXISTS_TAC `{x:real^3 | collinear {v0,v1,x}}` THEN
3996   ASM_SIMP_TAC[IN_ELIM_THM; AZIM_EQ_ALT; AZIM_EQ_0_ALT;
3997                GSYM wedge; WEDGE_LUNE_GT] THEN
3998   REPEAT CONJ_TAC THENL
3999    [ASM_SIMP_TAC[SUBSET; IN_ELIM_THM; AZIM_DEGENERATE];
4000     ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN
4001     REWRITE_TAC[SET_RULE `{x | x IN s} = s`] THEN
4002     MATCH_MP_TAC AFFINE_HULL_SUBSET_AFF_GE THEN
4003     ASM_REWRITE_TAC[DISJOINT_INSERT; IN_INSERT; NOT_IN_EMPTY; DISJOINT_EMPTY];
4004     ALL_TAC] THEN
4005   REWRITE_TAC[NOT_IMP] THEN MATCH_MP_TAC(SET_RULE
4006    `(!x. ~c x ==> (p x \/ q x \/ x IN t <=> x IN e))
4007     ==> {x | ~c x /\ p x} UNION {x | ~c x /\ q x} UNION (t DIFF {x | c x}) =
4008         e DIFF {x | c x}`) THEN
4009   X_GEN_TAC `y:real^3` THEN DISCH_TAC THEN
4010   W(MP_TAC o PART_MATCH (lhs o rand) AFF_GE_AFF_GT_DECOMP o rand o
4011     rand o snd) THEN
4012   ANTS_TAC THENL
4013    [ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN
4014     ASM_REWRITE_TAC[DISJOINT_INSERT; IN_INSERT; NOT_IN_EMPTY; DISJOINT_EMPTY];
4015     DISCH_THEN SUBST1_TAC] THEN
4016   REWRITE_TAC[IN_UNION] THEN
4017   REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; UNIONS_2] THEN
4018   ASM_SIMP_TAC[SET_RULE `~(w1 = w2) ==> {w1,w2} DELETE w1 = {w2}`;
4019                SET_RULE `~(w1 = w2) ==> {w1,w2} DELETE w2 = {w1}`] THEN
4020   REWRITE_TAC[IN_UNION; DISJ_ACI] THEN
4021   W(MP_TAC o PART_MATCH (lhs o rand) AFF_GE_AFF_GT_DECOMP o rand o lhand o
4022     rand o snd) THEN
4023   ANTS_TAC THENL
4024    [ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN
4025     ASM_REWRITE_TAC[DISJOINT_INSERT; IN_INSERT; NOT_IN_EMPTY; DISJOINT_EMPTY];
4026     DISCH_THEN SUBST1_TAC] THEN
4027   W(MP_TAC o PART_MATCH (lhs o rand) AFF_GE_AFF_GT_DECOMP o rand o lhand o
4028     rand o rand o snd) THEN
4029   ANTS_TAC THENL
4030    [ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN
4031     ASM_REWRITE_TAC[DISJOINT_INSERT; IN_INSERT; NOT_IN_EMPTY; DISJOINT_EMPTY];
4032     DISCH_THEN SUBST1_TAC] THEN
4033   REWRITE_TAC[IN_UNION] THEN
4034   REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; UNIONS_1] THEN
4035   REWRITE_TAC[SET_RULE `{a} DELETE a = {}`; AFF_GE_EQ_AFFINE_HULL] THEN
4036   ASM_MESON_TAC[COLLINEAR_3_AFFINE_HULL]);;
4037
4038 let WEDGE_LUNE = prove
4039  (`!v0 v1 w1 w2.
4040         ~coplanar{v0,v1,w1,w2} /\ azim v0 v1 w1 w2 < pi
4041         ==> wedge v0 v1 w1 w2 = aff_gt {v0,v1} {w1,w2}`,
4042   REPEAT STRIP_TAC THEN MATCH_MP_TAC WEDGE_LUNE_GT THEN
4043   ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
4044    [MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w1:real^3`; `w2:real^3`]
4045                 NOT_COPLANAR_NOT_COLLINEAR) THEN
4046     ASM_REWRITE_TAC[];
4047     MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w2:real^3`; `w1:real^3`]
4048                 NOT_COPLANAR_NOT_COLLINEAR) THEN
4049     ONCE_REWRITE_TAC[SET_RULE `{a,b,c,d} = {a,b,d,c}`] THEN
4050     ASM_REWRITE_TAC[];
4051     REWRITE_TAC[azim; REAL_LT_LE] THEN
4052     ASM_MESON_TAC[AZIM_EQ_0_PI_IMP_COPLANAR]]);;
4053
4054 let WEDGE = prove
4055  (`wedge v1 v2 w1 w2 =
4056         if collinear{v1,v2,w1} \/ collinear{v1,v2,w2} then {}
4057         else
4058           let z = v2 - v1 in
4059           let u1 = w1 - v1 in
4060           let u2 = w2 - v1 in
4061           let n = z cross u1 in
4062           let d =  n dot u2 in
4063           if w2 IN (aff_ge {v1,v2} {w1}) then {}
4064           else if w2 IN (aff_lt {v1,v2} {w1}) then aff_gt {v1,v2,w1} {v1 + n}
4065           else if d > &0 then aff_gt {v1,v2} {w1,w2}
4066           else (:real^3) DIFF aff_ge {v1,v2} {w1,w2}`,
4067   REPEAT GEN_TAC THEN COND_CASES_TAC THENL
4068    [FIRST_X_ASSUM DISJ_CASES_TAC THEN
4069     ASM_SIMP_TAC[WEDGE_DEGENERATE];
4070     POP_ASSUM MP_TAC THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC] THEN
4071   ASM_SIMP_TAC[GSYM AZIM_EQ_0_GE_ALT] THEN
4072   ASM_CASES_TAC `azim v1 v2 w1 w2 = &0` THENL
4073    [ASM_REWRITE_TAC[wedge] THEN
4074     ASM_REWRITE_TAC[REAL_LT_ANTISYM; LET_DEF; LET_END_DEF; EMPTY_GSPEC];
4075     ALL_TAC] THEN
4076   ASM_SIMP_TAC[GSYM AZIM_EQ_PI_ALT] THEN
4077   ASM_CASES_TAC `azim v1 v2 w1 w2 = pi` THEN ASM_REWRITE_TAC[] THEN
4078   REWRITE_TAC[LET_DEF; LET_END_DEF] THEN
4079   POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
4080   GEOM_ORIGIN_TAC `v1:real^3` THEN
4081   REWRITE_TAC[VECTOR_ADD_RID; TRANSLATION_INVARIANTS `v1:real^3`] THEN
4082   REWRITE_TAC[VECTOR_SUB_RZERO; VECTOR_ADD_LID] THEN
4083   GEOM_BASIS_MULTIPLE_TAC 3 `v2:real^3` THEN
4084   X_GEN_TAC `v2:real` THEN
4085   GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN
4086   (STRIP_TAC THENL
4087     [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC]) THEN
4088   ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE; REAL_LT_IMP_NZ;
4089                WEDGE_SPECIAL_SCALE] THEN
4090   (REPEAT GEN_TAC THEN
4091    MAP_EVERY (fun t -> ASM_CASES_TAC t THENL
4092         [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC] THEN NO_TAC; ALL_TAC])
4093     [`w1:real^3 = vec 0`; `w2:real^3 = vec 0`; `w1:real^3 = basis 3`;
4094      `w2:real^3 = basis 3`] THEN
4095    ASM_CASES_TAC `w1:real^3 = v2 % basis 3` THENL
4096     [ASM_REWRITE_TAC[COLLINEAR_LEMMA] THEN MESON_TAC[]; ALL_TAC] THEN
4097    ASM_CASES_TAC `w2:real^3 = v2 % basis 3` THENL
4098     [ASM_REWRITE_TAC[COLLINEAR_LEMMA] THEN MESON_TAC[]; ALL_TAC])
4099   THENL
4100    [REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION] THEN X_GEN_TAC `y:real^3` THEN
4101     MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
4102      `(dropout 3 (y:real^3)) IN
4103       aff_gt {vec 0:real^2,dropout 3 (w1:real^3)}
4104               {rotate2d (pi / &2) (dropout 3 (w1:real^3))}` THEN
4105     CONJ_TAC THENL
4106      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [AZIM_ARG]) THEN
4107       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (RAND_CONV o LAND_CONV)
4108        [AZIM_ARG]) THEN
4109       REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV
4110         [COLLINEAR_BASIS_3])) THEN
4111       POP_ASSUM_LIST(K ALL_TAC) THEN
4112       REWRITE_TAC[wedge; IN_ELIM_THM; AZIM_ARG; COLLINEAR_BASIS_3] THEN
4113       SPEC_TAC(`(dropout 3:real^3->real^2) y`,`x:real^2`) THEN
4114       SPEC_TAC(`(dropout 3:real^3->real^2) w2`,`v2:real^2`) THEN
4115       SPEC_TAC(`(dropout 3:real^3->real^2) w1`,`v1:real^2`) THEN
4116       GEOM_BASIS_MULTIPLE_TAC 1 `v1:complex` THEN
4117       X_GEN_TAC `v:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN
4118       ASM_CASES_TAC `v = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
4119       REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN
4120       SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID] THEN
4121       REWRITE_TAC[real; RE_DIV_CX; IM_DIV_CX; CX_INJ] THEN
4122       ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_EQ_LDIV_EQ; REAL_MUL_LZERO] THEN
4123       REPEAT STRIP_TAC THEN REWRITE_TAC[ARG_LT_PI; ROTATE2D_PI2] THEN
4124       W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_2_1 o rand o rand o snd) THEN
4125       ASM_REWRITE_TAC[DISJOINT_INSERT; DISJOINT_EMPTY; IN_SING] THEN
4126       ANTS_TAC THENL
4127        [CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN
4128         ASM_REWRITE_TAC[COMPLEX_ENTIRE; II_NZ; CX_INJ] THEN
4129         DISCH_THEN(MP_TAC o AP_TERM `Re`) THEN
4130         REWRITE_TAC[RE_MUL_II; RE_CX; IM_CX] THEN ASM_REAL_ARITH_TAC;
4131         DISCH_THEN SUBST1_TAC] THEN
4132       REWRITE_TAC[COMPLEX_CMUL; IN_ELIM_THM; COMPLEX_MUL_RZERO] THEN
4133       ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?b c a. P a b c)`] THEN
4134       REWRITE_TAC[REAL_ARITH `t1 + t2 = &1 <=> t1 = &1 - t2`] THEN
4135       REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2; COMPLEX_ADD_LID] THEN
4136       EQ_TAC THENL
4137        [DISCH_TAC THEN
4138         MAP_EVERY EXISTS_TAC [`Re x / v`; `Im x / v`] THEN
4139         ASM_SIMP_TAC[REAL_LT_DIV; COMPLEX_EQ; IM_ADD; RE_ADD] THEN
4140         REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; RE_CX; IM_CX; RE_II; IM_II] THEN
4141         UNDISCH_TAC `~(v = &0)` THEN CONV_TAC REAL_FIELD;
4142         REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
4143         MAP_EVERY X_GEN_TAC [`s:real`; `t:real`] THEN
4144         STRIP_TAC THEN ASM_REWRITE_TAC[COMPLEX_EQ; IM_ADD; RE_ADD] THEN
4145         REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; RE_CX; IM_CX; RE_II; IM_II] THEN
4146         ASM_SIMP_TAC[REAL_MUL_RZERO; REAL_MUL_LID; REAL_LT_MUL; REAL_ADD_LID;
4147                      REAL_MUL_LZERO] THEN
4148         MAP_EVERY UNDISCH_TAC [`&0 < v`; `&0 < t`] THEN
4149         CONV_TAC REAL_FIELD];
4150       ALL_TAC] THEN
4151     W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_3_1 o rand o rand o snd) THEN
4152     ANTS_TAC THENL
4153      [REWRITE_TAC[SET_RULE
4154        `DISJOINT {a,b,c} {x} <=> ~(x = a) /\ ~(x = b) /\ ~(x = c)`] THEN
4155       ASM_SIMP_TAC[CROSS_EQ_0; CROSS_EQ_SELF; VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ;
4156                    REAL_LT_IMP_NZ; BASIS_NONZERO; DIMINDEX_3;
4157                    ARITH; COLLINEAR_SPECIAL_SCALE];
4158       DISCH_THEN SUBST1_TAC] THEN
4159     W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_2_1 o rand o lhand o snd) THEN
4160     REWRITE_TAC[ROTATE2D_PI2] THEN ANTS_TAC THENL
4161      [REWRITE_TAC[SET_RULE `DISJOINT {a,b} {x} <=> ~(x = a) /\ ~(x = b)`] THEN
4162       REWRITE_TAC[COMPLEX_ENTIRE; COMPLEX_RING `ii * x = x <=> x = Cx(&0)`;
4163                   COMPLEX_VEC_0; II_NZ] THEN
4164       ASM_REWRITE_TAC[GSYM COMPLEX_VEC_0; GSYM COLLINEAR_BASIS_3];
4165       DISCH_THEN SUBST1_TAC] THEN
4166     REWRITE_TAC[IN_ELIM_THM; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
4167     ONCE_REWRITE_TAC[MESON[]
4168      `(?a b c d. P a b c d) <=> (?d c b a. P a b c d)`] THEN
4169     ONCE_REWRITE_TAC[REAL_ARITH `s + t = &1 <=> s = &1 - t`] THEN
4170     REWRITE_TAC[UNWIND_THM2; RIGHT_EXISTS_AND_THM] THEN
4171     ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?c b a. P a b c)`] THEN
4172     REWRITE_TAC[UNWIND_THM2; RIGHT_EXISTS_AND_THM] THEN
4173     REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
4174     SIMP_TAC[CART_EQ; FORALL_2; FORALL_3; DIMINDEX_2; DIMINDEX_3;
4175       dropout; LAMBDA_BETA; BASIS_COMPONENT; ARITH; REAL_MUL_RID;
4176       VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RZERO; UNWIND_THM1;
4177       VECTOR_ADD_COMPONENT; cross; VECTOR_3;
4178       REWRITE_RULE[RE_DEF; IM_DEF] RE_MUL_II;
4179       REWRITE_RULE[RE_DEF; IM_DEF] IM_MUL_II;
4180       REAL_ADD_LID; REAL_MUL_LZERO; REAL_SUB_REFL; REAL_ADD_RID;
4181       REAL_SUB_LZERO; REAL_SUB_RZERO] THEN
4182     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
4183     AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `s:real` THEN
4184     REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
4185     ASM_SIMP_TAC[EXISTS_REFL; REAL_FIELD
4186      `&0 < v ==> (x = a * v + b <=> a = (x - b) / v)`] THEN
4187     REWRITE_TAC[REAL_MUL_RNEG; REAL_MUL_ASSOC] THEN EQ_TAC THEN
4188     DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THENL
4189      [EXISTS_TAC `t / v2:real`; EXISTS_TAC `t * v2:real`] THEN
4190     ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_DIV; REAL_LT_IMP_NZ; REAL_LT_MUL];
4191     ALL_TAC] THEN
4192   REWRITE_TAC[CROSS_LMUL] THEN
4193   SIMP_TAC[cross; BASIS_COMPONENT; DIMINDEX_3; ARITH; DOT_3; VECTOR_3;
4194       VECTOR_MUL_COMPONENT; REAL_MUL_LZERO; REAL_SUB_RZERO; REAL_NEG_0;
4195            REAL_MUL_RZERO; REAL_SUB_LZERO; REAL_MUL_LID; REAL_ADD_RID] THEN
4196   REWRITE_TAC[REAL_ARITH
4197   `(v * --x2) * y1 + (v * x1) * y2 > &0 <=> &0 < v * (x1 * y2 - x2 * y1)`] THEN
4198   ASM_SIMP_TAC[REAL_LT_MUL_EQ; REAL_SUB_LT] THEN
4199   REWRITE_TAC[AZIM_ARG; COLLINEAR_BASIS_3] THEN STRIP_TAC THEN
4200   SUBGOAL_THEN
4201    `w1$2 * w2$1 < w1$1 * w2$2 <=>
4202     Arg(dropout 3 (w2:real^3) / dropout 3 (w1:real^3)) < pi`
4203   SUBST1_TAC THENL
4204    [MATCH_MP_TAC EQ_TRANS THEN
4205     EXISTS_TAC `&0 < Im(dropout 3 (w2:real^3) / dropout 3 (w1:real^3))` THEN
4206     CONJ_TAC THENL
4207      [REWRITE_TAC[IM_COMPLEX_DIV_GT_0] THEN
4208       REWRITE_TAC[complex_mul; cnj; RE_DEF; IM_DEF; complex] THEN
4209       SIMP_TAC[dropout; VECTOR_2; LAMBDA_BETA; DIMINDEX_3; ARITH;
4210                DIMINDEX_2] THEN
4211       REAL_ARITH_TAC;
4212       REWRITE_TAC[GSYM ARG_LT_PI] THEN ASM_MESON_TAC[ARG_LT_NZ]];
4213     ALL_TAC] THEN
4214   COND_CASES_TAC THENL
4215    [W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_SPECIAL_SCALE o rand o snd) THEN
4216     ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN
4217     DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC WEDGE_LUNE THEN
4218     ASM_SIMP_TAC[GSYM AZIM_EQ_0_PI_EQ_COPLANAR; COLLINEAR_BASIS_3] THEN
4219     ASM_REWRITE_TAC[AZIM_ARG];
4220     ALL_TAC] THEN
4221   REWRITE_TAC[wedge] THEN
4222   GEN_REWRITE_TAC (funpow 3 RAND_CONV) [SET_RULE `{a,b} = {b,a}`] THEN
4223   W(MP_TAC o PART_MATCH (rand o rand) WEDGE_LUNE_GE o rand o rand o snd) THEN
4224   ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE; REAL_LT_IMP_NZ; AZIM_SPECIAL_SCALE] THEN
4225   ASM_REWRITE_TAC[AZIM_ARG; COLLINEAR_BASIS_3] THEN ANTS_TAC THENL
4226    [ASM_REWRITE_TAC[ARG_LT_NZ] THEN
4227     ONCE_REWRITE_TAC[GSYM ARG_INV_EQ_0] THEN
4228     ASM_REWRITE_TAC[COMPLEX_INV_DIV] THEN
4229     ONCE_REWRITE_TAC[GSYM COMPLEX_INV_DIV] THEN
4230     ASM_SIMP_TAC[ARG_INV; GSYM ARG_EQ_0] THEN
4231     ASM_REAL_ARITH_TAC;
4232     ALL_TAC] THEN
4233   DISCH_THEN(SUBST1_TAC o SYM) THEN
4234   REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNIV; IN_ELIM_THM; ARG] THEN
4235   REWRITE_TAC[REAL_NOT_LE] THEN
4236   POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
4237   SPEC_TAC(`(dropout 3:real^3->real^2) w1`,`w:complex`) THEN
4238   SPEC_TAC(`(dropout 3:real^3->real^2) w2`,`z:complex`) THEN
4239   REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `x3:real^3` THEN
4240   SPEC_TAC(`(dropout 3:real^3->real^2) x3`,`x:complex`) THEN
4241   GEN_TAC THEN REWRITE_TAC[COMPLEX_VEC_0] THEN
4242   RULE_ASSUM_TAC(REWRITE_RULE[COMPLEX_VEC_0]) THEN
4243   ASM_CASES_TAC `x = Cx(&0)` THEN ASM_REWRITE_TAC[] THENL
4244    [ASM_REWRITE_TAC[complex_div; COMPLEX_MUL_LZERO; REAL_NOT_LT; ARG; ARG_0];
4245     ALL_TAC] THEN
4246   ASM_REWRITE_TAC[ARG_LT_NZ] THEN
4247   MAP_EVERY UNDISCH_TAC
4248    [`~(Arg (z / w) < pi)`;
4249     `~(Arg (z / w) = pi)`;
4250     `~(Arg (z / w) = &0)`;
4251     `~(x = Cx (&0))`;
4252     `~(w = Cx (&0))`;
4253     `~(z = Cx (&0))`] THEN
4254   POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN
4255   GEOM_BASIS_MULTIPLE_TAC 1 `w:complex` THEN
4256   X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN
4257   ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
4258   REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN
4259   SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID] THEN
4260   REWRITE_TAC[real; RE_DIV_CX; IM_DIV_CX; CX_INJ] THEN
4261   SIMP_TAC[complex_div; ARG_MUL_CX] THEN
4262   SIMP_TAC[ARG_INV; GSYM ARG_EQ_0; ARG_INV_EQ_0] THEN
4263   DISCH_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[GSYM complex_div] THEN
4264   ASM_CASES_TAC `Arg x = &0` THEN ASM_REWRITE_TAC[] THENL
4265    [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ARG_EQ_0]) THEN
4266     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
4267     REWRITE_TAC[REAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
4268     REWRITE_TAC[complex_div; CX_INJ] THEN
4269     ASM_SIMP_TAC[ARG_MUL_CX; REAL_LT_LE] THEN
4270     ASM_SIMP_TAC[ARG_INV; GSYM ARG_EQ_0];
4271     ALL_TAC] THEN
4272   REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
4273   SIMP_TAC[PI_POS; REAL_ARITH
4274    `&0 < pi ==> (~(z = &0) /\ ~(z = pi) /\ ~(z < pi) <=> pi < z)`] THEN
4275   STRIP_TAC THEN REWRITE_TAC[REAL_LT_SUB_RADD] THEN
4276   DISJ_CASES_TAC(REAL_ARITH `Arg z <= Arg x \/ Arg x < Arg z`) THENL
4277    [ASM_REWRITE_TAC[GSYM REAL_NOT_LE] THEN
4278     ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
4279     ASM_SIMP_TAC[GSYM ARG_LE_DIV_SUM] THEN
4280     SIMP_TAC[ARG; REAL_LT_IMP_LE];
4281     ALL_TAC] THEN
4282   ASM_REWRITE_TAC[] THEN
4283   MP_TAC(ISPECL [`x:complex`; `z:complex`] ARG_LE_DIV_SUM) THEN
4284   ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN DISCH_THEN SUBST1_TAC THEN
4285   MATCH_MP_TAC(REAL_ARITH
4286    `&0 <= x /\ ~(x = &0) /\ y = k - z ==> k < y + x + z`) THEN
4287   ASM_REWRITE_TAC[ARG] THEN
4288   GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM COMPLEX_INV_DIV] THEN
4289   MATCH_MP_TAC ARG_INV THEN REWRITE_TAC[REAL] THEN
4290   DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
4291   ABBREV_TAC `t = Re(z / x)` THEN UNDISCH_TAC `Arg x < Arg z` THEN
4292   UNDISCH_TAC `z / x = Cx t` THEN
4293   ASM_SIMP_TAC[COMPLEX_FIELD
4294    `~(x = Cx(&0)) ==> (z / x = t <=> z = t * x)`] THEN
4295   ASM_CASES_TAC `t = &0` THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO] THEN
4296   ASM_SIMP_TAC[ARG_MUL_CX; REAL_LT_LE]);;
4297
4298 let OPEN_WEDGE = prove
4299  (`!z:real^3 w w1 w2. open(wedge z w w1 w2)`,
4300   REPEAT GEN_TAC THEN
4301   ASM_CASES_TAC `z:real^3 = w \/  collinear{z,w,w1} \/ collinear{z,w,w2}` THENL
4302    [FIRST_X_ASSUM STRIP_ASSUME_TAC THEN
4303     ASM_SIMP_TAC[WEDGE_DEGENERATE; OPEN_EMPTY];
4304     FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[DE_MORGAN_THM]] THEN
4305   REWRITE_TAC[wedge] THEN GEOM_ORIGIN_TAC `z:real^3` THEN
4306   GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN
4307   X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN
4308   ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
4309   ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE] THEN
4310   REPEAT STRIP_TAC THEN
4311   ONCE_REWRITE_TAC[TAUT `~a /\ b /\ c <=> ~(~a ==> ~(b /\ c))`] THEN
4312   ASM_SIMP_TAC[AZIM_ARG] THEN REWRITE_TAC[COLLINEAR_BASIS_3] THEN
4313   RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN
4314   REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; DROPOUT_0] THEN
4315   MATCH_MP_TAC OPEN_DROPOUT_3 THEN
4316   UNDISCH_TAC `~((dropout 3:real^3->real^2) w1 = vec 0)` THEN
4317   UNDISCH_TAC `~((dropout 3:real^3->real^2) w2 = vec 0)` THEN
4318   SPEC_TAC(`(dropout 3:real^3->real^2) w2`,`v2:complex`) THEN
4319   SPEC_TAC(`(dropout 3:real^3->real^2) w1`,`v1:complex`) THEN
4320   POP_ASSUM_LIST(K ALL_TAC) THEN GEOM_BASIS_MULTIPLE_TAC 1 `v1:complex` THEN
4321   X_GEN_TAC `v1:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN
4322   ASM_CASES_TAC `v1 = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
4323   REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN
4324   SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID] THEN REPEAT STRIP_TAC THEN
4325   REWRITE_TAC[SET_RULE `{x | ~(x = a) /\ P x} = {x | P x} DIFF {a}`] THEN
4326   MATCH_MP_TAC OPEN_DIFF THEN REWRITE_TAC[CLOSED_SING] THEN
4327   MATCH_MP_TAC OPEN_ARG_LTT THEN
4328   SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_REFL; ARG]);;
4329
4330 let ARG_EQ_SUBSET_HALFLINE = prove
4331  (`!a. ?b. ~(b = vec 0) /\ {z | Arg z = a} SUBSET aff_ge {vec 0} {b}`,
4332   GEN_TAC THEN ASM_CASES_TAC `{z | Arg z = a} SUBSET {vec 0}` THENL
4333    [EXISTS_TAC `basis 1:real^2` THEN
4334     SIMP_TAC[BASIS_NONZERO; DIMINDEX_2; ARITH] THEN
4335     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
4336        SUBSET_TRANS)) THEN SIMP_TAC[SUBSET; IN_SING; ENDS_IN_HALFLINE];
4337     ALL_TAC] THEN
4338   FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
4339    `~(s SUBSET {a}) ==> ?z. ~(a = z) /\ z IN s`)) THEN
4340   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:complex` THEN
4341   REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
4342   ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
4343   X_GEN_TAC `x:complex` THEN
4344   ASM_CASES_TAC `x:complex = vec 0` THEN ASM_REWRITE_TAC[ENDS_IN_HALFLINE] THEN
4345   RULE_ASSUM_TAC(REWRITE_RULE[COMPLEX_VEC_0]) THEN ASM_SIMP_TAC[ARG_EQ] THEN
4346   DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN
4347   ASM_REWRITE_TAC[GSYM COMPLEX_CMUL] THEN
4348   REWRITE_TAC[HALFLINE_EXPLICIT; IN_ELIM_THM; VECTOR_MUL_RZERO] THEN
4349   MAP_EVERY EXISTS_TAC [`&1 - u`; `u:real`] THEN
4350   ASM_SIMP_TAC[VECTOR_ADD_LID; REAL_LT_IMP_LE] THEN ASM_REAL_ARITH_TAC);;
4351
4352 let ARG_DIV_EQ_SUBSET_HALFLINE = prove
4353  (`!w a. ~(w = vec 0)
4354          ==> ?b. ~(b = vec 0) /\
4355                  {z | Arg(z / w) = a} SUBSET aff_ge {vec 0} {b}`,
4356   REPEAT GEN_TAC THEN GEOM_BASIS_MULTIPLE_TAC 1 `w:complex` THEN
4357   X_GEN_TAC `w:real` THEN ASM_CASES_TAC `w = &0` THEN
4358   ASM_REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LE_LT] THEN DISCH_TAC THEN
4359   X_GEN_TAC `a:real` THEN DISCH_THEN(K ALL_TAC) THEN
4360   ASM_SIMP_TAC[ARG_DIV_CX; COMPLEX_CMUL; COMPLEX_BASIS; GSYM CX_MUL;
4361                REAL_MUL_RID; ARG_EQ_SUBSET_HALFLINE]);;
4362
4363 let COPLANAR_AZIM_EQ = prove
4364  (`!v0 v1 w1 a.
4365      (collinear{v0,v1,w1} ==> ~(a = &0))
4366      ==> coplanar {z | azim v0 v1 w1 z = a}`,
4367   REPEAT GEN_TAC THEN ASM_CASES_TAC `collinear{v0:real^3,v1,w1}` THENL
4368    [ASM_SIMP_TAC[azim_def; EMPTY_GSPEC; COPLANAR_EMPTY]; ALL_TAC] THEN
4369   ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN
4370   GEOM_ORIGIN_TAC `v0:real^3` THEN
4371   GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN
4372   X_GEN_TAC `v1:real` THEN ASM_CASES_TAC `v1 = &0` THENL
4373    [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
4374   ASM_SIMP_TAC[REAL_LE_LT; COLLINEAR_SPECIAL_SCALE] THEN REPEAT STRIP_TAC THEN
4375   ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; AZIM_ARG] THEN
4376   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [COLLINEAR_BASIS_3]) THEN
4377   POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^2`
4378    STRIP_ASSUME_TAC o SPEC `a:real` o MATCH_MP ARG_DIV_EQ_SUBSET_HALFLINE) THEN
4379   REWRITE_TAC[coplanar] THEN MAP_EVERY EXISTS_TAC
4380    [`vec 0:real^3`; `pushin 3 (&0) (b:real^2):real^3`; `basis 3:real^3`] THEN
4381   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
4382   REWRITE_TAC[AFFINE_HULL_3; HALFLINE; SUBSET; IN_ELIM_THM] THEN
4383   DISCH_THEN(fun th -> X_GEN_TAC `x:real^3` THEN DISCH_TAC THEN
4384    MP_TAC(SPEC `(dropout 3:real^3->real^2) x` th)) THEN
4385   ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
4386   DISCH_THEN(X_CHOOSE_THEN `v:real` STRIP_ASSUME_TAC) THEN
4387   MAP_EVERY EXISTS_TAC [`&1 - v - (x:real^3)$3`; `v:real`; `(x:real^3)$3`] THEN
4388   CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN
4389   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN
4390   SIMP_TAC[CART_EQ; DIMINDEX_2; DIMINDEX_3; FORALL_2; FORALL_3; LAMBDA_BETA;
4391            dropout; pushin; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; ARITH;
4392            BASIS_COMPONENT] THEN
4393   REAL_ARITH_TAC);;
4394
4395 (* ------------------------------------------------------------------------- *)
4396 (* Volume of a tetrahedron defined by conv0.                                 *)
4397 (* ------------------------------------------------------------------------- *)
4398
4399 let delta_x = new_definition
4400  `delta_x x1 x2 x3 x4 x5 x6 =
4401         x1*x4*(--x1 + x2 + x3 -x4 + x5 + x6) +
4402         x2*x5*(x1 - x2 + x3 + x4 -x5 + x6) +
4403         x3*x6*(x1 + x2 - x3 + x4 + x5 - x6)
4404         -x2*x3*x4 - x1*x3*x5 - x1*x2*x6 -x4*x5*x6:real`;;
4405
4406 let VOLUME_OF_CLOSED_TETRAHEDRON = prove
4407  (`!x1 x2 x3 x4:real^3.
4408      measure(convex hull {x1,x2,x3,x4}) =
4409      sqrt(delta_x (dist(x1,x2) pow 2) (dist(x1,x3) pow 2) (dist(x1,x4) pow 2)
4410                   (dist(x3,x4) pow 2) (dist(x2,x4) pow 2) (dist(x2,x3) pow 2))
4411       / &12`,
4412   REPEAT GEN_TAC THEN REWRITE_TAC[LET_DEF; LET_END_DEF] THEN
4413   REWRITE_TAC[MEASURE_TETRAHEDRON] THEN
4414   REWRITE_TAC[REAL_ARITH `x / &6 = y / &12 <=> y = &2 * x`] THEN
4415   MATCH_MP_TAC SQRT_UNIQUE THEN
4416   SIMP_TAC[REAL_LE_MUL; REAL_ABS_POS; REAL_POS] THEN
4417   REWRITE_TAC[REAL_POW_MUL; REAL_POW2_ABS; delta_x] THEN
4418   REWRITE_TAC[dist; NORM_POW_2] THEN
4419   SIMP_TAC[DOT_3; VECTOR_SUB_COMPONENT; DIMINDEX_3; ARITH] THEN
4420   CONV_TAC REAL_RING);;
4421
4422 let VOLUME_OF_TETRAHEDRON = prove
4423  (`!v1 v2 v3 v4:real^3.
4424         measure(conv0 {v1,v2,v3,v4}) =
4425             let x12 = dist(v1,v2) pow 2 in
4426             let x13 = dist(v1,v3) pow 2 in
4427             let x14 = dist(v1,v4) pow 2 in
4428             let x23 = dist(v2,v3) pow 2 in
4429             let x24 = dist(v2,v4) pow 2 in
4430             let x34 = dist(v3,v4) pow 2 in
4431             sqrt(delta_x x12 x13 x14 x34 x24 x23)/(&12)`,
4432   REPEAT GEN_TAC THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN
4433   ASM_SIMP_TAC[GSYM VOLUME_OF_CLOSED_TETRAHEDRON] THEN
4434   MATCH_MP_TAC MEASURE_CONV0_CONVEX_HULL THEN
4435   SIMP_TAC[DIMINDEX_3; FINITE_INSERT; FINITE_EMPTY; CARD_CLAUSES] THEN
4436   ARITH_TAC);;
4437
4438 (* ------------------------------------------------------------------------- *)
4439 (* Circle area. Should maybe extend WLOG tactics for such scaling.           *)
4440 (* ------------------------------------------------------------------------- *)
4441
4442 let AREA_UNIT_CBALL = prove
4443  (`measure(cball(vec 0:real^2,&1)) = pi`,
4444   REPEAT STRIP_TAC THEN
4445   MATCH_MP_TAC(INST_TYPE[`:1`,`:M`; `:2`,`:N`] FUBINI_SIMPLE_COMPACT) THEN
4446   EXISTS_TAC `1` THEN
4447   SIMP_TAC[DIMINDEX_1; DIMINDEX_2; ARITH; COMPACT_CBALL; SLICE_CBALL] THEN
4448   REWRITE_TAC[VEC_COMPONENT; DROPOUT_0; REAL_SUB_RZERO] THEN
4449   ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[MEASURE_EMPTY] THEN
4450   SUBGOAL_THEN `!t. abs(t) <= &1 <=> t IN real_interval[-- &1,&1]`
4451    (fun th -> REWRITE_TAC[th])
4452   THENL [REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN
4453   REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV; BALL_1] THEN
4454   MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN
4455   EXISTS_TAC `\t. &2 * sqrt(&1 - t pow 2)` THEN CONJ_TAC THENL
4456    [X_GEN_TAC `t:real` THEN SIMP_TAC[IN_REAL_INTERVAL; MEASURE_INTERVAL] THEN
4457     REWRITE_TAC[REAL_BOUNDS_LE; VECTOR_ADD_LID; VECTOR_SUB_LZERO] THEN
4458     DISCH_TAC THEN
4459     W(MP_TAC o PART_MATCH (lhs o rand) CONTENT_1 o rand o snd) THEN
4460     REWRITE_TAC[LIFT_DROP; DROP_NEG] THEN
4461     ANTS_TAC THENL [ALL_TAC; SIMP_TAC[REAL_POW_ONE] THEN REAL_ARITH_TAC] THEN
4462     MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> --x <= x`) THEN
4463     ASM_SIMP_TAC[SQRT_POS_LE; REAL_SUB_LE; GSYM REAL_LE_SQUARE_ABS;
4464                  REAL_ABS_NUM];
4465     ALL_TAC] THEN
4466   MP_TAC(ISPECL
4467    [`\x.  asn(x) + x * sqrt(&1 - x pow 2)`;
4468     `\x. &2 * sqrt(&1 - x pow 2)`;
4469     `-- &1`; `&1`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR) THEN
4470   REWRITE_TAC[ASN_1; ASN_NEG_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
4471   REWRITE_TAC[SQRT_0; REAL_MUL_RZERO; REAL_ADD_RID] THEN
4472   REWRITE_TAC[REAL_ARITH `x / &2 - --(x / &2) = x`] THEN
4473   DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL
4474    [MATCH_MP_TAC REAL_CONTINUOUS_ON_ADD THEN
4475     SIMP_TAC[REAL_CONTINUOUS_ON_ASN; IN_REAL_INTERVAL; REAL_BOUNDS_LE] THEN
4476     MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN
4477     REWRITE_TAC[REAL_CONTINUOUS_ON_ID] THEN
4478     GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
4479     MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN
4480     SIMP_TAC[REAL_CONTINUOUS_ON_SUB; REAL_CONTINUOUS_ON_POW;
4481              REAL_CONTINUOUS_ON_ID; REAL_CONTINUOUS_ON_CONST] THEN
4482     MATCH_MP_TAC REAL_CONTINUOUS_ON_SQRT THEN
4483     REWRITE_TAC[FORALL_IN_IMAGE; IN_REAL_INTERVAL] THEN
4484     REWRITE_TAC[REAL_ARITH `&0 <= &1 - x <=> x <= &1 pow 2`] THEN
4485     REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS; REAL_ABS_NUM] THEN
4486     REAL_ARITH_TAC;
4487     REWRITE_TAC[IN_REAL_INTERVAL; REAL_BOUNDS_LT] THEN REPEAT STRIP_TAC THEN
4488     REAL_DIFF_TAC THEN
4489     CONV_TAC NUM_REDUCE_CONV THEN
4490     REWRITE_TAC[REAL_MUL_LID; REAL_POW_1; REAL_MUL_RID] THEN
4491     REWRITE_TAC[REAL_SUB_LZERO; REAL_MUL_RNEG; REAL_INV_MUL] THEN
4492     ASM_REWRITE_TAC[REAL_SUB_LT; ABS_SQUARE_LT_1] THEN
4493     MATCH_MP_TAC(REAL_FIELD
4494      `s pow 2 = &1 - x pow 2 /\ x pow 2 < &1
4495       ==> (inv s + x * --(&2 * x) * inv (&2) * inv s + s) = &2 * s`) THEN
4496     ASM_SIMP_TAC[ABS_SQUARE_LT_1; SQRT_POW_2; REAL_SUB_LE; REAL_LT_IMP_LE]]);;
4497
4498 let AREA_CBALL = prove
4499  (`!z:real^2 r. &0 <= r ==> measure(cball(z,r)) = pi * r pow 2`,
4500   REPEAT STRIP_TAC THEN ASM_CASES_TAC `r = &0` THENL
4501    [ASM_SIMP_TAC[CBALL_SING; REAL_POW_2; REAL_MUL_RZERO] THEN
4502     MATCH_MP_TAC MEASURE_UNIQUE THEN
4503     REWRITE_TAC[HAS_MEASURE_0; NEGLIGIBLE_SING];
4504     ALL_TAC] THEN
4505   SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
4506   MP_TAC(ISPECL [`cball(vec 0:real^2,&1)`; `r:real`; `z:real^2`; `pi`]
4507         HAS_MEASURE_AFFINITY) THEN
4508   REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_CBALL;
4509               AREA_UNIT_CBALL] THEN
4510   ASM_REWRITE_TAC[real_abs; DIMINDEX_2] THEN
4511   DISCH_THEN(MP_TAC o CONJUNCT2) THEN
4512   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN
4513   DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN
4514   MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
4515   REWRITE_TAC[IN_CBALL_0; IN_IMAGE] THEN REWRITE_TAC[IN_CBALL] THEN
4516   REWRITE_TAC[NORM_ARITH `dist(z,a + z) = norm a`; NORM_MUL] THEN
4517   ONCE_REWRITE_TAC[REAL_ARITH `abs r * x <= r <=> abs r * x <= r * &1`] THEN
4518   ASM_SIMP_TAC[real_abs; REAL_LE_LMUL; dist] THEN X_GEN_TAC `w:real^2` THEN
4519   DISCH_TAC THEN EXISTS_TAC `inv(r) % (w - z):real^2` THEN
4520   ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV] THEN
4521   CONJ_TAC THENL [NORM_ARITH_TAC; ALL_TAC] THEN
4522   REWRITE_TAC[NORM_MUL; REAL_ABS_INV] THEN ASM_REWRITE_TAC[real_abs] THEN
4523   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
4524   ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_MUL_LID] THEN
4525   ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_REWRITE_TAC[]);;
4526
4527 let AREA_BALL = prove
4528  (`!z:real^2 r. &0 <= r ==> measure(ball(z,r)) = pi * r pow 2`,
4529   SIMP_TAC[GSYM INTERIOR_CBALL; GSYM AREA_CBALL] THEN
4530   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_INTERIOR THEN
4531   SIMP_TAC[BOUNDED_CBALL; NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_CBALL]);;
4532
4533 (* ------------------------------------------------------------------------- *)
4534 (* Volume of a ball.                                                         *)
4535 (* ------------------------------------------------------------------------- *)
4536
4537 let VOLUME_CBALL = prove
4538  (`!z:real^3 r. &0 <= r ==> measure(cball(z,r)) = &4 / &3 * pi * r pow 3`,
4539   GEOM_ORIGIN_TAC `z:real^3` THEN REPEAT STRIP_TAC THEN
4540   MATCH_MP_TAC(INST_TYPE[`:2`,`:M`; `:3`,`:N`] FUBINI_SIMPLE_COMPACT) THEN
4541   EXISTS_TAC `1` THEN
4542   SIMP_TAC[DIMINDEX_2; DIMINDEX_3; ARITH; COMPACT_CBALL; SLICE_CBALL] THEN
4543   REWRITE_TAC[VEC_COMPONENT; DROPOUT_0; REAL_SUB_RZERO] THEN
4544   ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[MEASURE_EMPTY] THEN
4545   SUBGOAL_THEN `!t. abs(t) <= r <=> t IN real_interval[--r,r]`
4546    (fun th -> REWRITE_TAC[th])
4547   THENL [REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN
4548   REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN
4549   MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN
4550   EXISTS_TAC `\t. pi * (r pow 2 - t pow 2)` THEN CONJ_TAC THENL
4551    [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL; REAL_BOUNDS_LE] THEN
4552     SIMP_TAC[AREA_CBALL; SQRT_POS_LE; REAL_SUB_LE; GSYM REAL_LE_SQUARE_ABS;
4553              SQRT_POW_2; REAL_ARITH `abs x <= r ==> abs x <= abs r`];
4554     ALL_TAC] THEN
4555   MP_TAC(ISPECL
4556    [`\t. pi * (r pow 2 * t - &1 / &3 * t pow 3)`;
4557     `\t. pi * (r pow 2 - t pow 2)`;
4558     `--r:real`; `r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN
4559   REWRITE_TAC[] THEN ANTS_TAC THENL
4560    [CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
4561     REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN
4562     CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING;
4563     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
4564     CONV_TAC REAL_RING]);;
4565
4566 let VOLUME_BALL = prove
4567  (`!z:real^3 r. &0 <= r ==> measure(ball(z,r)) =  &4 / &3 * pi * r pow 3`,
4568   SIMP_TAC[GSYM INTERIOR_CBALL; GSYM VOLUME_CBALL] THEN
4569   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_INTERIOR THEN
4570   SIMP_TAC[BOUNDED_CBALL; NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_CBALL]);;
4571
4572 (* ------------------------------------------------------------------------- *)
4573 (* Frustum.                                                                  *)
4574 (* ------------------------------------------------------------------------- *)
4575
4576 let rconesgn = new_definition
4577   `rconesgn sgn v w h =
4578        {x:real^A | sgn ((x-v) dot (w-v)) (dist(x,v)*dist(w,v)*h)}`;;
4579
4580 let rcone_gt = new_definition `rcone_gt = rconesgn ( > )`;;
4581
4582 let rcone_ge = new_definition `rcone_ge = rconesgn ( >= )`;;
4583
4584 let rcone_eq = new_definition `rcone_eq = rconesgn ( = )`;;
4585
4586 let frustum = new_definition
4587   `frustum v0 v1 h1 h2 a =
4588      { y:real^N | rcone_gt v0 v1 a y /\
4589                   let d = (y - v0) dot (v1 - v0) in
4590                   let n = norm(v1 - v0) in
4591                   (h1*n < d /\ d < h2*n)}`;;
4592
4593 let frustt = new_definition `frustt v0 v1 h a = frustum v0 v1 (&0) h a`;;
4594
4595 let FRUSTUM_DEGENERATE = prove
4596  (`!v0 h1 h2 a. frustum v0 v0 h1 h2 a = {}`,
4597   REWRITE_TAC[frustum; VECTOR_SUB_REFL; NORM_0; DOT_RZERO] THEN
4598   CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN
4599   REWRITE_TAC[REAL_MUL_RZERO; REAL_LT_REFL] THEN SET_TAC[]);;
4600
4601 let CONVEX_RCONE_GT = prove
4602  (`!v0 v1:real^N a. &0 <= a ==> convex(rcone_gt v0 v1 a)`,
4603   REWRITE_TAC[rcone_gt; rconesgn] THEN
4604   GEOM_ORIGIN_TAC `v0:real^N` THEN REPEAT GEN_TAC THEN
4605   REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN
4606   REWRITE_TAC[CONVEX_ALT; IN_ELIM_THM; real_gt; DOT_LADD; DOT_LMUL] THEN
4607   DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `t:real`] THEN
4608   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
4609   EXISTS_TAC `(&1 - t) * norm(x:real^N) * norm v1 * a +
4610               t * norm(y:real^N) * norm(v1:real^N) * a` THEN
4611   CONJ_TAC THENL
4612    [REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; REAL_MUL_ASSOC] THEN
4613     MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[] THEN
4614     MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN
4615     MATCH_MP_TAC(NORM_ARITH
4616      `norm(x:real^N) = a /\ norm(y) = b ==> norm(x + y) <= a + b`) THEN
4617     REWRITE_TAC[NORM_MUL] THEN CONJ_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
4618     ASM_REAL_ARITH_TAC;
4619     MATCH_MP_TAC REAL_CONVEX_BOUND2_LT THEN ASM_REAL_ARITH_TAC]);;
4620
4621 let OPEN_RCONE_GT = prove
4622  (`!v0 v1:real^N a. open(rcone_gt v0 v1 a)`,
4623   REWRITE_TAC[rcone_gt; rconesgn] THEN
4624   GEOM_ORIGIN_TAC `v0:real^N` THEN REPEAT GEN_TAC THEN
4625   REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN
4626   MP_TAC(ISPECL [`\x:real^N. lift(x dot v1 - norm x * norm v1 * a)`;
4627                  `{x:real^1 | x$1 > &0}`]
4628         CONTINUOUS_OPEN_PREIMAGE_UNIV) THEN
4629   REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_GT] THEN REWRITE_TAC[GSYM drop] THEN
4630   REWRITE_TAC[IN_ELIM_THM; real_gt; REAL_SUB_LT; LIFT_DROP] THEN
4631   DISCH_THEN MATCH_MP_TAC THEN GEN_TAC THEN REWRITE_TAC[LIFT_SUB] THEN
4632   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_CMUL] THEN
4633   MATCH_MP_TAC CONTINUOUS_SUB THEN ONCE_REWRITE_TAC[DOT_SYM] THEN
4634   REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_DOT] THEN
4635   MATCH_MP_TAC CONTINUOUS_CMUL THEN
4636   REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_NORM]);;
4637
4638 let RCONE_GT_NEG = prove
4639  (`!v0 v1:real^N a.
4640         rcone_gt v0 v1 (--a) =
4641          IMAGE (\x. &2 % v0 - x) ((:real^N) DIFF rcone_ge v0 v1 a)`,
4642   REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN
4643   MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[] THEN CONJ_TAC THENL
4644    [MESON_TAC[VECTOR_ARITH `a - (a - b):real^N = b`];
4645     REWRITE_TAC[rcone_gt; rconesgn; rcone_ge;
4646                 IN_ELIM_THM; IN_DIFF; IN_UNIV] THEN
4647     REWRITE_TAC[NORM_ARITH `dist(&2 % x - y,x) = dist(y,x)`] THEN
4648     REWRITE_TAC[VECTOR_ARITH `&2 % v - x - v:real^N = --(x - v)`] THEN
4649     REWRITE_TAC[DOT_LNEG] THEN REAL_ARITH_TAC]);;
4650
4651 let VOLUME_FRUSTT_STRONG = prove
4652  (`!v0 v1:real^3 h a.
4653        &0 < a
4654        ==> bounded(frustt v0 v1 h a) /\
4655            convex(frustt v0 v1 h a) /\
4656            measurable(frustt v0 v1 h a) /\
4657            measure(frustt v0 v1 h a) =
4658            if v1 = v0 \/ &1 <= a \/ h < &0 then &0
4659            else pi * ((h / a) pow 2 - h pow 2) * h / &3`,
4660   REPEAT GEN_TAC THEN DISCH_TAC THEN
4661   REWRITE_TAC[frustt; frustum; rcone_gt; rconesgn; IN_ELIM_THM] THEN
4662   CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN GEOM_ORIGIN_TAC `v0:real^3` THEN
4663   REWRITE_TAC[VECTOR_SUB_RZERO; REAL_MUL_LZERO; DIST_0; real_gt] THEN
4664   GEOM_BASIS_MULTIPLE_TAC 1 `v1:real^3` THEN
4665   X_GEN_TAC `b:real` THEN REPEAT(GEN_TAC ORELSE DISCH_TAC) THEN
4666   FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH
4667    `&0 <= x ==> x = &0 \/ &0 < x`)) THEN
4668   ASM_REWRITE_TAC[DOT_RZERO; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LT_REFL;
4669     MEASURABLE_EMPTY; MEASURE_EMPTY; EMPTY_GSPEC; VECTOR_MUL_LZERO;
4670     BOUNDED_EMPTY; CONVEX_EMPTY] THEN
4671   ASM_CASES_TAC `&1 <= a` THEN ASM_REWRITE_TAC[] THENL
4672    [SUBGOAL_THEN
4673      `!y:real^3. ~(norm(y) * norm(b % basis 1:real^3) * a
4674                    < y dot (b % basis 1))`
4675      (fun th -> REWRITE_TAC[th; EMPTY_GSPEC; MEASURABLE_EMPTY;
4676        BOUNDED_EMPTY; CONVEX_EMPTY; MEASURE_EMPTY]) THEN
4677     REWRITE_TAC[REAL_NOT_LT] THEN X_GEN_TAC `y:real^3` THEN
4678     MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN
4679     SIMP_TAC[DOT_RMUL; NORM_MUL; REAL_ABS_MUL; DOT_BASIS; NORM_BASIS;
4680              DIMINDEX_3; ARITH] THEN
4681     REWRITE_TAC[REAL_ARITH
4682      `b * y <= n * (b * &1) * a <=> b * &1 * y <= b * a * n`] THEN
4683     MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN
4684     MATCH_MP_TAC REAL_LE_MUL2 THEN
4685     ASM_SIMP_TAC[REAL_POS; REAL_ABS_POS; COMPONENT_LE_NORM; DIMINDEX_3; ARITH];
4686     ALL_TAC] THEN
4687   RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
4688   SIMP_TAC[NORM_MUL; NORM_BASIS; DOT_BASIS; DOT_RMUL; DIMINDEX_3; ARITH] THEN
4689   ONCE_REWRITE_TAC[REAL_ARITH `n * x * a:real = x * n * a`] THEN
4690   ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN
4691   ASM_SIMP_TAC[REAL_MUL_RID; REAL_LT_LMUL_EQ; REAL_LT_MUL_EQ; NORM_POS_LT] THEN
4692   ASM_SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_3; ARITH;
4693                REAL_LT_IMP_NZ] THEN
4694   ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_LT_SQUARE] THEN
4695   ASM_SIMP_TAC[REAL_POW_DIV; REAL_POW_LT; REAL_LT_RDIV_EQ] THEN
4696   REWRITE_TAC[REAL_ARITH `(&0 * x < y /\ u < v) /\ &0 < y /\ y < h <=>
4697                           &0 < y /\ y < h /\ u < v`] THEN
4698   MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN
4699   REPEAT CONJ_TAC THENL
4700    [MATCH_MP_TAC BOUNDED_SUBSET THEN
4701     EXISTS_TAC `ball(vec 0:real^3,h / a)` THEN
4702     REWRITE_TAC[BOUNDED_BALL; IN_BALL_0; SUBSET; IN_ELIM_THM] THEN
4703     REWRITE_TAC[NORM_LT_SQUARE] THEN
4704     ASM_SIMP_TAC[REAL_POW_DIV; REAL_LT_RDIV_EQ; REAL_POW_LT] THEN
4705     X_GEN_TAC `x:real^3` THEN STRIP_TAC THEN
4706     CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
4707     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
4708         (REWRITE_RULE[IMP_CONJ] REAL_LTE_TRANS)) THEN
4709     MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REAL_ARITH_TAC;
4710     REWRITE_TAC[SET_RULE `{x | P x /\ Q x /\ R x} =
4711                           {x | Q x} INTER {x | P x /\ R x}`] THEN
4712     REWRITE_TAC[REAL_ARITH `&0 < y <=> y > &0`] THEN
4713     MATCH_MP_TAC CONVEX_INTER THEN
4714     REWRITE_TAC[CONVEX_HALFSPACE_COMPONENT_LT] THEN
4715     MP_TAC(ISPECL [`vec 0:real^3`; `basis 1:real^3`; `a:real`]
4716         CONVEX_RCONE_GT) THEN
4717     ASM_SIMP_TAC[REAL_LT_IMP_LE; rcone_gt; rconesgn] THEN
4718     REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN
4719     SIMP_TAC[DOT_BASIS; NORM_BASIS; DIMINDEX_3; ARITH] THEN
4720     REWRITE_TAC[real_gt; REAL_MUL_LID] THEN
4721     ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN
4722     REWRITE_TAC[NORM_LT_SQUARE] THEN
4723     ASM_SIMP_TAC[REAL_POW_DIV; REAL_LT_RDIV_EQ; REAL_POW_LT] THEN
4724     REWRITE_TAC[REAL_MUL_LZERO];
4725     ALL_TAC] THEN
4726   STRIP_TAC THEN
4727   MATCH_MP_TAC(INST_TYPE [`:2`,`:M`] FUBINI_SIMPLE_CONVEX_STRONG) THEN
4728   EXISTS_TAC `1` THEN REWRITE_TAC[DIMINDEX_2; DIMINDEX_3; ARITH] THEN
4729   ASM_REWRITE_TAC[] THEN
4730   SIMP_TAC[SLICE_312; DIMINDEX_2; DIMINDEX_3; ARITH; IN_ELIM_THM;
4731            VECTOR_3; DOT_3; GSYM DOT_2] THEN
4732   SUBGOAL_THEN `&0 < inv(a pow 2) - &1` ASSUME_TAC THENL
4733    [REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_INV_1_LT THEN
4734     ASM_SIMP_TAC[REAL_POW_1_LT; REAL_LT_IMP_LE; ARITH; REAL_POW_LT];
4735     ALL_TAC] THEN
4736   MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN
4737   EXISTS_TAC `\t. if &0 < t /\ t < h then pi * (inv(a pow 2) - &1) * t pow 2
4738                   else &0` THEN
4739   CONJ_TAC THENL
4740    [X_GEN_TAC `t:real` THEN DISCH_TAC THEN REWRITE_TAC[] THEN
4741     COND_CASES_TAC THEN
4742     ASM_REWRITE_TAC[EMPTY_GSPEC; CONJ_ASSOC;
4743                     MEASURE_EMPTY; MEASURABLE_EMPTY] THEN
4744     MATCH_MP_TAC EQ_TRANS THEN
4745     EXISTS_TAC `measure(ball(vec 0:real^2,sqrt(inv(a pow 2) - &1) * t))` THEN
4746     CONJ_TAC THENL
4747      [W(MP_TAC o PART_MATCH (lhs o rand) AREA_BALL o rand o snd) THEN
4748       ASM_SIMP_TAC[REAL_LT_IMP_LE; SQRT_POS_LT; REAL_LT_MUL] THEN
4749       ASM_SIMP_TAC[SQRT_POW_2; REAL_LT_IMP_LE; REAL_POW_MUL];
4750       AP_TERM_TAC THEN REWRITE_TAC[IN_BALL_0; EXTENSION; IN_ELIM_THM] THEN
4751       REWRITE_TAC[NORM_LT_SQUARE] THEN
4752       ASM_SIMP_TAC[SQRT_POS_LT; SQRT_POW_2; REAL_LT_IMP_LE; REAL_LT_MUL;
4753                    REAL_POW_MUL; GSYM REAL_LT_RDIV_EQ; REAL_POW_LT] THEN
4754       REAL_ARITH_TAC];
4755     ALL_TAC] THEN
4756   REWRITE_TAC[GSYM IN_REAL_INTERVAL; HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN
4757   REWRITE_TAC[HAS_REAL_INTEGRAL_OPEN_INTERVAL] THEN
4758   COND_CASES_TAC THENL
4759    [ASM_MESON_TAC[REAL_INTERVAL_EQ_EMPTY; HAS_REAL_INTEGRAL_EMPTY];
4760     RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT])] THEN
4761   MP_TAC(ISPECL
4762    [`\t. pi / &3 * (inv (a pow 2) - &1) * t pow 3`;
4763     `\t. pi * (inv (a pow 2) - &1) * t pow 2`;
4764     `&0`; `h:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN
4765   REWRITE_TAC[] THEN ANTS_TAC THENL
4766    [ASM_REWRITE_TAC[] THEN
4767     REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN
4768     CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING;
4769     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
4770     UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD]);;
4771
4772 let VOLUME_FRUSTT = prove
4773  (`!v0 v1:real^3 h a.
4774        &0 < a
4775        ==> measurable(frustt v0 v1 h a) /\
4776            measure(frustt v0 v1 h a) =
4777            if v1 = v0 \/ &1 <= a \/ h < &0 then &0
4778            else pi * ((h / a) pow 2 - h pow 2) * h / &3`,
4779   SIMP_TAC[VOLUME_FRUSTT_STRONG]);;
4780
4781 (* ------------------------------------------------------------------------- *)
4782 (* Ellipsoid.                                                                *)
4783 (* ------------------------------------------------------------------------- *)
4784
4785 let scale = new_definition
4786   `scale (t:real^3) (u:real^3):real^3 =
4787        vector[t$1 * u$1; t$2 * u$2; t$3 * u$3]`;;
4788
4789 let normball = new_definition `normball x r = { y:real^A | dist(y,x) < r}`;;
4790
4791 let ellipsoid = new_definition
4792   `ellipsoid t r = IMAGE (scale t) (normball(vec 0) r)`;;
4793
4794 let NORMBALL_BALL = prove
4795  (`!z r. normball z r = ball(z,r)`,
4796   REWRITE_TAC[normball; ball; DIST_SYM]);;
4797
4798 let MEASURE_SCALE = prove
4799  (`!s. measurable s
4800        ==> measurable(IMAGE (scale t) s) /\
4801            measure(IMAGE (scale t) s) = abs(t$1 * t$2 * t$3) * measure s`,
4802   GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_MEASURE] THEN
4803   DISCH_THEN(MP_TAC o SPEC `\i. (t:real^3)$i` o
4804     MATCH_MP HAS_MEASURE_STRETCH) THEN
4805   REWRITE_TAC[DIMINDEX_3; PRODUCT_3] THEN
4806   SUBGOAL_THEN `(\x:real^3. (lambda k. t$k * x$k):real^3) = scale t`
4807   SUBST1_TAC THENL
4808    [SIMP_TAC[CART_EQ; FUN_EQ_THM; scale; LAMBDA_BETA; DIMINDEX_3;
4809              VECTOR_3; ARITH; FORALL_3];
4810     MESON_TAC[measurable; MEASURE_UNIQUE]]);;
4811
4812 let MEASURE_ELLIPSOID = prove
4813  (`!t r. &0 <= r
4814          ==> measurable(ellipsoid t r) /\
4815              measure(ellipsoid t r) =
4816                 abs(t$1 * t$2 * t$3) * &4 / &3 * pi * r pow 3`,
4817   REPEAT GEN_TAC THEN DISCH_TAC THEN
4818   FIRST_X_ASSUM(SUBST1_TAC o SYM o
4819     SPEC `vec 0:real^3` o MATCH_MP VOLUME_BALL) THEN
4820   REWRITE_TAC[normball; ellipsoid] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
4821   REWRITE_TAC[GSYM ball] THEN MATCH_MP_TAC MEASURE_SCALE THEN
4822   REWRITE_TAC[MEASURABLE_BALL]);;
4823
4824 let MEASURABLE_ELLIPSOID = prove
4825  (`!t r. measurable(ellipsoid t r)`,
4826   REPEAT GEN_TAC THEN
4827   ASM_CASES_TAC `&0 <= r` THEN ASM_SIMP_TAC[MEASURE_ELLIPSOID] THEN
4828   REWRITE_TAC[ellipsoid; NORMBALL_BALL; IMAGE; IN_BALL_0] THEN
4829   ASM_SIMP_TAC[NORM_ARITH `~(&0 <= r) ==> ~(norm(x:real^3) < r)`] THEN
4830   REWRITE_TAC[EMPTY_GSPEC; MEASURABLE_EMPTY]);;
4831
4832 (* ------------------------------------------------------------------------- *)
4833 (* Conic cap.                                                                *)
4834 (* ------------------------------------------------------------------------- *)
4835
4836 let conic_cap = new_definition
4837   `conic_cap v0 v1 r a = normball v0 r INTER rcone_gt v0 v1 a`;;
4838
4839 let CONIC_CAP_DEGENERATE = prove
4840  (`!v0 r a. conic_cap v0 v0 r a = {}`,
4841   REWRITE_TAC[conic_cap; rcone_gt; rconesgn; VECTOR_SUB_REFL] THEN
4842   REWRITE_TAC[DIST_REFL; DOT_RZERO; REAL_MUL_RZERO; REAL_MUL_LZERO] THEN
4843   REWRITE_TAC[real_gt; REAL_LT_REFL] THEN SET_TAC[]);;
4844
4845 let BOUNDED_CONIC_CAP = prove
4846  (`!v0 v1:real^3 r a. bounded(conic_cap v0 v1 r a)`,
4847   REPEAT GEN_TAC THEN REWRITE_TAC[conic_cap; NORMBALL_BALL] THEN
4848   MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(v0:real^3,r)` THEN
4849   REWRITE_TAC[BOUNDED_BALL] THEN SET_TAC[]);;
4850
4851 let MEASURABLE_CONIC_CAP = prove
4852  (`!v0 v1:real^3 r a. measurable(conic_cap v0 v1 r a)`,
4853   REPEAT GEN_TAC THEN REWRITE_TAC[conic_cap; NORMBALL_BALL] THEN
4854   MATCH_MP_TAC MEASURABLE_OPEN THEN
4855   SIMP_TAC[OPEN_INTER; OPEN_RCONE_GT; OPEN_BALL] THEN
4856   MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(v0:real^3,r)` THEN
4857   REWRITE_TAC[BOUNDED_BALL] THEN SET_TAC[]);;
4858
4859 let VOLUME_CONIC_CAP_STRONG = prove
4860  (`!v0 v1:real^3 r a.
4861        &0 < a
4862        ==> bounded(conic_cap v0 v1 r a) /\
4863            convex(conic_cap v0 v1 r a) /\
4864            measurable(conic_cap v0 v1 r a) /\
4865            measure(conic_cap v0 v1 r a) =
4866              if v1 = v0 \/ &1 <= a \/ r < &0 then &0
4867              else &2 / &3 * pi * (&1 - a) * r pow 3`,
4868   REPEAT GEN_TAC THEN DISCH_TAC THEN
4869   REWRITE_TAC[conic_cap; rcone_gt; rconesgn; IN_ELIM_THM] THEN
4870   REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] normball; GSYM ball] THEN
4871   CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN GEOM_ORIGIN_TAC `v0:real^3` THEN
4872   REWRITE_TAC[VECTOR_SUB_RZERO; REAL_MUL_LZERO; DIST_0; real_gt] THEN
4873   GEOM_BASIS_MULTIPLE_TAC 1 `v1:real^3` THEN
4874   X_GEN_TAC `b:real` THEN REPEAT(GEN_TAC ORELSE DISCH_TAC) THEN
4875   FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH
4876    `&0 <= x ==> x = &0 \/ &0 < x`))
4877   THENL
4878    [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; GSYM REAL_NOT_LE; DOT_RZERO] THEN
4879     ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; NORM_POS_LE] THEN
4880     REWRITE_TAC[EMPTY_GSPEC; INTER_EMPTY; MEASURE_EMPTY; MEASURABLE_EMPTY;
4881                 CONVEX_EMPTY; BOUNDED_EMPTY];
4882     ALL_TAC] THEN
4883   ASM_CASES_TAC `&1 <= a` THEN ASM_REWRITE_TAC[] THENL
4884    [SUBGOAL_THEN
4885      `!y:real^3. ~(norm(y) * norm(b % basis 1:real^3) * a
4886                    < y dot (b % basis 1))`
4887      (fun th -> REWRITE_TAC[th; EMPTY_GSPEC; INTER_EMPTY; MEASURE_EMPTY;
4888                          MEASURABLE_EMPTY; BOUNDED_EMPTY; CONVEX_EMPTY]) THEN
4889     REWRITE_TAC[REAL_NOT_LT] THEN X_GEN_TAC `y:real^3` THEN
4890     MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN
4891     SIMP_TAC[DOT_RMUL; NORM_MUL; REAL_ABS_MUL; DOT_BASIS; NORM_BASIS;
4892              DIMINDEX_3; ARITH] THEN
4893     REWRITE_TAC[REAL_ARITH
4894      `b * y <= n * (b * &1) * a <=> b * &1 * y <= b * a * n`] THEN
4895     MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN
4896     MATCH_MP_TAC REAL_LE_MUL2 THEN
4897     ASM_SIMP_TAC[REAL_POS; REAL_ABS_POS; COMPONENT_LE_NORM; DIMINDEX_3; ARITH];
4898     ALL_TAC] THEN
4899   RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
4900   SIMP_TAC[DOT_RMUL; NORM_MUL; REAL_ABS_NORM; DOT_BASIS;
4901            DIMINDEX_3; ARITH; NORM_BASIS] THEN
4902   ONCE_REWRITE_TAC[REAL_ARITH `n * x * a:real = x * n * a`] THEN
4903   ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN
4904   ASM_SIMP_TAC[REAL_MUL_RID; REAL_LT_LMUL_EQ; REAL_LT_MUL_EQ; NORM_POS_LT] THEN
4905   ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_LT_SQUARE] THEN
4906   ASM_SIMP_TAC[REAL_POW_DIV; REAL_POW_LT; REAL_LT_RDIV_EQ] THEN
4907   REWRITE_TAC[INTER; REAL_MUL_LZERO; IN_BALL_0; IN_ELIM_THM] THEN
4908   ASM_SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_3; ARITH;
4909                REAL_LT_IMP_NZ] THEN
4910   COND_CASES_TAC THENL
4911    [ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm x < r)`] THEN
4912     REWRITE_TAC[EMPTY_GSPEC; MEASURE_EMPTY; MEASURABLE_EMPTY;
4913                 BOUNDED_EMPTY; CONVEX_EMPTY];
4914     RULE_ASSUM_TAC(ONCE_REWRITE_RULE[REAL_NOT_LT])] THEN
4915   MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c /\ d) ==> a /\ b /\ c /\ d`) THEN
4916   REPEAT CONJ_TAC THENL
4917    [MATCH_MP_TAC BOUNDED_SUBSET THEN
4918     EXISTS_TAC `ball(vec 0:real^3,r)` THEN
4919     SIMP_TAC[BOUNDED_BALL; IN_BALL_0; SUBSET; IN_ELIM_THM];
4920     ONCE_REWRITE_TAC[SET_RULE
4921       `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN
4922     MATCH_MP_TAC CONVEX_INTER THEN
4923     REWRITE_TAC[GSYM IN_BALL_0; CONVEX_BALL; SIMPLE_IMAGE; IMAGE_ID] THEN
4924     MP_TAC(ISPECL [`vec 0:real^3`; `basis 1:real^3`; `a:real`]
4925         CONVEX_RCONE_GT) THEN
4926     ASM_SIMP_TAC[REAL_LT_IMP_LE; rcone_gt; rconesgn] THEN
4927     REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN
4928     SIMP_TAC[DOT_BASIS; NORM_BASIS; DIMINDEX_3; ARITH] THEN
4929     REWRITE_TAC[real_gt; REAL_MUL_LID] THEN
4930     ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN
4931     REWRITE_TAC[NORM_LT_SQUARE] THEN
4932     ASM_SIMP_TAC[REAL_POW_DIV; REAL_LT_RDIV_EQ; REAL_POW_LT] THEN
4933     REWRITE_TAC[REAL_MUL_LZERO];
4934     STRIP_TAC] THEN
4935   MATCH_MP_TAC(INST_TYPE [`:2`,`:M`] FUBINI_SIMPLE_CONVEX_STRONG) THEN
4936   EXISTS_TAC `1` THEN ASM_REWRITE_TAC[DIMINDEX_2; DIMINDEX_3; ARITH] THEN
4937   SIMP_TAC[SLICE_312; DIMINDEX_2; DIMINDEX_3; ARITH; IN_ELIM_THM;
4938            VECTOR_3; DOT_3; GSYM DOT_2] THEN
4939   SUBGOAL_THEN `&0 < inv(a pow 2) - &1` ASSUME_TAC THENL
4940    [REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_INV_1_LT THEN
4941     ASM_SIMP_TAC[REAL_POW_1_LT; REAL_LT_IMP_LE; ARITH; REAL_POW_LT];
4942     ALL_TAC] THEN
4943   MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN
4944   EXISTS_TAC `\t. if &0 < t /\ t < r
4945                   then measure
4946                     {y:real^2 | norm(vector[t; y$1; y$2]:real^3) pow 2
4947                                  < r pow 2 /\
4948                                 (t * t + y dot y) * a pow 2 < t pow 2}
4949                   else &0` THEN
4950   CONJ_TAC THENL
4951    [X_GEN_TAC `t:real` THEN DISCH_TAC THEN REWRITE_TAC[] THEN
4952     ASM_CASES_TAC `&0 < t` THEN
4953     ASM_REWRITE_TAC[EMPTY_GSPEC; MEASURE_EMPTY; MEASURABLE_EMPTY] THEN
4954     ASM_CASES_TAC `t:real < r` THEN ASM_REWRITE_TAC[] THENL
4955      [REWRITE_TAC[NORM_LT_SQUARE] THEN
4956       SUBGOAL_THEN `&0 < r` (fun th -> REWRITE_TAC[th; NORM_POW_2]) THEN
4957       ASM_REAL_ARITH_TAC;
4958       ALL_TAC] THEN
4959     SUBGOAL_THEN `!y. ~(norm(vector[t; (y:real^2)$1; y$2]:real^3) < r)`
4960      (fun th -> REWRITE_TAC[th; EMPTY_GSPEC; MEASURE_EMPTY;
4961                             MEASURABLE_EMPTY]) THEN
4962     ASM_REWRITE_TAC[NORM_LT_SQUARE; DOT_3; VECTOR_3] THEN
4963     GEN_TAC THEN
4964     MATCH_MP_TAC(REAL_ARITH `&0 <= a /\ &0 <= b /\ c <= d
4965                              ==> ~(&0 < r /\ d + a + b < c)`) THEN
4966     REWRITE_TAC[REAL_LE_SQUARE] THEN
4967     REWRITE_TAC[REAL_POW_2] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN
4968     ASM_REAL_ARITH_TAC;
4969     ALL_TAC] THEN
4970   REWRITE_TAC[GSYM IN_REAL_INTERVAL; HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN
4971   REWRITE_TAC[HAS_REAL_INTEGRAL_OPEN_INTERVAL] THEN
4972   REWRITE_TAC[NORM_POW_2; DOT_3; VECTOR_3; DOT_2] THEN
4973   ONCE_REWRITE_TAC[REAL_ARITH
4974    `pi * &2 / &3 * (&1 - a) * r pow 3 =
4975     pi / &3 * (inv (a pow 2) - &1) * (a * r) pow 3 +
4976     (pi * &2 / &3 * (&1 - a) * r pow 3 -
4977      pi / &3 * (inv (a pow 2) - &1) * (a * r) pow 3)`] THEN
4978   MATCH_MP_TAC HAS_REAL_INTEGRAL_COMBINE THEN
4979   EXISTS_TAC `a * r:real` THEN
4980   REWRITE_TAC[REAL_ARITH `a * r <= r <=> &0 <= r * (&1 - a)`] THEN
4981   ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_LT_IMP_LE] THEN CONJ_TAC THENL
4982    [MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC
4983      `\t. measure(ball(vec 0:real^2,sqrt(inv(a pow 2) - &1) * t))` THEN
4984     CONJ_TAC THENL
4985      [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN
4986       STRIP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
4987       REWRITE_TAC[IN_BALL_0; NORM_LT_SQUARE_ALT] THEN
4988       ASM_SIMP_TAC[SQRT_POS_LE; REAL_LE_MUL; SQRT_POW_2; REAL_LT_IMP_LE;
4989                    REAL_POW_MUL] THEN
4990       REWRITE_TAC[REAL_ARITH `x < (a - &1) * t <=> t + x < t * a`] THEN
4991       ASM_SIMP_TAC[GSYM real_div; REAL_LT_RDIV_EQ; REAL_POW_LT] THEN
4992       X_GEN_TAC `x:real^2` THEN REWRITE_TAC[DOT_2] THEN
4993       ASM_SIMP_TAC[GSYM REAL_POW_2; GSYM REAL_LT_RDIV_EQ; REAL_POW_LT] THEN
4994       MATCH_MP_TAC(REAL_ARITH `b <= a ==> (x < b <=> x < a /\ x < b)`) THEN
4995       ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; GSYM REAL_POW_MUL] THEN
4996       ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
4997       REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN ASM_REAL_ARITH_TAC;
4998       ALL_TAC] THEN
4999     MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN
5000     EXISTS_TAC `\t. pi * (inv(a pow 2) - &1) * t pow 2` THEN
5001     CONJ_TAC THENL
5002      [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN
5003       STRIP_TAC THEN
5004       W(MP_TAC o PART_MATCH (lhs o rand) AREA_BALL o rand o snd) THEN
5005       ASM_SIMP_TAC[REAL_POW_MUL; REAL_LT_IMP_LE; SQRT_POS_LT; REAL_LE_MUL;
5006                    SQRT_POW_2];
5007       ALL_TAC] THEN
5008     MP_TAC(ISPECL
5009      [`\t. pi / &3 * (inv (a pow 2) - &1) * t pow 3`;
5010       `\t. pi * (inv (a pow 2) - &1) * t pow 2`;
5011       `&0`; `a * r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN
5012     ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN ANTS_TAC THENL
5013      [ASM_REWRITE_TAC[] THEN
5014       REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN
5015       CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING;
5016       MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
5017       UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD];
5018     MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC
5019      `\t. measure(ball(vec 0:real^2,sqrt(r pow 2 - t pow 2)))` THEN
5020     CONJ_TAC THENL
5021      [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN
5022       STRIP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
5023       REWRITE_TAC[IN_BALL_0; NORM_LT_SQUARE_ALT] THEN
5024       SUBGOAL_THEN `&0 <= t` ASSUME_TAC THENL
5025        [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a * r:real` THEN
5026         ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE];
5027         ALL_TAC] THEN
5028       ASM_SIMP_TAC[SQRT_POS_LE; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE2] THEN
5029       X_GEN_TAC `x:real^2` THEN REWRITE_TAC[DOT_2] THEN
5030       REWRITE_TAC[REAL_ARITH `x < r - t <=> t + x < r`] THEN
5031       ASM_SIMP_TAC[GSYM REAL_POW_2; GSYM REAL_LT_RDIV_EQ; REAL_POW_LT] THEN
5032       MATCH_MP_TAC(REAL_ARITH `a <= b ==> (x < a <=> x < a /\ x < b)`) THEN
5033       ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_POW_LT; GSYM REAL_POW_MUL] THEN
5034       ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
5035       ASM_SIMP_TAC[REAL_POW_LE2; REAL_LE_MUL; REAL_LT_IMP_LE];
5036       ALL_TAC] THEN
5037     MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN
5038     EXISTS_TAC `\t. pi * (r pow 2 - t pow 2)` THEN
5039     CONJ_TAC THENL
5040      [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN
5041       STRIP_TAC THEN
5042       W(MP_TAC o PART_MATCH (lhs o rand) AREA_BALL o rand o snd) THEN
5043       SUBGOAL_THEN `&0 <= t` ASSUME_TAC THENL
5044        [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a * r:real` THEN
5045         ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE];
5046         ALL_TAC] THEN
5047       ASM_SIMP_TAC[SQRT_POS_LE; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE2];
5048       ALL_TAC] THEN
5049     MP_TAC(ISPECL
5050      [`\t. pi * (r pow 2 * t - t pow 3 / &3)`;
5051       `\t. pi * (r pow 2 - t pow 2)`;
5052       `a * r:real`; `r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN
5053     ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN ANTS_TAC THENL
5054      [ASM_REWRITE_TAC[REAL_ARITH `a * r <= r <=> &0 <= r * (&1 - a)`] THEN
5055       ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LE] THEN
5056       REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN
5057       CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING;
5058       MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
5059       UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD]]);;
5060
5061 let VOLUME_CONIC_CAP = prove
5062  (`!v0 v1:real^3 r a.
5063        &0 < a
5064        ==> measurable(conic_cap v0 v1 r a) /\ measure(conic_cap v0 v1 r a) =
5065            if v1 = v0 \/ &1 <= a \/ r < &0 then &0
5066            else &2 / &3 * pi * (&1 - a) * r pow 3`,
5067   SIMP_TAC[VOLUME_CONIC_CAP_STRONG]);;
5068
5069 (* ------------------------------------------------------------------------- *)
5070 (* Negligibility of a circular cone.                                         *)
5071 (* This isn't exactly using the Flyspeck definition of "cone" but we use it  *)
5072 (* to get that later on. Could now simplify this using WLOG tactics.         *)
5073 (* ------------------------------------------------------------------------- *)
5074
5075 let NEGLIGIBLE_CIRCULAR_CONE_0_NONPARALLEL = prove
5076  (`!c:real^N k. ~(c = vec 0) /\ ~(k = &0) /\ ~(k = pi)
5077                 ==> negligible {x | vector_angle c x = k}`,
5078   REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
5079   EXISTS_TAC `(vec 0:real^N) INSERT
5080               UNIONS { {x | x IN ((:real^N) DIFF ball(vec 0,inv(&n + &1))) /\
5081                             Cx(vector_angle c x) = Cx k} |
5082                        n IN (:num)  }` THEN
5083   CONJ_TAC THENL
5084    [ALL_TAC;
5085     REWRITE_TAC[SUBSET; IN_INSERT; IN_UNIONS; IN_ELIM_THM; CX_INJ] THEN
5086     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_UNIV] THEN
5087     ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[] THEN
5088     REWRITE_TAC[LEFT_AND_EXISTS_THM; IN_DIFF; IN_UNIV] THEN
5089     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN
5090     ASM_REWRITE_TAC[IN_ELIM_THM] THEN
5091     MP_TAC(SPEC `norm(x:real^N)` REAL_ARCH_INV) THEN
5092     ASM_REWRITE_TAC[NORM_POS_LT; IN_BALL_0; REAL_NOT_LT; REAL_LT_INV_EQ] THEN
5093     MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN
5094     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&n)` THEN
5095     ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
5096     ASM_REAL_ARITH_TAC] THEN
5097   REWRITE_TAC[NEGLIGIBLE_INSERT] THEN
5098   MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN X_GEN_TAC `n:num` THEN
5099   MATCH_MP_TAC STARLIKE_NEGLIGIBLE_STRONG THEN EXISTS_TAC `c:real^N` THEN
5100   CONJ_TAC THENL
5101    [MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_CONSTANT THEN
5102     SIMP_TAC[CLOSED_DIFF; CLOSED_UNIV; OPEN_BALL] THEN
5103     MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_CX_VECTOR_ANGLE) THEN
5104     REWRITE_TAC[IN_DIFF; IN_BALL_0; NORM_0; IN_UNIV] THEN
5105     REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC;
5106     ALL_TAC] THEN
5107   MAP_EVERY X_GEN_TAC [`a:real`; `x:real^N`] THEN
5108   SIMP_TAC[IN_ELIM_THM; IN_UNIV; IN_DIFF; IN_BALL_0; REAL_NOT_LT; CX_INJ] THEN
5109   REWRITE_TAC[DE_MORGAN_THM] THEN ASM_CASES_TAC `(c + x:real^N) = vec 0` THENL
5110    [ASM_REWRITE_TAC[GSYM REAL_NOT_LT; REAL_LT_INV_EQ; NORM_0] THEN
5111     REAL_ARITH_TAC;
5112     ALL_TAC] THEN
5113   ASM_CASES_TAC `c + a % x:real^N = vec 0` THENL
5114    [ASM_REWRITE_TAC[GSYM REAL_NOT_LT; REAL_LT_INV_EQ; NORM_0] THEN
5115     REAL_ARITH_TAC;
5116     ALL_TAC] THEN
5117   ASM_CASES_TAC `x:real^N = vec 0` THENL
5118    [ASM_REWRITE_TAC[VECTOR_ADD_RID; VECTOR_ANGLE_REFL];
5119     ALL_TAC] THEN
5120   ASM_CASES_TAC `a = &0` THENL
5121    [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID; VECTOR_ANGLE_REFL];
5122     ALL_TAC] THEN
5123   REWRITE_TAC[TAUT `~a \/ ~b <=> a ==> ~b`] THEN REPEAT STRIP_TAC THEN
5124   MP_TAC(ISPECL [`vec 0:real^N`; `c:real^N`; `c + a % x:real^N`;
5125                  `vec 0:real^N`; `c:real^N`; `c + x:real^N`]
5126                 CONGRUENT_TRIANGLES_ASA_FULL) THEN
5127   REWRITE_TAC[angle; VECTOR_ADD_SUB] THEN ASM_SIMP_TAC[VECTOR_SUB_RZERO] THEN
5128   REWRITE_TAC[NORM_ARITH `dist(x,x + a) = norm(a)`; NORM_MUL] THEN
5129   REWRITE_TAC[REAL_FIELD `a * x = x <=> a = &1 \/ x = &0`] THEN
5130   ASM_SIMP_TAC[REAL_ARITH `&0 <= a /\ a < &1 ==> ~(abs a = &1)`] THEN
5131   ASM_REWRITE_TAC[NORM_EQ_0; VECTOR_ANGLE_RMUL; COLLINEAR_LEMMA] THEN
5132   DISCH_THEN(X_CHOOSE_THEN `u:real` MP_TAC) THEN
5133   DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. inv(a) % x`) THEN
5134   ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_ADD_LDISTRIB;
5135                VECTOR_MUL_LID; REAL_MUL_LINV] THEN
5136   REWRITE_TAC[VECTOR_ARITH `a % c + x = b % c <=> x = (b - a) % c`] THEN
5137   DISCH_THEN SUBST_ALL_TAC THEN
5138   RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_ARITH `c + a % c = (a + &1) % c`]) THEN
5139   UNDISCH_TAC `vector_angle c ((inv a * u - inv a + &1) % c:real^N) = k` THEN
5140   RULE_ASSUM_TAC(REWRITE_RULE
5141    [VECTOR_ANGLE_RMUL; VECTOR_MUL_EQ_0; DE_MORGAN_THM]) THEN
5142   ASM_REWRITE_TAC[VECTOR_ANGLE_RMUL; VECTOR_ANGLE_REFL] THEN
5143   ASM_REAL_ARITH_TAC);;
5144
5145 let NEGLIGIBLE_CIRCULAR_CONE_0 = prove
5146  (`!c:real^N k. 2 <= dimindex(:N) /\ ~(c = vec 0)
5147                 ==> negligible {x | vector_angle c x = k}`,
5148   REPEAT STRIP_TAC THEN
5149   SUBGOAL_THEN `orthogonal (basis 1:real^N) (basis 2)` ASSUME_TAC THENL
5150    [ASM_SIMP_TAC[ORTHOGONAL_BASIS_BASIS; ARITH;
5151                  ARITH_RULE `2 <= d ==> 1 <= d`];
5152     ALL_TAC] THEN
5153   ASM_CASES_TAC `k = &0 \/ k = pi` THENL
5154    [ALL_TAC; ASM_MESON_TAC[NEGLIGIBLE_CIRCULAR_CONE_0_NONPARALLEL]] THEN
5155   SUBGOAL_THEN
5156    `?b:real^N. ~(b = vec 0) /\
5157                ~(vector_angle c b = &0) /\
5158                ~(vector_angle c b = pi)`
5159   STRIP_ASSUME_TAC THENL
5160    [MATCH_MP_TAC(MESON[] `!a b. P a \/ P b ==> ?x. P x`) THEN
5161     MAP_EVERY EXISTS_TAC [`basis 1:real^N`; `basis 2:real^N`] THEN
5162     REWRITE_TAC[BASIS_EQ_0] THEN
5163     ASM_SIMP_TAC[ARITH_RULE `2 <= d ==> 1 <= d`; IN_NUMSEG; ARITH] THEN
5164     REWRITE_TAC[GSYM DE_MORGAN_THM] THEN STRIP_TAC THEN
5165     REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `basis 1:real^N` o
5166       MATCH_MP VECTOR_ANGLE_EQ_0_LEFT)) THEN
5167     REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `basis 1:real^N` o
5168       MATCH_MP VECTOR_ANGLE_EQ_PI_LEFT)) THEN
5169     DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[VECTOR_ANGLE_REFL; BASIS_EQ_0] THEN
5170     ASM_SIMP_TAC[ARITH_RULE `2 <= d ==> 1 <= d`; IN_NUMSEG; ARITH] THEN
5171     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ORTHOGONAL_VECTOR_ANGLE]) THEN
5172     REWRITE_TAC[VECTOR_ANGLE_SYM] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC;
5173     ALL_TAC] THEN
5174   ASM_CASES_TAC `k = &0 \/ k = pi` THENL
5175    [ALL_TAC; ASM_MESON_TAC[NEGLIGIBLE_CIRCULAR_CONE_0_NONPARALLEL]] THEN
5176   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
5177   FIRST_X_ASSUM(DISJ_CASES_THEN SUBST_ALL_TAC) THENL
5178    [EXISTS_TAC `{x:real^N | vector_angle b x = vector_angle c b}` THEN
5179     ASM_SIMP_TAC[NEGLIGIBLE_CIRCULAR_CONE_0_NONPARALLEL] THEN
5180     REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
5181     MESON_TAC[VECTOR_ANGLE_EQ_0_RIGHT; VECTOR_ANGLE_SYM];
5182     EXISTS_TAC `{x:real^N | vector_angle b x = pi - vector_angle c b}` THEN
5183     ASM_SIMP_TAC[NEGLIGIBLE_CIRCULAR_CONE_0_NONPARALLEL;
5184                  REAL_SUB_0; REAL_ARITH `p - x = p <=> x = &0`] THEN
5185     REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
5186     MESON_TAC[VECTOR_ANGLE_EQ_PI_RIGHT; VECTOR_ANGLE_SYM]]);;
5187
5188 let NEGLIGIBLE_CIRCULAR_CONE = prove
5189  (`!a:real^N c k.
5190       2 <= dimindex(:N) /\ ~(c = vec 0)
5191       ==> negligible(a INSERT {x | vector_angle c (x - a) = k})`,
5192   REPEAT STRIP_TAC THEN REWRITE_TAC[NEGLIGIBLE_INSERT] THEN
5193   MATCH_MP_TAC NEGLIGIBLE_TRANSLATION_REV THEN EXISTS_TAC `--a:real^N` THEN
5194   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
5195   EXISTS_TAC `{x:real^N | vector_angle c x = k}` THEN
5196   ASM_SIMP_TAC[NEGLIGIBLE_CIRCULAR_CONE_0] THEN
5197   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
5198   REWRITE_TAC[VECTOR_ARITH `--a + x:real^N = x - a`]);;
5199
5200 let NEGLIGIBLE_RCONE_EQ = prove
5201  (`!w z:real^3 h. ~(w = z) ==> negligible(rcone_eq z w h)`,
5202   REWRITE_TAC[rcone_eq; rconesgn] THEN GEOM_ORIGIN_TAC `z:real^3` THEN
5203   REPEAT STRIP_TAC THEN REWRITE_TAC[DIST_0; VECTOR_SUB_RZERO] THEN
5204   ASM_CASES_TAC `abs(h) <= &1` THENL
5205    [MP_TAC(ISPECL [`w:real^3`; `acs h`] NEGLIGIBLE_CIRCULAR_CONE_0) THEN
5206     ASM_REWRITE_TAC[DIMINDEX_3; ARITH] THEN
5207     REWRITE_TAC[GSYM HAS_MEASURE_0] THEN
5208     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT]
5209       HAS_MEASURE_NEGLIGIBLE_SYMDIFF) THEN
5210     MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{vec 0:real^3}` THEN
5211     REWRITE_TAC[NEGLIGIBLE_SING] THEN MATCH_MP_TAC(SET_RULE
5212      `(!x. ~(x = a) ==> (x IN s <=> x IN t))
5213       ==> (s DIFF t) UNION (t DIFF s) SUBSET {a}`) THEN
5214     X_GEN_TAC `x:real^3` THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN
5215     ASM_SIMP_TAC[vector_angle] THEN ASM_SIMP_TAC[NORM_EQ_0; REAL_FIELD
5216      `~(x = &0) /\ ~(w = &0) ==> (a = x * w * b <=> a / (w * x) = b)`] THEN
5217     GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [DOT_SYM] THEN
5218     MATCH_MP_TAC ACS_INJ THEN ASM_REWRITE_TAC[NORM_CAUCHY_SCHWARZ_DIV];
5219     MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
5220     EXISTS_TAC `{vec 0}:real^3->bool` THEN
5221     REWRITE_TAC[NEGLIGIBLE_SING] THEN
5222     REWRITE_TAC[SET_RULE `{x | P x} SUBSET {a} <=> !x. ~(x = a) ==> ~P x`] THEN
5223     X_GEN_TAC `x:real^3` THEN REPEAT DISCH_TAC THEN
5224     MP_TAC(ISPECL [`x:real^3`; `w:real^3`] NORM_CAUCHY_SCHWARZ_ABS) THEN
5225     ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM; REAL_ARITH
5226      `~(x * w * h <= x * w) <=> &0 < x * w * (h - &1)`] THEN
5227     REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[NORM_POS_LT]) THEN
5228     ASM_REAL_ARITH_TAC]);;
5229
5230 (* ------------------------------------------------------------------------- *)
5231 (* Area of sector of a circle delimited by Arg values.                       *)
5232 (* ------------------------------------------------------------------------- *)
5233
5234 let NEGLIGIBLE_ARG_EQ = prove
5235  (`!t. negligible {z | Arg z = t}`,
5236   GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
5237   EXISTS_TAC `{z | cexp(ii * Cx(pi / &2 + t)) dot z = &0}` THEN
5238   SIMP_TAC[NEGLIGIBLE_HYPERPLANE; COMPLEX_VEC_0; CEXP_NZ] THEN
5239   REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `z:complex` THEN
5240   DISCH_TAC THEN MP_TAC(SPEC `z:complex` ARG) THEN ASM_REWRITE_TAC[] THEN
5241   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5242   DISCH_THEN SUBST1_TAC THEN
5243   REWRITE_TAC[GSYM COMPLEX_CMUL; DOT_RMUL; REAL_ENTIRE] THEN
5244   DISJ2_TAC THEN REWRITE_TAC[CEXP_EULER] THEN
5245   REWRITE_TAC[DOT_2; GSYM RE_DEF; GSYM IM_DEF] THEN
5246   REWRITE_TAC[GSYM CX_SIN; GSYM CX_COS; RE_ADD; IM_ADD;
5247               RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN
5248   REWRITE_TAC[SIN_ADD; COS_ADD; SIN_PI2; COS_PI2] THEN
5249   REAL_ARITH_TAC);;
5250
5251 let MEASURABLE_CLOSED_SECTOR_LE = prove
5252  (`!r t. measurable {z | norm(z) <= r /\ Arg z <= t}`,
5253   REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURABLE_COMPACT THEN
5254   REWRITE_TAC[SET_RULE `{z | P z /\ Q z} = {z | P z} INTER {z | Q z}`] THEN
5255   MATCH_MP_TAC COMPACT_INTER_CLOSED THEN REWRITE_TAC[CLOSED_ARG_LE] THEN
5256   REWRITE_TAC[NORM_ARITH `norm z = dist(vec 0,z)`; GSYM cball] THEN
5257   REWRITE_TAC[COMPACT_CBALL]);;
5258
5259 let MEASURABLE_CLOSED_SECTOR_LT = prove
5260  (`!r t. measurable {z | norm(z) <= r /\ Arg z < t}`,
5261   REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURABLE_NEGLIGIBLE_SYMDIFF THEN
5262   EXISTS_TAC `{z | norm(z) <= r /\ Arg z <= t}` THEN
5263   REWRITE_TAC[MEASURABLE_CLOSED_SECTOR_LE] THEN
5264   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
5265   EXISTS_TAC `{z | Arg z = t}` THEN
5266   REWRITE_TAC[NEGLIGIBLE_ARG_EQ; NEGLIGIBLE_UNION_EQ] THEN
5267   REWRITE_TAC[SUBSET; IN_DIFF; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC);;
5268
5269 let MEASURABLE_CLOSED_SECTOR_LTE = prove
5270  (`!r s t. measurable {z | norm(z) <= r /\ s < Arg z /\ Arg z <= t}`,
5271   REPEAT GEN_TAC THEN REWRITE_TAC[SET_RULE
5272    `{z | P z /\ Q z /\ R z} = {z | P z /\ R z} DIFF {z | P z /\ ~Q z}`] THEN
5273   SIMP_TAC[MEASURABLE_DIFF; REAL_NOT_LT; MEASURABLE_CLOSED_SECTOR_LE]);;
5274
5275 let MEASURE_CLOSED_SECTOR_LE = prove
5276  (`!t r. &0 <= r /\ &0 <= t /\ t <= &2 * pi
5277          ==> measure {x:real^2 | norm(x) <= r /\ Arg(x) <= t} =
5278              t * r pow 2 / &2`,
5279   REPEAT STRIP_TAC THEN
5280   MP_TAC(ISPECL
5281    [`\t. measure {z:real^2 | norm(z) <= r /\ Arg(z) <= t}`;
5282     `&2 * pi`] REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR_INTERVAL) THEN
5283   ANTS_TAC THENL
5284    [ALL_TAC;
5285     DISCH_THEN(MP_TAC o SPECL [`t / (&2 * pi)`; `&2 * pi`]) THEN
5286     MP_TAC(SPECL [`vec 0:real^2`; `r:real`] AREA_CBALL) THEN
5287     ASM_REWRITE_TAC[cball; NORM_ARITH `dist(vec 0,z) = norm z`] THEN
5288     SIMP_TAC[ARG; REAL_LT_IMP_LE] THEN DISCH_THEN(K ALL_TAC) THEN
5289     SIMP_TAC[PI_POS; REAL_FIELD `&0 < p ==> t / (&2 * p) * p * r = t * r / &2`;
5290              REAL_FIELD `&0 < p ==> t / (&2 * p) * &2 * p = t`] THEN
5291     DISCH_THEN MATCH_MP_TAC THEN MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC] THEN
5292   REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL
5293    [MATCH_MP_TAC REALLIM_TRANSFORM_BOUND THEN
5294     EXISTS_TAC `\t. r pow 2 * sin(t)` THEN REWRITE_TAC[] THEN CONJ_TAC THENL
5295      [REWRITE_TAC[EVENTUALLY_WITHINREAL] THEN EXISTS_TAC `pi / &2` THEN
5296       SIMP_TAC[PI_POS; REAL_LT_DIV; IN_ELIM_THM; REAL_OF_NUM_LT; ARITH] THEN
5297       X_GEN_TAC `x:real` THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
5298       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5299       ASM_SIMP_TAC[real_abs; MEASURE_POS_LE; MEASURABLE_CLOSED_SECTOR_LE] THEN
5300       STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
5301       EXISTS_TAC `measure(interval[vec 0,complex(r,r * sin x)])` THEN
5302       CONJ_TAC THENL
5303        [MATCH_MP_TAC MEASURE_SUBSET THEN
5304         REWRITE_TAC[MEASURABLE_CLOSED_SECTOR_LE; MEASURABLE_INTERVAL] THEN
5305         REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL] THEN
5306         X_GEN_TAC `z:complex` THEN STRIP_TAC THEN
5307         REWRITE_TAC[DIMINDEX_2; FORALL_2; VEC_COMPONENT] THEN
5308         REWRITE_TAC[GSYM IM_DEF; GSYM RE_DEF; IM; RE] THEN
5309         SUBST1_TAC(last(CONJUNCTS(SPEC `z:complex` ARG))) THEN
5310         REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; CEXP_EULER] THEN
5311         REWRITE_TAC[RE_ADD; GSYM CX_COS; GSYM CX_SIN; RE_CX; IM_CX;
5312                     RE_MUL_II; IM_MUL_II; IM_ADD] THEN
5313         REWRITE_TAC[REAL_NEG_0; REAL_ADD_LID; REAL_ADD_RID] THEN
5314         SUBGOAL_THEN `&0 <= Arg z /\ Arg z < pi / &2 /\ Arg z <= pi / &2`
5315         STRIP_ASSUME_TAC THENL
5316          [REWRITE_TAC[ARG] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN
5317         REPEAT CONJ_TAC THENL
5318          [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE] THEN
5319           MATCH_MP_TAC COS_POS_PI_LE THEN ASM_REAL_ARITH_TAC;
5320           MATCH_MP_TAC(REAL_ARITH `abs(a * b) <= c * &1 ==> a * b <= c`) THEN
5321           REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM] THEN
5322           MATCH_MP_TAC REAL_LE_MUL2 THEN
5323           ASM_REWRITE_TAC[NORM_POS_LE; REAL_ABS_POS; COS_BOUND];
5324           MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE] THEN
5325           MATCH_MP_TAC SIN_POS_PI_LE THEN ASM_REAL_ARITH_TAC;
5326           MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[NORM_POS_LE] THEN
5327           CONJ_TAC THENL
5328            [MATCH_MP_TAC SIN_POS_PI_LE THEN ASM_REAL_ARITH_TAC;
5329             MATCH_MP_TAC SIN_MONO_LE THEN ASM_REAL_ARITH_TAC]];
5330         REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
5331         REWRITE_TAC[FORALL_2; PRODUCT_2; DIMINDEX_2; VEC_COMPONENT] THEN
5332         REWRITE_TAC[GSYM IM_DEF; GSYM RE_DEF; IM; RE] THEN
5333         REWRITE_TAC[REAL_SUB_RZERO; REAL_POW_2; REAL_MUL_ASSOC] THEN
5334         SUBGOAL_THEN `&0 <= sin x` (fun th ->
5335           ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_REFL; REAL_LE_MUL; th]) THEN
5336         MATCH_MP_TAC SIN_POS_PI_LE THEN ASM_REAL_ARITH_TAC];
5337       MATCH_MP_TAC REALLIM_ATREAL_WITHINREAL THEN
5338       SUBGOAL_THEN `(\t. r pow 2 * sin t) real_continuous atreal (&0)`
5339       MP_TAC THENL
5340        [MATCH_MP_TAC REAL_CONTINUOUS_LMUL THEN
5341         REWRITE_TAC[ETA_AX; REAL_CONTINUOUS_AT_SIN];
5342         REWRITE_TAC[REAL_CONTINUOUS_ATREAL; SIN_0; REAL_MUL_RZERO]]];
5343     ASM_SIMP_TAC[REAL_ARITH
5344       `&0 <= x /\ &0 <= y
5345        ==> (norm z <= r /\ Arg z <= x + y <=>
5346             norm z <= r /\ Arg z <= x \/
5347             norm z <= r /\ x < Arg z /\ Arg z <= x + y)`] THEN
5348     REWRITE_TAC[SET_RULE `{z | Q z \/ R z} = {z | Q z} UNION {z | R z}`] THEN
5349     SIMP_TAC[MEASURE_UNION; MEASURABLE_CLOSED_SECTOR_LE;
5350              MEASURABLE_CLOSED_SECTOR_LTE] THEN
5351     REWRITE_TAC[GSYM REAL_NOT_LE; SET_RULE
5352      `{z | P z /\ Q z} INTER {z | P z /\ ~Q z /\ R z} = {}`] THEN
5353     REWRITE_TAC[MEASURE_EMPTY; REAL_SUB_RZERO; REAL_EQ_ADD_LCANCEL] THEN
5354     REWRITE_TAC[REAL_NOT_LE] THEN MATCH_MP_TAC EQ_TRANS THEN
5355     EXISTS_TAC `measure {z | norm z <= r /\ x < Arg z /\ Arg z < x + y}` THEN
5356     CONJ_TAC THENL
5357      [MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN
5358       REWRITE_TAC[MEASURABLE_CLOSED_SECTOR_LTE] THEN
5359       MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
5360       EXISTS_TAC `{z | Arg z = x + y}` THEN
5361       REWRITE_TAC[NEGLIGIBLE_ARG_EQ; NEGLIGIBLE_UNION_EQ] THEN
5362       REWRITE_TAC[SUBSET; IN_DIFF; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC;
5363       ALL_TAC] THEN
5364     MATCH_MP_TAC EQ_TRANS THEN
5365     EXISTS_TAC `measure {z | norm z <= r /\ &0 < Arg z /\ Arg z < y}` THEN
5366     CONJ_TAC THENL
5367      [ALL_TAC;
5368       MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN
5369       REWRITE_TAC[MEASURABLE_CLOSED_SECTOR_LE] THEN
5370       MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
5371       EXISTS_TAC `{z | Arg z = &0} UNION {z | Arg z = y}` THEN
5372       REWRITE_TAC[NEGLIGIBLE_ARG_EQ; NEGLIGIBLE_UNION_EQ] THEN
5373       REWRITE_TAC[SUBSET; IN_DIFF; IN_UNION; IN_ELIM_THM] THEN
5374       MP_TAC ARG THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC] THEN
5375     MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
5376      `measure (IMAGE (rotate2d x)
5377               {z | norm z <= r /\ &0 < Arg z /\ Arg z < y})` THEN
5378     CONJ_TAC THENL
5379      [ALL_TAC;
5380       ASM_SIMP_TAC[MEASURE_ORTHOGONAL_IMAGE_EQ;
5381                    ORTHOGONAL_TRANSFORMATION_ROTATE2D]] THEN
5382     AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN
5383     MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL
5384      [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE;
5385                     ORTHOGONAL_TRANSFORMATION_ROTATE2D]; ALL_TAC] THEN
5386     X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_ELIM_THM] THEN
5387     ASM_CASES_TAC `z = Cx(&0)` THENL
5388      [ASM_REWRITE_TAC[Arg_DEF; ROTATE2D_0] THEN
5389       ASM_REAL_ARITH_TAC;
5390       ALL_TAC] THEN
5391     REWRITE_TAC[NORM_ROTATE2D] THEN AP_TERM_TAC THEN EQ_TAC THENL
5392      [STRIP_TAC THEN
5393       SUBGOAL_THEN `z = rotate2d (--x) (rotate2d x z)` SUBST1_TAC THENL
5394        [REWRITE_TAC[GSYM ROTATE2D_ADD; REAL_ADD_LINV; ROTATE2D_ZERO];
5395         ALL_TAC] THEN
5396       MP_TAC(ISPECL [`--x:real`; `rotate2d x z`] ARG_ROTATE2D) THEN
5397       ASM_REWRITE_TAC[ROTATE2D_EQ_0] THEN
5398       ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN
5399       ASM_REAL_ARITH_TAC;
5400       STRIP_TAC THEN
5401       MP_TAC(ISPECL [`x:real`; `z:complex`] ARG_ROTATE2D) THEN
5402       ASM_REWRITE_TAC[ROTATE2D_EQ_0] THEN
5403       ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN
5404       ASM_REAL_ARITH_TAC]]);;
5405
5406 let HAS_MEASURE_OPEN_SECTOR_LT = prove
5407  (`!t r. &0 <= t /\ t <= &2 * pi
5408          ==> {x:real^2 | norm(x) < r /\ &0 < Arg x /\ Arg x < t}
5409              has_measure (if &0 <= r then t * r pow 2 / &2 else &0)`,
5410   REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
5411   ASM_SIMP_TAC[NORM_ARITH `~(&0 <= r) ==> ~(norm x < r)`;
5412                EMPTY_GSPEC; HAS_MEASURE_EMPTY] THEN
5413   MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_SYMDIFF THEN
5414   EXISTS_TAC `{x | norm x <= r /\ Arg x <= t}` THEN
5415   REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN
5416   ASM_SIMP_TAC[MEASURE_CLOSED_SECTOR_LE; MEASURABLE_CLOSED_SECTOR_LE] THEN
5417   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
5418   EXISTS_TAC `{x | dist(vec 0,x) = r} UNION
5419               {z | Arg z = &0} UNION {z | Arg z = t}` THEN
5420   REWRITE_TAC[NEGLIGIBLE_ARG_EQ; REWRITE_RULE[sphere] NEGLIGIBLE_SPHERE;
5421               NEGLIGIBLE_UNION_EQ] THEN
5422   REWRITE_TAC[DIST_0; SUBSET; IN_DIFF; IN_UNION; IN_ELIM_THM] THEN
5423       MP_TAC ARG THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);;
5424
5425 let MEASURE_OPEN_SECTOR_LT = prove
5426  (`!t r. &0 <= t /\ t <= &2 * pi
5427          ==> measure {x:real^2 | norm(x) < r /\ &0 < Arg x /\ Arg x < t} =
5428              if &0 <= r then t * r pow 2 / &2 else &0`,
5429   SIMP_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE]
5430            HAS_MEASURE_OPEN_SECTOR_LT]);;
5431
5432 let HAS_MEASURE_OPEN_SECTOR_LT_GEN = prove
5433  (`!w z.
5434         ~(w = vec 0)
5435         ==> {x | norm(x) < r /\ &0 < Arg(x / w) /\ Arg(x / w) < Arg(z / w)}
5436             has_measure (if &0 <= r then Arg(z / w) * r pow 2 / &2 else &0)`,
5437   GEOM_BASIS_MULTIPLE_TAC 1 `w:complex` THEN
5438   X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN
5439   ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
5440   REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN
5441   SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID] THEN ASM_REWRITE_TAC[CX_INJ] THEN
5442   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_OPEN_SECTOR_LT THEN
5443   SIMP_TAC[ARG; REAL_LT_IMP_LE]);;
5444
5445 (* ------------------------------------------------------------------------- *)
5446 (* Hence volume of a wedge of a ball.                                        *)
5447 (* ------------------------------------------------------------------------- *)
5448
5449 let MEASURABLE_BALL_WEDGE = prove
5450  (`!z:real^3 w w1 w2. measurable(ball(z,r) INTER wedge z w w1 w2)`,
5451   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_OPEN THEN CONJ_TAC THENL
5452    [MATCH_MP_TAC BOUNDED_INTER THEN REWRITE_TAC[BOUNDED_BALL];
5453     MATCH_MP_TAC OPEN_INTER THEN REWRITE_TAC[OPEN_BALL] THEN
5454     ASM_SIMP_TAC[OPEN_WEDGE]]);;
5455
5456 let VOLUME_BALL_WEDGE = prove
5457  (`!z:real^3 w r w1 w2.
5458         &0 <= r ==> measure(ball(z,r) INTER wedge z w w1 w2) =
5459                        azim z w w1 w2 * &2 * r pow 3 / &3`,
5460   REPEAT GEN_TAC THEN
5461   ASM_CASES_TAC `z:real^3 = w \/  collinear{z,w,w1} \/ collinear{z,w,w2}` THENL
5462    [FIRST_X_ASSUM STRIP_ASSUME_TAC THEN
5463     ASM_SIMP_TAC[WEDGE_DEGENERATE; AZIM_DEGENERATE; INTER_EMPTY; REAL_MUL_LZERO;
5464                  MEASURE_EMPTY];
5465     FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; DE_MORGAN_THM]] THEN
5466   REWRITE_TAC[wedge] THEN GEOM_ORIGIN_TAC `z:real^3` THEN
5467   GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN
5468   X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN
5469   ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
5470   ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE] THEN
5471   REPEAT STRIP_TAC THEN
5472   MATCH_MP_TAC(INST_TYPE[`:2`,`:M`; `:3`,`:N`] FUBINI_SIMPLE_OPEN) THEN
5473   EXISTS_TAC `3` THEN REWRITE_TAC[DIMINDEX_2; DIMINDEX_3; ARITH] THEN
5474   REPEAT CONJ_TAC THENL
5475    [MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET; BOUNDED_BALL];
5476     REWRITE_TAC[GSYM wedge] THEN MATCH_MP_TAC OPEN_INTER THEN
5477     ASM_REWRITE_TAC[OPEN_BALL; OPEN_WEDGE];
5478     SIMP_TAC[SLICE_INTER; DIMINDEX_2; DIMINDEX_3; ARITH; SLICE_BALL]] THEN
5479   ONCE_REWRITE_TAC[TAUT `~a /\ b /\ c <=> ~(~a ==> ~(b /\ c))`] THEN
5480   ASM_SIMP_TAC[AZIM_ARG] THEN REWRITE_TAC[COLLINEAR_BASIS_3] THEN
5481   RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN
5482   REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; DROPOUT_0] THEN
5483   MAP_EVERY ABBREV_TAC
5484    [`v1:real^2 = dropout 3 (w1:real^3)`;
5485     `v2:real^2 = dropout 3 (w2:real^3)`] THEN
5486   REWRITE_TAC[SLICE_DROPOUT_3; VEC_COMPONENT; REAL_SUB_RZERO] THEN
5487   ONCE_REWRITE_TAC[COND_RAND] THEN
5488   ONCE_REWRITE_TAC[COND_RATOR] THEN
5489   REWRITE_TAC[INTER_EMPTY] THEN REWRITE_TAC[INTER; IN_BALL_0; IN_ELIM_THM] THEN
5490   ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[MEASURE_EMPTY] THEN
5491   MAP_EVERY UNDISCH_TAC
5492    [`~(v1:complex = vec 0)`; `~(v2:complex = vec 0)`] THEN
5493   MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`v2:complex`; `v1:complex`] THEN
5494   UNDISCH_TAC `&0 <= r` THEN SPEC_TAC(`r:real`,`r:real`) THEN
5495   REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN
5496   POP_ASSUM_LIST(K ALL_TAC) THEN GEOM_BASIS_MULTIPLE_TAC 1 `v1:complex` THEN
5497   X_GEN_TAC `v1:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN
5498   ASM_CASES_TAC `v1 = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
5499   REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN
5500   SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID; CX_INJ] THEN REPEAT STRIP_TAC THEN
5501   SUBGOAL_THEN
5502    `!t z. ~(z = Cx(&0)) /\ &0 < Arg z /\ Arg z < t <=>
5503           &0 < Arg z /\ Arg z < t`
5504    (fun th -> REWRITE_TAC[th])
5505   THENL [MESON_TAC[ARG_0; REAL_LT_REFL]; ALL_TAC] THEN
5506   ASM_SIMP_TAC[MEASURE_OPEN_SECTOR_LT; REAL_LE_REFL; ARG; REAL_LT_IMP_LE] THEN
5507   SUBGOAL_THEN `!t. abs(t) < r <=> t IN real_interval(--r,r)`
5508    (fun th -> REWRITE_TAC[th])
5509   THENL [REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN
5510   REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN
5511   REWRITE_TAC[HAS_REAL_INTEGRAL_OPEN_INTERVAL] THEN
5512   MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN
5513   EXISTS_TAC `\t. Arg v2 * (r pow 2 - t pow 2) / &2` THEN CONJ_TAC THENL
5514    [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL; REAL_BOUNDS_LE] THEN
5515     SIMP_TAC[AREA_CBALL; SQRT_POS_LE; REAL_SUB_LE; GSYM REAL_LE_SQUARE_ABS;
5516              SQRT_POW_2; REAL_ARITH `abs x <= r ==> abs x <= abs r`];
5517     ALL_TAC] THEN
5518   MP_TAC(ISPECL
5519    [`\t. Arg v2 * (r pow 2 * t - &1 / &3 * t pow 3) / &2`;
5520     `\t. Arg v2 * (r pow 2 - t pow 2) / &2`;
5521     `--r:real`; `r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN
5522   REWRITE_TAC[] THEN ANTS_TAC THENL
5523    [CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
5524     REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN
5525     CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING;
5526     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
5527     CONV_TAC REAL_RING]);;
5528
5529 (* ------------------------------------------------------------------------- *)
5530 (* Hence volume of lune.                                                     *)
5531 (* ------------------------------------------------------------------------- *)
5532
5533 let HAS_MEASURE_LUNE = prove
5534  (`!z:real^3 w r w1 w2.
5535         &0 <= r /\ ~(w = z) /\
5536         ~collinear {z,w,w1} /\ ~collinear {z,w,w2} /\ ~(dihV z w w1 w2 = pi)
5537         ==> (ball(z,r) INTER aff_gt {z,w} {w1,w2})
5538             has_measure (dihV z w w1 w2 * &2 * r pow 3 / &3)`,
5539   GEOM_ORIGIN_TAC `z:real^3` THEN
5540   GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN
5541   X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN
5542   ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[] THENL
5543    [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
5544   DISCH_TAC THEN REPEAT GEN_TAC THEN
5545   ASM_SIMP_TAC[DIHV_SPECIAL_SCALE] THEN
5546   MP_TAC(ISPECL [`{}:real^3->bool`; `{w1:real^3,w2:real^3}`;
5547                  `w:real`; `basis 3:real^3`] AFF_GT_SPECIAL_SCALE) THEN
5548   ASM_CASES_TAC `w1:real^3 = vec 0` THENL
5549    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
5550   ASM_CASES_TAC `w2:real^3 = vec 0` THENL
5551    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
5552   ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN
5553   ASM_CASES_TAC `w1:real^3 = w % basis 3` THENL
5554    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
5555   ASM_CASES_TAC `w2:real^3 = w % basis 3` THENL
5556    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
5557   ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE] THEN
5558   ASM_CASES_TAC `w1:real^3 = basis 3` THENL
5559    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
5560   ASM_CASES_TAC `w2:real^3 = basis 3` THENL
5561    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN
5562   ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
5563   ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN STRIP_TAC THEN
5564   ASM_CASES_TAC `azim (vec 0) (basis 3) w1 w2 = &0` THENL
5565    [MP_TAC(ASSUME `azim (vec 0) (basis 3) w1 w2 = &0`) THEN
5566     W(MP_TAC o PART_MATCH (lhs o rand) AZIM_DIVH o lhs o lhand o snd) THEN
5567     ASM_REWRITE_TAC[PI_POS] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
5568     REWRITE_TAC[REAL_MUL_LZERO; HAS_MEASURE_0] THEN
5569     MATCH_MP_TAC COPLANAR_IMP_NEGLIGIBLE THEN
5570     MATCH_MP_TAC COPLANAR_SUBSET THEN
5571     EXISTS_TAC `affine hull {vec 0:real^3,basis 3,w1,w2}` THEN
5572     CONJ_TAC THENL
5573      [ASM_MESON_TAC[COPLANAR_AFFINE_HULL_COPLANAR; AZIM_EQ_0_PI_IMP_COPLANAR];
5574       ALL_TAC] THEN
5575     MATCH_MP_TAC(SET_RULE `t SUBSET u ==> (s INTER t) SUBSET u`) THEN
5576     SIMP_TAC[aff_gt_def; AFFSIGN; sgn_gt; AFFINE_HULL_FINITE;
5577              FINITE_INSERT; FINITE_EMPTY] THEN
5578     REWRITE_TAC[SET_RULE `{a,b} UNION {c,d} = {a,b,c,d}`] THEN
5579     REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN
5580     MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[];
5581     ALL_TAC] THEN
5582   SUBGOAL_THEN `&0 < azim (vec 0) (basis 3) w1 w2` ASSUME_TAC THENL
5583    [ASM_REWRITE_TAC[REAL_LT_LE; azim]; ALL_TAC] THEN
5584   ASM_CASES_TAC `azim (vec 0) (basis 3) w1 w2 < pi` THENL
5585    [ASM_SIMP_TAC[GSYM AZIM_DIHV_SAME; GSYM WEDGE_LUNE_GT] THEN
5586     ASM_SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_BALL_WEDGE;
5587                  VOLUME_BALL_WEDGE];
5588     ALL_TAC] THEN
5589   ASM_CASES_TAC `azim (vec 0) (basis 3) w1 w2 = pi` THENL
5590    [MP_TAC(ISPECL [`vec 0:real^3`; `basis 3:real^3`; `w1:real^3`; `w2:real^3`]
5591            AZIM_DIVH) THEN
5592     ASM_REWRITE_TAC[REAL_LT_REFL] THEN ASM_REAL_ARITH_TAC;
5593     ALL_TAC] THEN
5594   SUBGOAL_THEN
5595    `dihV (vec 0) (basis 3) w1 w2 = azim (vec 0) (basis 3) w2 w1`
5596   SUBST1_TAC THENL
5597    [W(MP_TAC o PART_MATCH (lhs o rand) AZIM_COMPL o rand o snd) THEN
5598     ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
5599     ONCE_REWRITE_TAC[REAL_ARITH `x:real = y - z <=> z = y - x`] THEN
5600     MATCH_MP_TAC AZIM_DIHV_COMPL THEN
5601     ASM_REWRITE_TAC[GSYM REAL_NOT_LT];
5602     ALL_TAC] THEN
5603   SUBGOAL_THEN `&0 < azim (vec 0) (basis 3) w2 w1 /\
5604                 azim (vec 0) (basis 3) w2 w1 < pi`
5605   ASSUME_TAC THENL
5606    [W(MP_TAC o PART_MATCH (lhs o rand) AZIM_COMPL o lhand o rand o snd) THEN
5607     ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
5608     MP_TAC(ISPECL [`vec 0:real^3`; `basis 3:real^3`; `w1:real^3`; `w2:real^3`]
5609         azim) THEN
5610     REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN
5611     ASM_REAL_ARITH_TAC;
5612     ALL_TAC] THEN
5613   SUBST1_TAC(SET_RULE `{w1:real^3,w2} = {w2,w1}`) THEN
5614   ASM_SIMP_TAC[GSYM AZIM_DIHV_SAME; GSYM WEDGE_LUNE_GT] THEN
5615   ASM_SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_BALL_WEDGE;
5616                VOLUME_BALL_WEDGE]);;
5617
5618 let HAS_MEASURE_LUNE_SIMPLE = prove
5619  (`!z:real^3 w r w1 w2.
5620         &0 <= r /\ ~coplanar{z,w,w1,w2}
5621         ==> (ball(z,r) INTER aff_gt {z,w} {w1,w2})
5622             has_measure (dihV z w w1 w2 * &2 * r pow 3 / &3)`,
5623   REPEAT GEN_TAC THEN
5624   ASM_CASES_TAC `w:real^3 = z` THENL
5625    [ASM_REWRITE_TAC[INSERT_AC; COPLANAR_3]; ALL_TAC] THEN
5626   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_LUNE THEN
5627   ASM_REWRITE_TAC[] THEN
5628   MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN
5629   REPEAT(CONJ_TAC THENL
5630    [ASM_MESON_TAC[NOT_COPLANAR_NOT_COLLINEAR; INSERT_AC]; ALL_TAC]) THEN
5631   REPEAT STRIP_TAC THEN
5632   MP_TAC(ISPECL [`z:real^3`; `w:real^3`; `w1:real^3`; `w2:real^3`]
5633         AZIM_DIVH) THEN
5634   ASM_REWRITE_TAC[REAL_ARITH `&2 * pi - pi = pi`; COND_ID] THEN
5635   ASM_MESON_TAC[AZIM_EQ_0_PI_IMP_COPLANAR]);;
5636
5637 (* ------------------------------------------------------------------------- *)
5638 (* Now the volume of a solid triangle.                                       *)
5639 (* ------------------------------------------------------------------------- *)
5640
5641 let MEASURABLE_BALL_AFF_GT = prove
5642  (`!z r s t. measurable(ball(z,r) INTER aff_gt s t)`,
5643   MESON_TAC[MEASURABLE_CONVEX; CONVEX_INTER; CONVEX_AFF_GT; CONVEX_BALL;
5644             BOUNDED_INTER; BOUNDED_BALL]);;
5645
5646 let AFF_GT_SHUFFLE = prove
5647  (`!s t v:real^N.
5648         FINITE s /\ FINITE t /\
5649         vec 0 IN s /\ ~(vec 0 IN t) /\
5650         ~(v IN s) /\ ~(--v IN s) /\ ~(v IN t)
5651         ==> aff_gt (v INSERT s) t =
5652             aff_gt s (v INSERT t) UNION
5653             aff_gt s (--v INSERT t) UNION
5654             aff_gt s t`,
5655   REPEAT STRIP_TAC THEN
5656   REWRITE_TAC[aff_gt_def; AFFSIGN_ALT; sgn_gt] THEN
5657   REWRITE_TAC[SET_RULE `(v INSERT s) UNION t = v INSERT (s UNION t)`;
5658               SET_RULE `s UNION (v INSERT t) = v INSERT (s UNION t)`] THEN
5659   ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN;
5660                RIGHT_EXISTS_AND_THM; REAL_LT_ADD; REAL_HALF; FINITE_EMPTY] THEN
5661   REWRITE_TAC[IN_INSERT] THEN
5662   ASM_SIMP_TAC[SET_RULE
5663    `~(a IN s)
5664     ==> ((w IN s UNION t ==> w = a \/ w IN t ==> P w) <=>
5665          (w IN t ==> P w))`] THEN
5666   REWRITE_TAC[SET_RULE `x IN (s UNION t)
5667                         ==> x IN t ==> P x <=> x IN t ==> P  x`] THEN
5668   REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM] THEN
5669   X_GEN_TAC `y:real^N` THEN EQ_TAC THENL
5670    [DISCH_THEN(X_CHOOSE_THEN `v:real` ASSUME_TAC) THEN
5671     ASM_CASES_TAC `&0 < v` THENL
5672      [DISJ1_TAC THEN EXISTS_TAC `v:real` THEN ASM_REWRITE_TAC[];
5673       DISJ2_TAC] THEN
5674     ASM_CASES_TAC `v = &0` THENL
5675      [DISJ2_TAC THEN
5676       FIRST_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC MONO_EXISTS) THEN
5677       ASM_REWRITE_TAC[REAL_SUB_RZERO; VECTOR_MUL_LZERO; VECTOR_SUB_RZERO];
5678       DISJ1_TAC] THEN
5679     EXISTS_TAC `--v:real` THEN CONJ_TAC THENL
5680      [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
5681     FIRST_X_ASSUM(X_CHOOSE_THEN `f:real^N->real` STRIP_ASSUME_TAC) THEN
5682     EXISTS_TAC `\x:real^N. if x = vec 0 then f(x) + &2 * v else f(x)` THEN
5683     REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
5684      [ASM_MESON_TAC[];
5685       ASM_SIMP_TAC[SUM_CASES_1; FINITE_UNION; IN_UNION] THEN REAL_ARITH_TAC;
5686       REWRITE_TAC[VECTOR_ARITH `--a % --x:real^N = a % x`] THEN
5687       FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN
5688       MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[] THEN
5689       REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
5690       ASM_REWRITE_TAC[VECTOR_MUL_RZERO]];
5691     DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [MESON_TAC[]; ALL_TAC] THEN
5692     DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL
5693      [DISCH_THEN(X_CHOOSE_THEN `a:real`
5694        (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5695       DISCH_THEN(X_CHOOSE_THEN `f:real^N->real` STRIP_ASSUME_TAC) THEN
5696       EXISTS_TAC `--a:real` THEN
5697       EXISTS_TAC `\x:real^N. if x = vec 0 then &2 * a + f(vec 0) else f x` THEN
5698       ASM_SIMP_TAC[SUM_CASES_1; FINITE_UNION; IN_UNION] THEN
5699       CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
5700       CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN
5701       ONCE_REWRITE_TAC[VECTOR_ARITH `y - --a % v:real^N = y - a % --v`] THEN
5702       FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
5703       MATCH_MP_TAC VSUM_EQ THEN REPEAT GEN_TAC THEN REWRITE_TAC[] THEN
5704       DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO];
5705       GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN
5706       MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN
5707       EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN
5708       VECTOR_ARITH_TAC]]);;
5709
5710 let MEASURE_BALL_AFF_GT_SHUFFLE_LEMMA = prove
5711  (`!r s t v:real^N.
5712         &0 <= r /\
5713         independent(v INSERT((s DELETE vec 0) UNION t)) /\
5714         FINITE s /\ FINITE t /\ CARD(s UNION t) <= dimindex(:N) /\
5715         vec 0 IN s /\ ~(vec 0 IN t) /\
5716         ~(v IN s) /\ ~(--v IN s) /\ ~(v IN t)
5717         ==> measure(ball(vec 0,r) INTER aff_gt (v INSERT s) t) =
5718             measure(ball(vec 0,r) INTER aff_gt s (v INSERT t)) +
5719             measure(ball(vec 0,r) INTER aff_gt s (--v INSERT t))`,
5720   let lemma = prove
5721    (`!s t u:real^N->bool.
5722           measurable s /\ measurable t /\ s INTER t = {} /\ negligible u
5723           ==> measure(s UNION t UNION u) = measure s + measure t`,
5724     REPEAT STRIP_TAC THEN REWRITE_TAC[UNION_ASSOC] THEN
5725     ASM_SIMP_TAC[GSYM MEASURE_DISJOINT_UNION; DISJOINT] THEN
5726     MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN
5727     ASM_SIMP_TAC[MEASURABLE_UNION] THEN
5728     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
5729      (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]) in
5730   REPEAT STRIP_TAC THEN
5731   W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_SHUFFLE o
5732     rand o rand o lhand o snd) THEN
5733   ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
5734   REWRITE_TAC[UNION_OVER_INTER] THEN MATCH_MP_TAC lemma THEN
5735   ASM_REWRITE_TAC[MEASURABLE_BALL_AFF_GT] THEN CONJ_TAC THENL
5736    [MATCH_MP_TAC(SET_RULE
5737      `t INTER u = {} ==> (s INTER t) INTER (s INTER u) = {}`) THEN
5738     REWRITE_TAC[aff_gt_def; AFFSIGN_ALT; sgn_gt] THEN
5739     REWRITE_TAC[SET_RULE `(v INSERT s) UNION t = v INSERT (s UNION t)`;
5740                 SET_RULE `s UNION (v INSERT t) = v INSERT (s UNION t)`] THEN
5741     ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN;
5742                  RIGHT_EXISTS_AND_THM; REAL_LT_ADD;
5743                  REAL_HALF; FINITE_EMPTY] THEN
5744     REWRITE_TAC[IN_INSERT] THEN
5745     ASM_SIMP_TAC[SET_RULE
5746      `~(a IN s) ==> ((w IN s UNION t ==> w = a \/ w IN t ==> P w) <=>
5747                      (w IN t ==> P w))`] THEN
5748     GEN_REWRITE_TAC I [EXTENSION] THEN
5749     REWRITE_TAC[IN_INTER; NOT_IN_EMPTY; IN_ELIM_THM] THEN
5750     X_GEN_TAC `y:real^N` THEN
5751     DISCH_THEN(CONJUNCTS_THEN2
5752      (X_CHOOSE_THEN `a:real`
5753        (CONJUNCTS_THEN2 ASSUME_TAC
5754          (X_CHOOSE_THEN `f:real^N->real` STRIP_ASSUME_TAC)))
5755      (X_CHOOSE_THEN `b:real`
5756        (CONJUNCTS_THEN2 ASSUME_TAC
5757          (X_CHOOSE_THEN `g:real^N->real` STRIP_ASSUME_TAC)))) THEN
5758     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INDEPENDENT_EXPLICIT]) THEN
5759     REWRITE_TAC[FINITE_INSERT; FINITE_DELETE; FINITE_UNION] THEN
5760     DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
5761     DISCH_THEN(MP_TAC o SPEC
5762      `\x. if x = v then a + b else (f:real^N->real) x - g x`) THEN
5763     ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_DELETE; FINITE_UNION] THEN
5764     ASM_REWRITE_TAC[IN_DELETE; IN_UNION] THEN
5765     REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
5766      [ALL_TAC; DISCH_THEN(MP_TAC o SPEC `v:real^N`) THEN
5767       REWRITE_TAC[IN_INSERT] THEN ASM_REAL_ARITH_TAC] THEN
5768     ASM_SIMP_TAC[SET_RULE
5769       `~(a IN t) ==> (s DELETE a) UNION t = (s UNION t) DELETE a`] THEN
5770     ASM_SIMP_TAC[VSUM_DELETE_CASES; FINITE_UNION; IN_UNION] THEN
5771     REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN
5772     SUBGOAL_THEN
5773      `!x:real^N. (if x = v then a + b else f x - g x) % x =
5774                  (if x = v then a else f x) % x -
5775                  (if x = v then --b else g x) % x`
5776      (fun th -> REWRITE_TAC[th])
5777     THENL
5778      [GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC;
5779       ASM_SIMP_TAC[VSUM_SUB; FINITE_UNION]] THEN
5780     MATCH_MP_TAC EQ_TRANS THEN
5781     EXISTS_TAC `(a + b) % v + (y - a % v) - (y - b % --v):real^N` THEN
5782     CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN
5783     AP_TERM_TAC THEN BINOP_TAC THEN
5784     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN
5785     MATCH_MP_TAC VSUM_EQ THEN GEN_TAC THEN REWRITE_TAC[] THEN
5786     COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_UNION];
5787     MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
5788     EXISTS_TAC `aff_gt s t :real^N->bool` THEN
5789     REWRITE_TAC[INTER_SUBSET] THEN
5790     MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
5791     EXISTS_TAC `affine hull (s UNION t:real^N->bool)` THEN
5792     REWRITE_TAC[AFF_GT_SUBSET_AFFINE_HULL] THEN
5793     ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; IN_UNION; HULL_INC] THEN
5794     ONCE_REWRITE_TAC[GSYM SPAN_DELETE_0] THEN
5795     MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN
5796     MATCH_MP_TAC LET_TRANS THEN
5797     EXISTS_TAC `CARD((s UNION t) DELETE (vec 0:real^N))` THEN
5798     ASM_SIMP_TAC[DIM_LE_CARD; FINITE_DELETE; FINITE_UNION; DIM_SPAN] THEN
5799     ASM_SIMP_TAC[CARD_DELETE; IN_UNION; FINITE_UNION] THEN
5800     MATCH_MP_TAC(ARITH_RULE `1 <= n /\ x <= n ==> x - 1 < n`) THEN
5801     ASM_REWRITE_TAC[DIMINDEX_GE_1]]);;
5802
5803 let MEASURE_BALL_AFF_GT_SHUFFLE = prove
5804  (`!r s t v:real^N.
5805         &0 <= r /\ ~(v IN (s UNION t)) /\
5806         independent(v INSERT (s UNION t))
5807         ==> measure(ball(vec 0,r) INTER aff_gt (vec 0 INSERT v INSERT s) t) =
5808             measure(ball(vec 0,r) INTER aff_gt (vec 0 INSERT s) (v INSERT t)) +
5809             measure(ball(vec 0,r) INTER
5810                     aff_gt (vec 0 INSERT s) (--v INSERT t))`,
5811   REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN
5812   MP_TAC(ISPECL [`r:real`; `(vec 0:real^N) INSERT s`;
5813                  `t:real^N->bool`; `v:real^N`]
5814         MEASURE_BALL_AFF_GT_SHUFFLE_LEMMA) THEN
5815   ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[INSERT_AC]] THEN
5816   ASM_REWRITE_TAC[IN_INSERT; FINITE_INSERT] THEN
5817   FIRST_ASSUM(MP_TAC o MATCH_MP INDEPENDENT_NONZERO) THEN
5818   REWRITE_TAC[IN_INSERT; IN_UNION; DE_MORGAN_THM] THEN
5819   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5820   FIRST_ASSUM(MP_TAC o MATCH_MP INDEPENDENT_BOUND) THEN
5821   REWRITE_TAC[FINITE_INSERT; FINITE_UNION] THEN
5822   DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
5823   REWRITE_TAC[SET_RULE `(a INSERT s) UNION t = a INSERT (s UNION t)`] THEN
5824   ASM_SIMP_TAC[CARD_CLAUSES; FINITE_UNION; IN_UNION; FINITE_INSERT] THEN
5825   DISCH_TAC THEN ASM_REWRITE_TAC[VECTOR_NEG_EQ_0] THEN CONJ_TAC THENL
5826    [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
5827      (REWRITE_RULE[IMP_CONJ] INDEPENDENT_MONO)) THEN
5828     SET_TAC[];
5829     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN
5830     REWRITE_TAC[dependent; CONTRAPOS_THM] THEN DISCH_TAC THEN
5831     EXISTS_TAC `v:real^N` THEN REWRITE_TAC[IN_INSERT] THEN
5832     GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_NEG_NEG] THEN
5833     MATCH_MP_TAC SPAN_NEG THEN MATCH_MP_TAC SPAN_SUPERSET THEN
5834     ASM_REWRITE_TAC[IN_DELETE; VECTOR_ARITH `--v:real^N = v <=> v = vec 0`;
5835                     IN_INSERT; IN_UNION]]);;
5836
5837 let MEASURE_LUNE_DECOMPOSITION = prove
5838  (`!v1 v2 v3:real^3.
5839          &0 <= r /\ ~coplanar {vec 0, v1, v2, v3}
5840          ==> measure(ball(vec 0,r) INTER aff_gt {vec 0} {v1,v2,v3}) +
5841              measure(ball(vec 0,r) INTER aff_gt {vec 0} {--v1,v2,v3}) =
5842              dihV (vec 0) v1 v2 v3 * &2 * r pow 3 / &3`,
5843   let rec distinctpairs l =
5844     match l with
5845      x::t -> itlist (fun y a -> (x,y) :: a) t (distinctpairs t)
5846     | [] -> [] in
5847   REPEAT GEN_TAC THEN MAP_EVERY
5848    (fun t -> ASM_CASES_TAC t THENL
5849     [ASM_REWRITE_TAC[INSERT_AC; COPLANAR_3]; ALL_TAC])
5850    (map mk_eq (distinctpairs
5851     [`v3:real^3`; `v2:real^3`; `v1:real^3`; `vec 0:real^3`])) THEN
5852   REPEAT STRIP_TAC THEN
5853   ASM_SIMP_TAC[GSYM(REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE]
5854     HAS_MEASURE_LUNE_SIMPLE)] THEN
5855   CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_BALL_AFF_GT_SHUFFLE THEN
5856   ASM_REWRITE_TAC[UNION_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN
5857   ASM_SIMP_TAC[NOT_COPLANAR_0_4_IMP_INDEPENDENT]);;
5858
5859 let SOLID_TRIANGLE_CONGRUENT_NEG = prove
5860  (`!r v1 v2 v3:real^N.
5861         measure(ball(vec 0,r) INTER aff_gt {vec 0} {--v1, --v2, --v3}) =
5862         measure(ball(vec 0,r) INTER aff_gt {vec 0} {v1, v2, v3})`,
5863   REPEAT GEN_TAC THEN
5864   SUBGOAL_THEN
5865    `ball(vec 0:real^N,r) INTER aff_gt {vec 0} {--v1, --v2, --v3} =
5866     IMAGE (--)
5867           (ball(vec 0,r) INTER aff_gt {vec 0} {v1, v2, v3})`
5868   SUBST1_TAC THENL
5869    [ALL_TAC;
5870     MATCH_MP_TAC MEASURE_ORTHOGONAL_IMAGE_EQ THEN
5871     REWRITE_TAC[ORTHOGONAL_TRANSFORMATION; linear; NORM_NEG] THEN
5872     CONJ_TAC THEN VECTOR_ARITH_TAC] THEN
5873   CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
5874   CONJ_TAC THENL [MESON_TAC[VECTOR_NEG_NEG]; ALL_TAC] THEN
5875   REWRITE_TAC[IN_INTER; IN_BALL_0; NORM_NEG] THEN
5876   REWRITE_TAC[AFFSIGN_ALT; aff_gt_def; sgn_gt; IN_ELIM_THM] THEN
5877   REWRITE_TAC[SET_RULE `{a} UNION {b,c,d} = {a,b,d,c}`] THEN
5878   REWRITE_TAC[SET_RULE `x IN {a} <=> a = x`] THEN
5879   ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN;
5880                RIGHT_EXISTS_AND_THM; REAL_LT_ADD; REAL_HALF; FINITE_EMPTY] THEN
5881   ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN
5882   REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN
5883   REWRITE_TAC[VECTOR_ARITH `vec 0:real^N = --x <=> vec 0 = x`] THEN
5884   REWRITE_TAC[VECTOR_ARITH `--x - a % --w:real^N = --(x - a % w)`] THEN
5885   REWRITE_TAC[VECTOR_NEG_EQ_0]);;
5886
5887 let VOLUME_SOLID_TRIANGLE = prove
5888  (`!r v0 v1 v2 v3:real^3.
5889        &0 < r /\ ~coplanar{v0, v1, v2, v3}
5890        ==> measure(ball(v0,r) INTER aff_gt {v0} {v1,v2,v3}) =
5891                 let a123 = dihV v0 v1 v2 v3 in
5892                 let a231 = dihV v0 v2 v3 v1 in
5893                 let a312 = dihV v0 v3 v1 v2 in
5894                   (a123 + a231 + a312 - pi) * r pow 3 / &3`,
5895   let tac convl =
5896     W(MP_TAC o PART_MATCH (lhs o rand) MEASURE_BALL_AFF_GT_SHUFFLE o
5897       convl o lhand o lhand o snd) THEN
5898     ASM_REWRITE_TAC[UNION_EMPTY; IN_INSERT; IN_UNION; NOT_IN_EMPTY] THEN
5899     REWRITE_TAC[SET_RULE `(a INSERT s) UNION t = a INSERT (s UNION t)`] THEN
5900     ASM_SIMP_TAC[UNION_EMPTY; REAL_LT_IMP_LE] THEN ANTS_TAC THENL
5901      [CONJ_TAC THENL
5902        [DISCH_THEN(STRIP_THM_THEN SUBST_ALL_TAC) THEN
5903         RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC]) THEN
5904         RULE_ASSUM_TAC(REWRITE_RULE[COPLANAR_3]) THEN
5905         FIRST_ASSUM CONTR_TAC;
5906         MATCH_MP_TAC NOT_COPLANAR_0_4_IMP_INDEPENDENT THEN
5907         RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC]) THEN
5908         ASM_REWRITE_TAC[INSERT_AC]];
5909       DISCH_THEN SUBST1_TAC] in
5910   GEN_TAC THEN GEOM_ORIGIN_TAC `v0:real^3` THEN
5911   CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN REPEAT STRIP_TAC THEN
5912   SUBGOAL_THEN
5913     `measure(ball(vec 0:real^3,r) INTER aff_gt {vec 0,v1,v2,v3} {}) =
5914      &4 / &3 * pi * r pow 3`
5915   MP_TAC THENL
5916    [MP_TAC(SPECL [`vec 0:real^3`; `r:real`] VOLUME_BALL) THEN
5917     ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN
5918     DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN
5919     MATCH_MP_TAC(SET_RULE `t = UNIV ==> s INTER t = s`) THEN
5920     REWRITE_TAC[AFF_GT_EQ_AFFINE_HULL] THEN
5921     SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT; SPAN_INSERT_0] THEN
5922     REWRITE_TAC[SET_RULE `s = UNIV <=> UNIV SUBSET s`] THEN
5923     MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN
5924     ASM_SIMP_TAC[DIM_UNIV; DIMINDEX_3; SUBSET_UNIV] THEN
5925     ASM_SIMP_TAC[NOT_COPLANAR_0_4_IMP_INDEPENDENT] THEN
5926     SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN
5927     REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN
5928     MAP_EVERY (fun t ->
5929       ASM_CASES_TAC t THENL
5930        [FIRST_X_ASSUM SUBST_ALL_TAC THEN
5931         RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC; COPLANAR_3]) THEN
5932         ASM_MESON_TAC[];
5933         ASM_REWRITE_TAC[]])
5934      [`v3:real^3 = v2`; `v3:real^3 = v1`; `v2:real^3 = v1`] THEN
5935     CONV_TAC NUM_REDUCE_CONV;
5936     ALL_TAC] THEN
5937   SUBGOAL_THEN
5938    `~(coplanar {vec 0:real^3,v1,v2,v3}) /\
5939     ~(coplanar {vec 0,--v1,v2,v3}) /\
5940     ~(coplanar {vec 0,v1,--v2,v3}) /\
5941     ~(coplanar {vec 0,--v1,--v2,v3}) /\
5942     ~(coplanar {vec 0,--v1,--v2,v3}) /\
5943     ~(coplanar {vec 0,--v1,v2,--v3}) /\
5944     ~(coplanar {vec 0,v1,--v2,--v3}) /\
5945     ~(coplanar {vec 0,--v1,--v2,--v3}) /\
5946     ~(coplanar {vec 0,--v1,--v2,--v3})`
5947   STRIP_ASSUME_TAC THENL
5948    [REPLICATE_TAC 3
5949      (REWRITE_TAC[COPLANAR_INSERT_0_NEG] THEN
5950       ONCE_REWRITE_TAC[SET_RULE `{vec 0,a,b,c} = {vec 0,b,c,a}`]) THEN
5951     ASM_REWRITE_TAC[];
5952     ALL_TAC] THEN
5953   MAP_EVERY tac
5954    [I; lhand; rand;
5955     lhand o lhand; rand o lhand; lhand o rand; rand o rand] THEN
5956   MP_TAC(ISPECL [`v1:real^3`; `v2:real^3`; `v3:real^3`]
5957     MEASURE_LUNE_DECOMPOSITION) THEN
5958   MP_TAC(ISPECL [`v2:real^3`; `v3:real^3`; `v1:real^3`]
5959     MEASURE_LUNE_DECOMPOSITION) THEN
5960   MP_TAC(ISPECL [`v3:real^3`; `v1:real^3`; `v2:real^3`]
5961     MEASURE_LUNE_DECOMPOSITION) THEN
5962   MP_TAC(ISPECL [`--v1:real^3`; `--v2:real^3`; `--v3:real^3`]
5963     MEASURE_LUNE_DECOMPOSITION) THEN
5964   MP_TAC(ISPECL [`--v2:real^3`; `--v3:real^3`; `--v1:real^3`]
5965     MEASURE_LUNE_DECOMPOSITION) THEN
5966   MP_TAC(ISPECL [`--v3:real^3`; `--v1:real^3`; `--v2:real^3`]
5967     MEASURE_LUNE_DECOMPOSITION) THEN
5968   ASM_REWRITE_TAC[VECTOR_NEG_NEG] THEN
5969   ASM_SIMP_TAC[REAL_LT_IMP_LE; INSERT_AC] THEN
5970   RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC]) THEN ASM_REWRITE_TAC[] THEN
5971   REWRITE_TAC[DIHV_NEG_0] THEN
5972   REWRITE_TAC[SOLID_TRIANGLE_CONGRUENT_NEG] THEN
5973   REWRITE_TAC[INSERT_AC] THEN REAL_ARITH_TAC);;
5974
5975 (* ------------------------------------------------------------------------- *)
5976 (* Volume of wedge of a frustum.                                             *)
5977 (* ------------------------------------------------------------------------- *)
5978
5979 let MEASURABLE_BOUNDED_INTER_OPEN = prove
5980  (`!s t:real^N->bool.
5981        measurable s /\ bounded s /\ open t ==> measurable(s INTER t)`,
5982   REPEAT STRIP_TAC THEN
5983   FIRST_X_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_OPEN_INTERVAL) THEN
5984   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
5985   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
5986   DISCH_THEN(SUBST1_TAC o MATCH_MP (SET_RULE
5987    `s SUBSET i ==> s INTER t = s INTER (t INTER i)`)) THEN
5988   MATCH_MP_TAC MEASURABLE_INTER THEN ASM_REWRITE_TAC[] THEN
5989   MATCH_MP_TAC MEASURABLE_OPEN THEN
5990   ASM_SIMP_TAC[OPEN_INTER; OPEN_INTERVAL; BOUNDED_INTER; BOUNDED_INTERVAL]);;
5991
5992 let SLICE_SPECIAL_WEDGE = prove
5993  (`!w1 w2.
5994         ~collinear {vec 0, basis 3, w1} /\ ~collinear {vec 0, basis 3, w2}
5995         ==> slice 3 t (wedge (vec 0) (basis 3) w1 w2) =
5996             {z | &0 < Arg(z / dropout 3 w1) /\
5997                  Arg(z / dropout 3 w1) < Arg(dropout 3 w2 / dropout 3 w1)}`,
5998   REWRITE_TAC[wedge] THEN
5999   ONCE_REWRITE_TAC[TAUT `~a /\ b /\ c <=> ~(~a ==> ~(b /\ c))`] THEN
6000   ASM_SIMP_TAC[AZIM_ARG] THEN REWRITE_TAC[COLLINEAR_BASIS_3] THEN
6001   REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; DROPOUT_0] THEN
6002   MAP_EVERY ABBREV_TAC
6003    [`v1:real^2 = dropout 3 (w1:real^3)`;
6004     `v2:real^2 = dropout 3 (w2:real^3)`] THEN
6005   REWRITE_TAC[SLICE_DROPOUT_3; VEC_COMPONENT; REAL_SUB_RZERO] THEN
6006   REPEAT STRIP_TAC THEN
6007   REWRITE_TAC[EXTENSION; IN_ELIM_THM; COMPLEX_VEC_0] THEN
6008   X_GEN_TAC `w:complex` THEN
6009   ASM_CASES_TAC `w = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN
6010   ASM_REWRITE_TAC[complex_div; COMPLEX_MUL_LZERO; ARG_0; REAL_LT_REFL]);;
6011
6012 let VOLUME_FRUSTT_WEDGE = prove
6013  (`!v0 v1:real^3 w1 w2 h a.
6014        &0 < a /\ ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2}
6015        ==> bounded(frustt v0 v1 h a INTER wedge v0 v1 w1 w2) /\
6016            measurable(frustt v0 v1 h a INTER wedge v0 v1 w1 w2) /\
6017            measure(frustt v0 v1 h a INTER wedge v0 v1 w1 w2) =
6018            if &1 <= a \/ h < &0 then &0
6019            else azim v0 v1 w1 w2 * ((h / a) pow 2 - h pow 2) * h / &6`,
6020   REPEAT GEN_TAC THEN ASM_CASES_TAC `v1:real^3 = v0` THENL
6021    [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; STRIP_TAC] THEN
6022   MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN
6023   REPEAT CONJ_TAC THENL
6024    [MATCH_MP_TAC BOUNDED_INTER THEN ASM_SIMP_TAC[VOLUME_FRUSTT_STRONG];
6025     MATCH_MP_TAC MEASURABLE_BOUNDED_INTER_OPEN THEN
6026     ASM_SIMP_TAC[VOLUME_FRUSTT_STRONG; OPEN_WEDGE];
6027     ALL_TAC] THEN
6028   REWRITE_TAC[frustt; frustum; rcone_gt; rconesgn; IN_ELIM_THM] THEN
6029   CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN
6030   POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
6031   GEOM_ORIGIN_TAC `v0:real^3` THEN
6032   REWRITE_TAC[VECTOR_SUB_RZERO; REAL_MUL_LZERO; DIST_0; real_gt] THEN
6033   GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN
6034   X_GEN_TAC `b:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN
6035   ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
6036   ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE; WEDGE_SPECIAL_SCALE] THEN
6037   ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN
6038   DISCH_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
6039   ASM_CASES_TAC `&1 <= a` THEN ASM_REWRITE_TAC[] THENL
6040    [SUBGOAL_THEN
6041      `!y:real^3. ~(norm(y) * norm(b % basis 3:real^3) * a
6042                    < y dot (b % basis 3))`
6043      (fun th -> REWRITE_TAC[th; EMPTY_GSPEC; MEASURABLE_EMPTY;
6044                     INTER_EMPTY; MEASURE_EMPTY]) THEN
6045     REWRITE_TAC[REAL_NOT_LT] THEN X_GEN_TAC `y:real^3` THEN
6046     MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN
6047     SIMP_TAC[DOT_RMUL; NORM_MUL; REAL_ABS_MUL; DOT_BASIS; NORM_BASIS;
6048              DIMINDEX_3; ARITH] THEN
6049     REWRITE_TAC[REAL_ARITH
6050      `b * y <= n * (b * &1) * a <=> b * &1 * y <= b * a * n`] THEN
6051     MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN
6052     MATCH_MP_TAC REAL_LE_MUL2 THEN
6053     ASM_SIMP_TAC[REAL_POS; REAL_ABS_POS; COMPONENT_LE_NORM; DIMINDEX_3; ARITH];
6054     ALL_TAC] THEN
6055   RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
6056   SIMP_TAC[NORM_MUL; NORM_BASIS; DOT_BASIS; DOT_RMUL; DIMINDEX_3; ARITH] THEN
6057   ONCE_REWRITE_TAC[REAL_ARITH `n * x * a:real = x * n * a`] THEN
6058   ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN
6059   ASM_SIMP_TAC[REAL_MUL_RID; REAL_LT_LMUL_EQ; REAL_LT_MUL_EQ; NORM_POS_LT] THEN
6060   ASM_SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_3; ARITH;
6061                REAL_LT_IMP_NZ] THEN
6062   ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_LT_SQUARE] THEN
6063   ASM_SIMP_TAC[REAL_POW_DIV; REAL_POW_LT; REAL_LT_RDIV_EQ] THEN
6064   REWRITE_TAC[REAL_ARITH `(&0 * x < y /\ u < v) /\ &0 < y /\ y < h <=>
6065                           &0 < y /\ y < h /\ u < v`] THEN
6066   DISCH_TAC THEN MATCH_MP_TAC(INST_TYPE [`:2`,`:M`] FUBINI_SIMPLE_ALT) THEN
6067   EXISTS_TAC `3` THEN ASM_REWRITE_TAC[DIMINDEX_2; DIMINDEX_3; ARITH] THEN
6068   ASM_SIMP_TAC[WEDGE_SPECIAL_SCALE; REAL_LT_IMP_LE] THEN
6069   ASM_SIMP_TAC[REAL_LT_LMUL_EQ; SLICE_INTER; DIMINDEX_2;
6070                DIMINDEX_3; ARITH] THEN
6071   SUBGOAL_THEN
6072    `!t. slice 3 t {y:real^3 | norm y * a < y$3 /\ &0 < y$3 /\ y$3 < h} =
6073         if t < h
6074         then ball(vec 0:real^2,sqrt(inv(a pow 2) - &1) * t)
6075         else {}`
6076    (fun th -> ASM_SIMP_TAC[th; SLICE_SPECIAL_WEDGE])
6077   THENL
6078    [REWRITE_TAC[EXTENSION] THEN
6079     MAP_EVERY X_GEN_TAC [`t:real`; `z:real^2`] THEN
6080     SIMP_TAC[SLICE_123; DIMINDEX_2; DIMINDEX_3; ARITH; IN_ELIM_THM;
6081              VECTOR_3; DOT_3; GSYM DOT_2] THEN
6082     ASM_CASES_TAC `t < h` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
6083     REWRITE_TAC[IN_BALL_0; IN_DELETE] THEN
6084     MATCH_MP_TAC(REAL_ARITH
6085      `&0 <= a /\ (a < t <=> u < v) ==> (a < t /\ &0 < t <=> u < v)`) THEN
6086     ASM_SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; REAL_LT_IMP_LE] THEN
6087     ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_LT_SQUARE] THEN
6088     SUBGOAL_THEN `&0 < inv(a pow 2) - &1` ASSUME_TAC THENL
6089      [REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_INV_1_LT THEN
6090       ASM_SIMP_TAC[REAL_POW_1_LT; REAL_LT_IMP_LE; ARITH; REAL_POW_LT];
6091       ALL_TAC] THEN
6092     ASM_SIMP_TAC[REAL_LT_MUL; SQRT_POS_LT; REAL_POW_MUL; SQRT_POW_2;
6093                  REAL_LT_IMP_LE; REAL_LT_MUL_EQ] THEN
6094     ASM_SIMP_TAC[real_div; REAL_LT_MUL_EQ; REAL_LT_INV_EQ] THEN
6095     ASM_CASES_TAC `&0 < t` THEN ASM_REWRITE_TAC[] THEN
6096     REWRITE_TAC[DOT_3; DOT_2; VECTOR_3; REAL_INV_POW] THEN
6097     REAL_ARITH_TAC;
6098     ALL_TAC] THEN
6099   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [COND_RATOR; COND_RAND] THEN
6100   GEN_REWRITE_TAC (RAND_CONV o RATOR_CONV o LAND_CONV o TOP_DEPTH_CONV)
6101    [COND_RATOR; COND_RAND] THEN
6102   REWRITE_TAC[INTER_EMPTY; MEASURABLE_EMPTY; MEASURE_EMPTY] THEN
6103   REWRITE_TAC[INTER; IN_BALL_0; IN_ELIM_THM] THEN
6104   RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN
6105   ASM_SIMP_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE]
6106                  HAS_MEASURE_OPEN_SECTOR_LT_GEN] THEN
6107   REWRITE_TAC[COND_ID] THEN
6108   SUBGOAL_THEN `&0 < inv(a pow 2) - &1` ASSUME_TAC THENL
6109    [REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_INV_1_LT THEN
6110     ASM_SIMP_TAC[REAL_POW_1_LT; REAL_LT_IMP_LE; ARITH; REAL_POW_LT];
6111     ALL_TAC] THEN
6112   ASM_SIMP_TAC[REAL_LE_MUL_EQ; SQRT_POS_LT] THEN
6113   ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; AZIM_ARG; COLLINEAR_BASIS_3] THEN
6114   MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN
6115   EXISTS_TAC
6116    `\t. if &0 < t /\ t < h
6117         then Arg(dropout 3 (w2:real^3) / dropout 3 (w1:real^3)) / &2 *
6118              (inv(a pow 2) - &1) * t pow 2
6119         else &0` THEN
6120   CONJ_TAC THENL
6121    [X_GEN_TAC `t:real` THEN DISCH_TAC THEN REWRITE_TAC[] THEN
6122     ASM_CASES_TAC `t < h` THEN ASM_REWRITE_TAC[] THEN
6123     REWRITE_TAC[REAL_ARITH `&0 <= t <=> t = &0 \/ &0 < t`] THEN
6124     ASM_CASES_TAC `t = &0` THEN
6125     ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_RZERO; SQRT_0] THEN
6126     CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_RZERO] THEN
6127     ASM_SIMP_TAC[REAL_POW_MUL; SQRT_POW_2; REAL_LT_IMP_LE] THEN
6128     REAL_ARITH_TAC;
6129     ALL_TAC] THEN
6130   REWRITE_TAC[GSYM IN_REAL_INTERVAL; HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN
6131   REWRITE_TAC[HAS_REAL_INTEGRAL_OPEN_INTERVAL] THEN
6132   COND_CASES_TAC THENL
6133    [ASM_MESON_TAC[REAL_INTERVAL_EQ_EMPTY; HAS_REAL_INTEGRAL_EMPTY];
6134     RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT])] THEN
6135   ABBREV_TAC `g = Arg(dropout 3 (w2:real^3) / dropout 3 (w1:real^3))` THEN
6136   MP_TAC(ISPECL
6137    [`\t. g / &6 * (inv (a pow 2) - &1) * t pow 3`;
6138     `\t. g / &2 * (inv (a pow 2) - &1) * t pow 2`;
6139     `&0`; `h:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN
6140   REWRITE_TAC[] THEN ANTS_TAC THENL
6141    [ASM_REWRITE_TAC[] THEN
6142     REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN
6143     CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING;
6144     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6145     UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD]);;
6146
6147 (* ------------------------------------------------------------------------- *)
6148 (* Wedge of a conic cap.                                                     *)
6149 (* ------------------------------------------------------------------------- *)
6150
6151 let VOLUME_CONIC_CAP_WEDGE_WEAK = prove
6152  (`!v0 v1:real^3 w1 w2 r a.
6153        &0 < a /\ ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2}
6154        ==> bounded(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) /\
6155            measurable(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) /\
6156            measure(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) =
6157            if &1 <= a \/ r < &0 then &0
6158            else azim v0 v1 w1 w2 / &3 * (&1 - a) * r pow 3`,
6159   REPEAT GEN_TAC THEN ASM_CASES_TAC `v1:real^3 = v0` THENL
6160    [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; STRIP_TAC] THEN
6161   MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN
6162   REPEAT CONJ_TAC THENL
6163    [MATCH_MP_TAC BOUNDED_INTER THEN ASM_SIMP_TAC[VOLUME_CONIC_CAP_STRONG];
6164     MATCH_MP_TAC MEASURABLE_BOUNDED_INTER_OPEN THEN
6165     ASM_SIMP_TAC[VOLUME_CONIC_CAP_STRONG; OPEN_WEDGE];
6166     ALL_TAC] THEN
6167   REWRITE_TAC[conic_cap; rcone_gt; rconesgn; IN_ELIM_THM] THEN
6168   REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] normball; GSYM ball] THEN
6169   CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN
6170   POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
6171   GEOM_ORIGIN_TAC `v0:real^3` THEN
6172   REWRITE_TAC[VECTOR_SUB_RZERO; REAL_MUL_LZERO; DIST_0; real_gt] THEN
6173   GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN
6174   X_GEN_TAC `b:real` THEN
6175   ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
6176   SIMP_TAC[COLLINEAR_SPECIAL_SCALE; WEDGE_SPECIAL_SCALE] THEN
6177   ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN
6178   DISCH_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
6179   ASM_CASES_TAC `&1 <= a` THEN ASM_REWRITE_TAC[] THENL
6180    [SUBGOAL_THEN
6181      `!y:real^3. ~(norm(y) * norm(b % basis 3:real^3) * a
6182                    < y dot (b % basis 3))`
6183      (fun th -> REWRITE_TAC[th; EMPTY_GSPEC; INTER_EMPTY; MEASURE_EMPTY;
6184                          MEASURABLE_EMPTY; BOUNDED_EMPTY; CONVEX_EMPTY]) THEN
6185     REWRITE_TAC[REAL_NOT_LT] THEN X_GEN_TAC `y:real^3` THEN
6186     MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN
6187     SIMP_TAC[DOT_RMUL; NORM_MUL; REAL_ABS_MUL; DOT_BASIS; NORM_BASIS;
6188              DIMINDEX_3; ARITH] THEN
6189     REWRITE_TAC[REAL_ARITH
6190      `b * y <= n * (b * &1) * a <=> b * &1 * y <= b * a * n`] THEN
6191     MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN
6192     MATCH_MP_TAC REAL_LE_MUL2 THEN
6193     ASM_SIMP_TAC[REAL_POS; REAL_ABS_POS; COMPONENT_LE_NORM; DIMINDEX_3; ARITH];
6194     ALL_TAC] THEN
6195   RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
6196   SIMP_TAC[DOT_RMUL; NORM_MUL; REAL_ABS_NORM; DOT_BASIS;
6197            DIMINDEX_3; ARITH; NORM_BASIS] THEN
6198   ONCE_REWRITE_TAC[REAL_ARITH `n * x * a:real = x * n * a`] THEN
6199   ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN
6200   ASM_SIMP_TAC[REAL_MUL_RID; REAL_LT_LMUL_EQ; REAL_LT_MUL_EQ; NORM_POS_LT] THEN
6201   ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_LT_SQUARE] THEN
6202   ASM_SIMP_TAC[REAL_POW_DIV; REAL_POW_LT; REAL_LT_RDIV_EQ] THEN
6203   REWRITE_TAC[INTER; REAL_MUL_LZERO; IN_BALL_0; IN_ELIM_THM] THEN
6204   ASM_SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_3; ARITH;
6205                REAL_LT_IMP_NZ] THEN
6206   COND_CASES_TAC THENL
6207    [ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm x < r)`] THEN
6208     REWRITE_TAC[EMPTY_GSPEC; MEASURE_EMPTY; MEASURABLE_EMPTY;
6209                 BOUNDED_EMPTY; CONVEX_EMPTY];
6210     RULE_ASSUM_TAC(ONCE_REWRITE_RULE[REAL_NOT_LT])] THEN
6211   STRIP_TAC THEN MATCH_MP_TAC(INST_TYPE [`:2`,`:M`] FUBINI_SIMPLE_ALT) THEN
6212   EXISTS_TAC `3` THEN ASM_REWRITE_TAC[DIMINDEX_2; DIMINDEX_3; ARITH] THEN
6213   SUBGOAL_THEN `&0 < b` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
6214   ASM_SIMP_TAC[WEDGE_SPECIAL_SCALE; AZIM_SPECIAL_SCALE] THEN
6215   ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ x IN s} = {x | P x} INTER s`] THEN
6216   ASM_SIMP_TAC[REAL_LT_LMUL_EQ; SLICE_INTER; DIMINDEX_2;
6217                DIMINDEX_3; ARITH] THEN
6218   RULE_ASSUM_TAC
6219    (REWRITE_RULE[MATCH_MP COLLINEAR_SPECIAL_SCALE (ASSUME `~(b = &0)`)]) THEN
6220   SUBGOAL_THEN `&0 < inv(a pow 2) - &1` ASSUME_TAC THENL
6221    [REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_INV_1_LT THEN
6222     ASM_SIMP_TAC[REAL_POW_1_LT; REAL_LT_IMP_LE; ARITH; REAL_POW_LT];
6223     ALL_TAC] THEN
6224   SUBGOAL_THEN
6225    `!t. slice 3 t {y:real^3 | norm y < r /\ norm y * a < y$3} =
6226         if &0 < t /\ t < r
6227         then ball(vec 0:real^2,min (sqrt(r pow 2 - t pow 2))
6228                                    (t * sqrt(inv(a pow 2) - &1)))
6229         else {}`
6230    (fun th -> ASM_SIMP_TAC[th; SLICE_SPECIAL_WEDGE])
6231   THENL
6232    [REWRITE_TAC[EXTENSION] THEN
6233     MAP_EVERY X_GEN_TAC [`t:real`; `z:real^2`] THEN
6234     SIMP_TAC[SLICE_123; DIMINDEX_2; DIMINDEX_3; ARITH; IN_ELIM_THM;
6235              VECTOR_3; DOT_3; GSYM DOT_2] THEN
6236     ASM_CASES_TAC `&0 < t` THEN ASM_REWRITE_TAC[] THENL
6237      [ALL_TAC;
6238       REWRITE_TAC[NOT_IN_EMPTY; DE_MORGAN_THM] THEN DISJ2_TAC THEN
6239       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
6240        `~(&0 < t) ==> &0 <= a ==> ~(a < t)`)) THEN
6241       ASM_SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; REAL_LT_IMP_LE]] THEN
6242     ASM_CASES_TAC `t < r` THEN ASM_REWRITE_TAC[] THENL
6243      [ALL_TAC;
6244       REWRITE_TAC[NOT_IN_EMPTY; DE_MORGAN_THM] THEN DISJ1_TAC THEN
6245       REWRITE_TAC[NORM_LT_SQUARE; DE_MORGAN_THM] THEN DISJ2_TAC THEN
6246       REWRITE_TAC[DOT_3; VECTOR_3] THEN
6247       MATCH_MP_TAC(REAL_ARITH
6248        `r <= t /\ &0 <= a /\ &0 <= b ==> ~(a + b + t < r)`) THEN
6249       REWRITE_TAC[REAL_LE_SQUARE; REAL_POW_2] THEN
6250       MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC] THEN
6251     REWRITE_TAC[IN_BALL_0; REAL_LT_MIN] THEN
6252     ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN REWRITE_TAC[NORM_LT_SQUARE] THEN
6253     SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
6254     SUBGOAL_THEN `t pow 2 < r pow 2` ASSUME_TAC THENL
6255      [MATCH_MP_TAC REAL_POW_LT2 THEN REWRITE_TAC[ARITH] THEN
6256       ASM_REAL_ARITH_TAC;
6257       ALL_TAC] THEN
6258     ASM_SIMP_TAC[REAL_LT_DIV; SQRT_POS_LT; REAL_LT_MUL; REAL_SUB_LT;
6259                  SQRT_POW_2; REAL_LT_IMP_LE; REAL_POW_MUL] THEN
6260     REWRITE_TAC[DOT_2; DOT_3; VECTOR_3] THEN
6261     ONCE_REWRITE_TAC[REAL_ARITH `a + b + c < d <=> a + b < d - c`] THEN
6262     BINOP_TAC THEN AP_TERM_TAC THEN
6263     UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD;
6264     ALL_TAC] THEN
6265   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [COND_RATOR; COND_RAND] THEN
6266   GEN_REWRITE_TAC (RAND_CONV o RATOR_CONV o LAND_CONV o TOP_DEPTH_CONV)
6267    [COND_RATOR; COND_RAND] THEN
6268   REWRITE_TAC[INTER_EMPTY; MEASURABLE_EMPTY; MEASURE_EMPTY] THEN
6269   REWRITE_TAC[INTER; IN_BALL_0; IN_ELIM_THM] THEN
6270   RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN
6271   ASM_SIMP_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE]
6272                  HAS_MEASURE_OPEN_SECTOR_LT_GEN] THEN
6273   REWRITE_TAC[COND_ID] THEN
6274   ASM_SIMP_TAC[REAL_LE_MIN; SQRT_POS_LE; REAL_LT_IMP_LE; REAL_LE_MUL;
6275                REAL_POW_LE2; ARITH; REAL_SUB_LE; REAL_LT_MUL; SQRT_POS_LT] THEN
6276   REWRITE_TAC[GSYM IN_REAL_INTERVAL; HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN
6277   REWRITE_TAC[HAS_REAL_INTEGRAL_OPEN_INTERVAL] THEN
6278   REWRITE_TAC[NORM_POW_2; DOT_3; VECTOR_3; DOT_2] THEN
6279   ASM_SIMP_TAC[AZIM_ARG; COLLINEAR_BASIS_3] THEN
6280   ONCE_REWRITE_TAC[REAL_ARITH
6281    `(&1 - a) * az / &3 * r pow 3 =
6282     az / &6 * (inv (a pow 2) - &1) * (a * r) pow 3 +
6283     (az * &1 / &3 * (&1 - a) * r pow 3 -
6284      az / &6 * (inv (a pow 2) - &1) * (a * r) pow 3)`] THEN
6285   MATCH_MP_TAC HAS_REAL_INTEGRAL_COMBINE THEN
6286   EXISTS_TAC `a * r:real` THEN
6287   REWRITE_TAC[REAL_ARITH `a * r <= r <=> &0 <= r * (&1 - a)`] THEN
6288   ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_LT_IMP_LE] THEN
6289   ABBREV_TAC `k = Arg(dropout 3 (w2:real^3) / dropout 3 (w1:real^3))` THEN
6290   CONJ_TAC THENL
6291    [MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC
6292      `\t. k * t pow 2 * (inv(a pow 2) - &1) / &2` THEN
6293     CONJ_TAC THENL
6294      [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN
6295       STRIP_TAC THEN AP_TERM_TAC THEN
6296       SUBGOAL_THEN `t pow 2 * (inv(a pow 2) - &1) <= r pow 2 - t pow 2`
6297       ASSUME_TAC THENL
6298        [REWRITE_TAC[REAL_ARITH `t * (a - &1) <= r - t <=> t * a <= r`] THEN
6299         ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_POW_LT] THEN
6300         REWRITE_TAC[GSYM REAL_POW_MUL] THEN MATCH_MP_TAC REAL_POW_LE2 THEN
6301         ASM_REAL_ARITH_TAC;
6302         ALL_TAC] THEN
6303       SUBGOAL_THEN `t * sqrt(inv(a pow 2) - &1) <= sqrt(r pow 2 - t pow 2)`
6304         (fun th -> SIMP_TAC[th; REAL_ARITH `a <= b ==> min b a = a`])
6305       THENL
6306        [MATCH_MP_TAC REAL_POW_LE2_REV THEN EXISTS_TAC `2` THEN
6307         REWRITE_TAC[ARITH] THEN
6308         SUBGOAL_THEN `&0 <= r pow 2 - t pow 2` ASSUME_TAC THENL
6309          [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
6310            `a <= x ==> &0 <= a ==> &0 <= x`)) THEN
6311           ASM_SIMP_TAC[REAL_POW_2; REAL_LE_MUL; REAL_LE_SQUARE; REAL_LT_IMP_LE];
6312           ASM_SIMP_TAC[SQRT_POS_LE; REAL_POW_MUL; SQRT_POW_2;
6313                        REAL_LT_IMP_LE]];
6314         ASM_SIMP_TAC[REAL_POW_MUL; SQRT_POW_2; SQRT_POW_2; REAL_LT_IMP_LE] THEN
6315         REAL_ARITH_TAC];
6316       MP_TAC(ISPECL
6317        [`\t. k / &6 * (inv (a pow 2) - &1) * t pow 3`;
6318         `\t. k * t pow 2 * (inv (a pow 2) - &1) / &2`;
6319         `&0`; `a * r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN
6320       ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN ANTS_TAC THENL
6321        [ASM_REWRITE_TAC[] THEN
6322         REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN
6323         CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING;
6324         MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6325         UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD]];
6326     MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC
6327      `\t:real. k * (r pow 2 - t pow 2) / &2` THEN
6328     CONJ_TAC THENL
6329      [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN
6330       STRIP_TAC THEN AP_TERM_TAC THEN
6331       SUBGOAL_THEN `&0 <= t` ASSUME_TAC THENL
6332        [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a * r:real` THEN
6333         ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE];
6334         ALL_TAC] THEN
6335       MATCH_MP_TAC(REAL_ARITH
6336        `a <= b /\ a pow 2 = x ==> x / &2 = (min a b pow 2) / &2`) THEN
6337       SUBGOAL_THEN `&0 <= r pow 2 - t pow 2` ASSUME_TAC THENL
6338        [REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS; REAL_SUB_LE] THEN
6339         ASM_REAL_ARITH_TAC;
6340         ALL_TAC] THEN
6341       ASM_SIMP_TAC[SQRT_POW_2] THEN MATCH_MP_TAC REAL_POW_LE2_REV THEN
6342       EXISTS_TAC `2` THEN REWRITE_TAC[ARITH] THEN
6343       ASM_SIMP_TAC[SQRT_POW_2; REAL_POW_MUL; REAL_LE_MUL; SQRT_POS_LT;
6344                    REAL_LT_MUL; REAL_LT_IMP_LE; SQRT_POS_LE] THEN
6345       REWRITE_TAC[REAL_ARITH `r - t <= t * (a - &1) <=> r <= t * a`] THEN
6346       REWRITE_TAC[REAL_INV_POW; GSYM REAL_POW_MUL] THEN
6347       MATCH_MP_TAC REAL_POW_LE2 THEN
6348       ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ] THEN
6349       ASM_REAL_ARITH_TAC;
6350       MP_TAC(ISPECL
6351        [`\t. k / &2 * (r pow 2 * t - t pow 3 / &3)`;
6352         `\t. k * (r pow 2 - t pow 2) / &2`;
6353         `a * r:real`; `r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN
6354       ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN ANTS_TAC THENL
6355        [ASM_REWRITE_TAC[REAL_ARITH `a * r <= r <=> &0 <= r * (&1 - a)`] THEN
6356         ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LE] THEN
6357         REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN
6358         CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING;
6359         MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6360         UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD]]]);;
6361
6362 let BOUNDED_CONIC_CAP_WEDGE = prove
6363  (`!v0 v1:real^3 w1 w2 r a.
6364         bounded(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2)`,
6365   REPEAT GEN_TAC THEN MATCH_MP_TAC BOUNDED_SUBSET THEN
6366   EXISTS_TAC `conic_cap (v0:real^3) v1 r a` THEN
6367   REWRITE_TAC[BOUNDED_CONIC_CAP] THEN SET_TAC[]);;
6368
6369 let MEASURABLE_CONIC_CAP_WEDGE = prove
6370  (`!v0 v1:real^3 w1 w2 r a.
6371         measurable(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2)`,
6372   REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURABLE_BOUNDED_INTER_OPEN THEN
6373   REWRITE_TAC[BOUNDED_CONIC_CAP; MEASURABLE_CONIC_CAP; OPEN_WEDGE]);;
6374
6375 let VOLUME_CONIC_CAP_COMPL = prove
6376  (`!v0 v1:real^3 w1 w2 r a.
6377         &0 <= r
6378         ==> measure(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) +
6379             measure(conic_cap v0 v1 r (--a) INTER wedge v0 v1 w1 w2) =
6380             azim v0 v1 w1 w2 * &2 * r pow 3 / &3`,
6381   let lemma = prove
6382    (`!f:real^N->real^N s t t' u.
6383           measurable(s) /\ measurable(t) /\ measurable(u) /\
6384           orthogonal_transformation f /\
6385           s SUBSET u /\ t' SUBSET u /\ s INTER t' = {} /\
6386           negligible(u DIFF (s UNION t')) /\
6387           ((!y. ?x. f x = y) ==> IMAGE f t = t')
6388           ==> measure s + measure t = measure u`,
6389     REPEAT GEN_TAC THEN
6390     ASM_CASES_TAC `orthogonal_transformation(f:real^N->real^N)` THEN
6391     ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE] THEN
6392     REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
6393     EXISTS_TAC
6394      `measure(s:real^N->bool) + measure(t':real^N->bool)` THEN
6395     CONJ_TAC THENL [ASM_MESON_TAC[MEASURE_ORTHOGONAL_IMAGE_EQ]; ALL_TAC] THEN
6396     W(MP_TAC o PART_MATCH (rhs o rand) MEASURE_DISJOINT_UNION o
6397       lhand o snd) THEN
6398     ASM_REWRITE_TAC[DISJOINT] THEN ANTS_TAC THENL
6399      [ASM_MESON_TAC[MEASURABLE_LINEAR_IMAGE; ORTHOGONAL_TRANSFORMATION_LINEAR];
6400       DISCH_THEN(SUBST1_TAC o SYM)] THEN
6401     MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN ASM_REWRITE_TAC[] THEN
6402     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
6403         NEGLIGIBLE_SUBSET)) THEN
6404     REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]) in
6405   REWRITE_TAC[conic_cap; rcone_gt; NORMBALL_BALL; rconesgn] THEN
6406   GEOM_ORIGIN_TAC `v0:real^3` THEN
6407   REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0; real_gt] THEN
6408   GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN
6409   X_GEN_TAC `v1:real` THEN
6410   GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN
6411   STRIP_TAC THENL
6412    [ASM_SIMP_TAC[VECTOR_MUL_LZERO; WEDGE_DEGENERATE; AZIM_DEGENERATE] THEN
6413     REWRITE_TAC[INTER_EMPTY; MEASURE_EMPTY] THEN REAL_ARITH_TAC;
6414     ALL_TAC] THEN
6415   ASM_SIMP_TAC[GSYM VOLUME_BALL_WEDGE] THEN REPEAT STRIP_TAC THEN
6416   ASM_CASES_TAC `collinear {vec 0:real^3,v1 % basis 3,w1}` THENL
6417    [ASM_SIMP_TAC[WEDGE_DEGENERATE; AZIM_DEGENERATE] THEN
6418     REWRITE_TAC[INTER_EMPTY; MEASURE_EMPTY] THEN REAL_ARITH_TAC;
6419     ALL_TAC] THEN
6420   ASM_SIMP_TAC[GSYM VOLUME_BALL_WEDGE] THEN REPEAT STRIP_TAC THEN
6421   ASM_CASES_TAC `collinear {vec 0:real^3,v1 % basis 3,w2}` THENL
6422    [ASM_SIMP_TAC[WEDGE_DEGENERATE; AZIM_DEGENERATE] THEN
6423     REWRITE_TAC[INTER_EMPTY; MEASURE_EMPTY] THEN REAL_ARITH_TAC;
6424     ALL_TAC] THEN
6425   ASM_SIMP_TAC[WEDGE_SPECIAL_SCALE] THEN
6426   MAP_EVERY UNDISCH_TAC
6427    [`~collinear{vec 0:real^3,v1 % basis 3,w1}`;
6428     `~collinear{vec 0:real^3,v1 % basis 3,w2}`] THEN
6429   ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE] THEN REPEAT DISCH_TAC THEN
6430   REWRITE_TAC[NORM_MUL; DOT_RMUL] THEN
6431   ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_ARITH
6432     `&0 < v1 ==> n * (abs v1 * y) * a = v1 * n * y * a`] THEN
6433   MATCH_MP_TAC lemma THEN
6434   MP_TAC(ISPECL
6435    [`vec 0:real^3`; `basis 3:real^3`; `w1:real^3`; `w2:real^3`;
6436     `r:real`; `a:real`] MEASURABLE_CONIC_CAP_WEDGE) THEN
6437   MP_TAC(ISPECL
6438    [`vec 0:real^3`; `basis 3:real^3`; `w1:real^3`; `w2:real^3`;
6439     `r:real`; `--a:real`] MEASURABLE_CONIC_CAP_WEDGE) THEN
6440   REWRITE_TAC[conic_cap; rcone_gt; NORMBALL_BALL; rconesgn] THEN
6441   REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0; real_gt] THEN
6442   REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[MEASURABLE_BALL_WEDGE] THEN
6443   SIMP_TAC[NORM_BASIS; DOT_BASIS; DIMINDEX_3; ARITH; REAL_MUL_LID] THEN
6444   EXISTS_TAC `(\x. vector[x$1; x$2; --(x$3)]):real^3->real^3` THEN
6445   EXISTS_TAC `(ball(vec 0,r) INTER {x | norm x * a > x$3}) INTER
6446               wedge (vec 0:real^3) (basis 3) w1 w2` THEN
6447   CONJ_TAC THENL
6448    [REWRITE_TAC[ORTHOGONAL_TRANSFORMATION; linear] THEN
6449     REWRITE_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_3; vector_norm; DOT_3;
6450                 VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
6451     REPEAT(GEN_TAC ORELSE CONJ_TAC ORELSE AP_TERM_TAC) THEN
6452     REAL_ARITH_TAC;
6453     ALL_TAC] THEN
6454   CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
6455   CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
6456   CONJ_TAC THENL
6457    [REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_ELIM_THM; real_gt] THEN
6458     MESON_TAC[REAL_LT_ANTISYM];
6459     ALL_TAC] THEN
6460   CONJ_TAC THENL
6461    [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
6462     EXISTS_TAC `rcone_eq (vec 0:real^3) (basis 3) a` THEN
6463     SIMP_TAC[NEGLIGIBLE_RCONE_EQ; BASIS_NONZERO; DIMINDEX_3; ARITH] THEN
6464     REWRITE_TAC[SUBSET; rcone_eq; rconesgn; VECTOR_SUB_RZERO; DIST_0] THEN
6465     SIMP_TAC[DOT_BASIS; NORM_BASIS; DIMINDEX_3; ARITH] THEN
6466     REWRITE_TAC[IN_DIFF; IN_ELIM_THM; IN_INTER; IN_UNION] THEN
6467     GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6468     ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
6469     ALL_TAC] THEN
6470   REWRITE_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
6471   ASM_REWRITE_TAC[] THEN
6472   REWRITE_TAC[IN_INTER; IN_BALL_0; IN_ELIM_THM; VECTOR_3] THEN
6473   X_GEN_TAC `x:real^3` THEN
6474   SUBGOAL_THEN `norm(vector [x$1; x$2; --(x$3)]:real^3) = norm(x:real^3)`
6475   SUBST1_TAC THENL
6476    [REWRITE_TAC[NORM_EQ; DOT_3; VECTOR_3] THEN REAL_ARITH_TAC;
6477     ALL_TAC] THEN
6478   REWRITE_TAC[REAL_ARITH `n * a > --x <=> n * --a < x`] THEN
6479   MATCH_MP_TAC(TAUT `(a ==> (b <=> b')) ==> (a /\ b <=> a /\ b')`) THEN
6480   STRIP_TAC THEN
6481   REWRITE_TAC[COLLINEAR_BASIS_3; wedge; AZIM_ARG] THEN
6482   REWRITE_TAC[IN_ELIM_THM] THEN
6483   SUBGOAL_THEN `(dropout 3 :real^3->real^2) (vector [x$1; x$2; --(x$3)]) =
6484                 (dropout 3 :real^3->real^2) x`
6485    (fun th -> REWRITE_TAC[th]) THEN
6486   SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; dropout; LAMBDA_BETA; ARITH;
6487            VECTOR_3]);;
6488
6489 let VOLUME_CONIC_CAP_WEDGE_MEDIUM = prove
6490  (`!v0 v1:real^3 w1 w2 r a.
6491        &0 <= a /\ ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2}
6492        ==> bounded(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) /\
6493            measurable(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) /\
6494            measure(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) =
6495            if &1 < abs a \/ r < &0 then &0
6496            else azim v0 v1 w1 w2 / &3 * (&1 - a) * r pow 3`,
6497   REWRITE_TAC[BOUNDED_CONIC_CAP_WEDGE; MEASURABLE_CONIC_CAP_WEDGE] THEN
6498   REPEAT STRIP_TAC THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH
6499    `&0 <= a ==> &0 < a \/ a = &0`))
6500   THENL
6501    [ASM_SIMP_TAC[VOLUME_CONIC_CAP_WEDGE_WEAK] THEN
6502     REWRITE_TAC[REAL_LE_LT] THEN
6503     ASM_CASES_TAC `a = &1` THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
6504     ALL_TAC] THEN
6505   ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
6506   COND_CASES_TAC THENL
6507    [REWRITE_TAC[conic_cap; NORMBALL_BALL] THEN
6508     SUBGOAL_THEN `ball(v0:real^3,r) = {}`
6509      (fun th -> SIMP_TAC[th; INTER_EMPTY; MEASURE_EMPTY]) THEN
6510     REWRITE_TAC[BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC;
6511     MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w1:real^3`; `w2:real^3`;
6512                    `r:real`; `&0`] VOLUME_CONIC_CAP_COMPL) THEN
6513     REWRITE_TAC[REAL_NEG_0] THEN ASM_REAL_ARITH_TAC]);;
6514
6515 let VOLUME_CONIC_CAP_WEDGE = prove
6516  (`!v0 v1:real^3 w1 w2 r a.
6517        ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2}
6518        ==> bounded(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) /\
6519            measurable(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) /\
6520            measure(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) =
6521                 if &1 < a \/ r < &0 then &0
6522                 else azim v0 v1 w1 w2 / &3 * (&1 - max a (-- &1)) * r pow 3`,
6523   REWRITE_TAC[BOUNDED_CONIC_CAP_WEDGE; MEASURABLE_CONIC_CAP_WEDGE] THEN
6524   REPEAT STRIP_TAC THEN
6525   ASM_CASES_TAC `&0 <= a` THEN
6526   ASM_SIMP_TAC[VOLUME_CONIC_CAP_WEDGE_MEDIUM;
6527                REAL_ARITH `&0 <= a ==> abs a = a /\ max a (-- &1) = a`] THEN
6528   MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w1:real^3`; `w2:real^3`;
6529                    `r:real`; `--a:real`] VOLUME_CONIC_CAP_WEDGE_MEDIUM) THEN
6530   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
6531   STRIP_TAC THEN
6532   MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w1:real^3`; `w2:real^3`;
6533                  `r:real`; `a:real`] VOLUME_CONIC_CAP_COMPL) THEN
6534   ASM_CASES_TAC `r < &0` THENL
6535    [REWRITE_TAC[conic_cap; NORMBALL_BALL] THEN
6536     SUBGOAL_THEN `ball(v0:real^3,r) = {}`
6537      (fun th -> SIMP_TAC[th; INTER_EMPTY; MEASURE_EMPTY]) THEN
6538     REWRITE_TAC[BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC;
6539     ALL_TAC] THEN
6540   ASM_REWRITE_TAC[GSYM REAL_NOT_LT; REAL_ABS_NEG] THEN
6541   ASM_SIMP_TAC[REAL_ARITH `~(&0 <= a) ==> ~(&1 < a) /\ abs a = --a`] THEN
6542   COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
6543    [ASM_SIMP_TAC[REAL_ARITH `&1 < --a ==> max a (-- &1) = -- &1`] THEN
6544     REAL_ARITH_TAC;
6545     ASM_SIMP_TAC[REAL_ARITH `~(&1 < --a) ==> max a (-- &1) = a`] THEN
6546     REAL_ARITH_TAC]);;
6547
6548 (* ------------------------------------------------------------------------- *)
6549 (* Precise formulation of Flyspeck volume properties.                        *)
6550 (* ------------------------------------------------------------------------- *)
6551
6552 (*** Might be preferable to switch
6553  ***
6554  *** normball z r -> ball(z,r)
6555  *** rect a b -> interval(a,b)
6556  ***
6557  *** to fit existing libraries. But I left this alone for now,
6558  *** to be absolutely sure I didn't introduce new errors.
6559  *** I also maintain
6560  ***
6561  *** NULLSET -> negligible
6562  *** vol -> measure
6563  ***
6564  *** as interface maps for the real^3 case.
6565  ***)
6566
6567 let cone = new_definition `cone v S:real^A->bool = affsign sgn_ge {v} S`;;
6568
6569 (*** JRH: should we exclude v for S = {}? Make it always open ***)
6570
6571 let cone0 = new_definition `cone0 v S:real^A->bool = affsign sgn_gt {v} S`;;
6572
6573 (*** JRH changed from cone to cone0 ***)
6574
6575 let solid_triangle = new_definition
6576   `solid_triangle v0 S r = normball v0 r INTER cone0 v0 S`;;
6577
6578 let rect = new_definition
6579   `rect (a:real^3) (b:real^3) =
6580         {(v:real^3) | !i. (a$i < v$i /\ v$i < b$i )}`;;
6581
6582 let RECT_INTERVAL = prove
6583  (`!a b. rect a b = interval(a,b)`,
6584   REWRITE_TAC[rect; EXTENSION; IN_INTERVAL; IN_ELIM_THM] THEN
6585   MESON_TAC[FINITE_INDEX_INRANGE]);;
6586
6587 let RCONE_GE_GT = prove
6588  (`rcone_ge z w h =
6589         rcone_gt z w h UNION
6590         { x | (x - z) dot (w - z) = norm(x - z) * norm(w - z) * h}`,
6591   REWRITE_TAC[rcone_ge; rcone_gt; rconesgn] THEN
6592   REWRITE_TAC[dist; EXTENSION; IN_UNION; NORM_SUB; IN_ELIM_THM] THEN
6593   REAL_ARITH_TAC);;
6594
6595 let RCONE_GT_GE = prove
6596  (`rcone_gt z w h =
6597         rcone_ge z w h DIFF
6598         { x | (x - z) dot (w - z) = norm(x - z) * norm(w - z) * h}`,
6599   REWRITE_TAC[rcone_ge; rcone_gt; rconesgn] THEN
6600   REWRITE_TAC[dist; EXTENSION; IN_DIFF; NORM_SUB; IN_ELIM_THM] THEN
6601   REAL_ARITH_TAC);;
6602
6603 override_interface("NULLSET",`negligible:(real^3->bool)->bool`);;
6604 override_interface("vol",`measure:(real^3->bool)->real`);;
6605
6606 let is_sphere= new_definition
6607   `is_sphere x=(?(v:real^3)(r:real). (r> &0)/\ (x={w:real^3 | norm (w-v)= r}))`;;
6608
6609 let c_cone = new_definition
6610   `c_cone (v,w:real^3, r:real)=
6611        {x:real^3 | ((x-v) dot w = norm (x-v)* norm w* r)}`;;
6612
6613 (*** JRH added the condition ~(w = 0), or the cone is all of space ***)
6614
6615 let circular_cone =new_definition
6616   `circular_cone (V:real^3-> bool)=
6617    (? (v,w:real^3)(r:real). ~(w = vec 0) /\ V = c_cone (v,w,r))`;;
6618
6619 let NULLSET_RULES = prove
6620  (`(!P. ((plane P)\/ (is_sphere P) \/ (circular_cone P)) ==> NULLSET P) /\
6621    (!(s:real^3->bool) t. (NULLSET s /\ NULLSET t) ==> NULLSET (s UNION t))`,
6622   SIMP_TAC[NEGLIGIBLE_UNION] THEN
6623   X_GEN_TAC `s:real^3->bool` THEN STRIP_TAC THENL
6624    [MATCH_MP_TAC COPLANAR_IMP_NEGLIGIBLE THEN
6625     SIMP_TAC[COPLANAR; DIMINDEX_3; ARITH] THEN ASM_MESON_TAC[SUBSET_REFL];
6626     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [is_sphere]) THEN
6627     STRIP_TAC THEN ASM_REWRITE_TAC[GSYM dist] THEN
6628     ONCE_REWRITE_TAC[DIST_SYM] THEN
6629     REWRITE_TAC[REWRITE_RULE[sphere] NEGLIGIBLE_SPHERE];
6630     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [circular_cone]) THEN
6631     REWRITE_TAC[EXISTS_PAIRED_THM; c_cone] THEN STRIP_TAC THEN
6632     ASM_REWRITE_TAC[] THEN
6633     MP_TAC(ISPECL [`w + v:real^3`; `v:real^3`; `r:real`]
6634      NEGLIGIBLE_RCONE_EQ) THEN
6635     ASM_REWRITE_TAC[rcone_eq; rconesgn] THEN
6636     REWRITE_TAC[dist; VECTOR_ARITH `(w + v) - v:real^N = w`] THEN
6637     ASM_REWRITE_TAC[VECTOR_ARITH `w + v:real^N = v <=> w = vec 0`]]);;
6638
6639 (*** JRH added &0 < a for frustum; otherwise it's in general unbounded ***)
6640
6641 let primitive = new_definition `primitive (C:real^3->bool) =
6642   ((?v0 v1 v2 v3 r.  (C = solid_triangle v0 {v1,v2,v3} r)) \/
6643   (?v0 v1 v2 v3. (C = conv0 {v0,v1,v2,v3})) \/
6644   (?v0 v1 v2 v3 h a. &0 < a /\
6645                      (C = frustt v0 v1 h a INTER wedge v0 v1 v2 v3)) \/
6646   (?v0 v1 v2 v3 r c. (C = conic_cap v0 v1 r c INTER wedge v0 v1 v2 v3)) \/
6647   (?a b.  (C = rect a b)) \/
6648   (?t r. (C = ellipsoid t r)) \/
6649   (?v0 v1 v2 v3 r. (C = normball v0 r INTER wedge v0 v1 v2 v3)))`;;
6650
6651 let MEASURABLE_RULES = prove
6652  (`(!C. primitive C ==> measurable C) /\
6653    (!Z. NULLSET Z ==> measurable Z) /\
6654    (!X t. measurable X ==> (measurable (IMAGE (scale t) X))) /\
6655    (!X v. measurable X ==> (measurable (IMAGE ((+) v) X))) /\
6656    (!(s:real^3->bool) t. (measurable s /\ measurable t)
6657                          ==> measurable (s UNION t)) /\
6658    (!(s:real^3->bool) t. (measurable s /\ measurable t)
6659                          ==> measurable (s INTER t)) /\
6660    (!(s:real^3->bool) t. (measurable s /\ measurable t)
6661                          ==> measurable (s DIFF t))`,
6662   SIMP_TAC[MEASURABLE_UNION; MEASURABLE_INTER; MEASURABLE_DIFF] THEN
6663   REWRITE_TAC[REWRITE_RULE[ETA_AX] MEASURABLE_TRANSLATION] THEN
6664   SIMP_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_MEASURABLE_MEASURE] THEN
6665   CONJ_TAC THENL
6666    [ALL_TAC;
6667     MAP_EVERY X_GEN_TAC [`X:real^3->bool`; `t:real^3`] THEN
6668     REWRITE_TAC[HAS_MEASURE_MEASURE] THEN
6669     DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_STRETCH) THEN
6670     DISCH_THEN(MP_TAC o SPEC `\i. (t:real^3)$i`) THEN
6671     REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN
6672     DISCH_THEN(MP_TAC o CONJUNCT1) THEN MATCH_MP_TAC EQ_IMP THEN
6673     AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6674     SIMP_TAC[FUN_EQ_THM; scale; CART_EQ; LAMBDA_BETA;
6675              DIMINDEX_3; VECTOR_3; FORALL_3]] THEN
6676   X_GEN_TAC `C:real^3->bool` THEN REWRITE_TAC[primitive] THEN
6677   REWRITE_TAC[NORMBALL_BALL; RECT_INTERVAL] THEN
6678   DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN MP_TAC) THEN
6679   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
6680    [REPEAT STRIP_TAC THEN
6681     ASM_REWRITE_TAC[solid_triangle; NORMBALL_BALL; cone0; GSYM aff_gt_def] THEN
6682     REWRITE_TAC[MEASURABLE_BALL_AFF_GT];
6683     REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6684     MATCH_MP_TAC MEASURABLE_CONV0 THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN
6685     REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY];
6686     MAP_EVERY X_GEN_TAC
6687      [`v0:real^3`; `v1:real^3`; `v2:real^3`; `v3:real^3`;
6688       `h:real`; `a:real`] THEN
6689     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC) THEN
6690     ASM_CASES_TAC `collinear {v0:real^3, v1, v2}` THENL
6691      [ASM_SIMP_TAC[WEDGE_DEGENERATE; INTER_EMPTY; MEASURABLE_EMPTY];
6692       ALL_TAC] THEN
6693     ASM_CASES_TAC `collinear {v0:real^3, v1, v3}` THENL
6694      [ASM_SIMP_TAC[WEDGE_DEGENERATE; INTER_EMPTY; MEASURABLE_EMPTY];
6695       ALL_TAC] THEN
6696     ASM_SIMP_TAC[VOLUME_FRUSTT_WEDGE];
6697     REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6698     MATCH_MP_TAC MEASURABLE_BOUNDED_INTER_OPEN THEN
6699     REWRITE_TAC[MEASURABLE_CONIC_CAP; BOUNDED_CONIC_CAP; OPEN_WEDGE];
6700     SIMP_TAC[MEASURABLE_INTERVAL];
6701     SIMP_TAC[MEASURABLE_ELLIPSOID];
6702     SIMP_TAC[MEASURABLE_BALL_WEDGE]]);;
6703
6704 let vol_solid_triangle = new_definition `vol_solid_triangle v0 v1 v2 v3 r =
6705    let a123 = dihV v0 v1 v2 v3 in
6706    let a231 = dihV v0 v2 v3 v1 in
6707    let a312 = dihV v0 v3 v1 v2 in
6708      (a123 + a231 + a312 - pi)*(r pow 3)/(&3)`;;
6709
6710 let vol_frustt_wedge = new_definition `vol_frustt_wedge v0 v1 v2 v3 h a =
6711        (azim v0 v1 v2 v3)*(h pow 3)*(&1/(a*a) - &1)/(&6)`;;
6712
6713 let vol_conic_cap_wedge = new_definition `vol_conic_cap_wedge v0 v1 v2 v3 r c =
6714        (azim v0 v1 v2 v3)*(&1 - c)*(r pow 3)/(&3)`;;
6715
6716 (*** JRH corrected delta_x x12 x13 x14 x34 x24 x34 ***)
6717 (*** to delta_x x12 x13 x14 x34 x24 x23            ***)
6718
6719 let vol_conv = new_definition `vol_conv v1 v2 v3 v4 =
6720    let x12 = dist(v1,v2) pow 2 in
6721    let x13 = dist(v1,v3) pow 2 in
6722    let x14 = dist(v1,v4) pow 2 in
6723    let x23 = dist(v2,v3) pow 2 in
6724    let x24 = dist(v2,v4) pow 2 in
6725    let x34 = dist(v3,v4) pow 2 in
6726    sqrt(delta_x x12 x13 x14 x34 x24 x23)/(&12)`;;
6727
6728 let vol_rect = new_definition `vol_rect a b =
6729    if (a$1 < b$1) /\ (a$2 < b$2) /\ (a$3 < b$3) then
6730    (b$3-a$3)*(b$2-a$2)*(b$1-a$1) else &0`;;
6731
6732 let vol_ball_wedge = new_definition `vol_ball_wedge v0 v1 v2 v3 r =
6733    (azim v0 v1 v2 v3)*(&2)*(r pow 3)/(&3)`;;
6734
6735 let SDIFF = new_definition `SDIFF X Y = (X DIFF Y) UNION (Y DIFF X)`;;
6736
6737 (*** JRH added the hypothesis "measurable" to the first one ***)
6738 (*** Could change the definition to make this hold anyway   ***)
6739
6740 (*** JRH changed solid triangle hypothesis to ~coplanar{...} ***)
6741 (*** since the current condition is not enough in general    ***)
6742
6743 let volume_props = prove
6744  (`(!C. measurable C ==> vol C >= &0) /\
6745    (!Z. NULLSET Z ==> (vol Z = &0)) /\
6746    (!X Y. measurable X /\ measurable Y /\ NULLSET (SDIFF X Y)
6747           ==> (vol X = vol Y)) /\
6748    (!X t. (measurable X) /\ (measurable (IMAGE (scale t) X))
6749           ==> (vol (IMAGE (scale t) X) = abs(t$1 * t$2 * t$3)*vol(X))) /\
6750    (!X v. measurable X ==> (vol (IMAGE ((+) v) X) = vol X)) /\
6751    (!v0 v1 v2 v3 r. (r > &0) /\ ~coplanar{v0,v1,v2,v3}
6752                     ==> vol (solid_triangle v0 {v1,v2,v3} r) =
6753                         vol_solid_triangle v0 v1 v2 v3 r) /\
6754    (!v0 v1 v2 v3. vol(conv0 {v0,v1,v2,v3}) = vol_conv v0 v1 v2 v3) /\
6755    (!v0 v1 v2 v3 h a. ~(collinear {v0,v1,v2}) /\ ~(collinear {v0,v1,v3}) /\
6756                       (h >= &0) /\ (a > &0) /\ (a <= &1)
6757                       ==> vol(frustt v0 v1 h a INTER wedge v0 v1 v2 v3) =
6758                           vol_frustt_wedge v0 v1 v2 v3 h a) /\
6759    (!v0 v1 v2 v3 r c.  ~(collinear {v0,v1,v2}) /\ ~(collinear {v0,v1,v3}) /\
6760                        (r >= &0) /\ (c >= -- (&1)) /\ (c <= &1)
6761                        ==> (vol(conic_cap v0 v1 r c INTER wedge v0 v1 v2 v3) =
6762                            vol_conic_cap_wedge v0 v1 v2 v3 r c)) /\
6763    (!(a:real^3) (b:real^3). vol(rect a b) = vol_rect a b) /\
6764    (!v0 v1 v2 v3 r. ~(collinear {v0,v1,v2}) /\ ~(collinear {v0,v1,v3}) /\
6765                     (r >= &0)
6766                     ==> (vol(normball v0 r INTER wedge v0 v1 v2 v3) =
6767                          vol_ball_wedge v0 v1 v2 v3 r))`,
6768   SIMP_TAC[MEASURE_POS_LE; real_ge; real_gt] THEN REPEAT CONJ_TAC THENL
6769    [SIMP_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_MEASURABLE_MEASURE];
6770     MAP_EVERY X_GEN_TAC [`s:real^3->bool`; `t:real^3->bool`] THEN
6771     STRIP_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN
6772     ASM_REWRITE_TAC[] THEN
6773     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
6774         NEGLIGIBLE_SUBSET)) THEN
6775     REWRITE_TAC[SDIFF] THEN SET_TAC[];
6776     MAP_EVERY X_GEN_TAC [`X:real^3->bool`; `t:real^3`] THEN
6777     REWRITE_TAC[HAS_MEASURE_MEASURE] THEN
6778     DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_STRETCH o CONJUNCT1) THEN
6779     DISCH_THEN(MP_TAC o SPEC `\i. (t:real^3)$i`) THEN
6780     REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN
6781     DISCH_THEN(MP_TAC o CONJUNCT2) THEN
6782     REWRITE_TAC[DIMINDEX_3; PRODUCT_3] THEN
6783     DISCH_THEN(SUBST1_TAC o SYM) THEN
6784     AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
6785     SIMP_TAC[FUN_EQ_THM; scale; CART_EQ; LAMBDA_BETA;
6786              DIMINDEX_3; VECTOR_3; FORALL_3];
6787     REWRITE_TAC[REWRITE_RULE[ETA_AX] MEASURE_TRANSLATION];
6788     REPEAT STRIP_TAC THEN
6789     REWRITE_TAC[solid_triangle; vol_solid_triangle; NORMBALL_BALL] THEN
6790     REWRITE_TAC[cone0; GSYM aff_gt_def] THEN
6791     MATCH_MP_TAC VOLUME_SOLID_TRIANGLE THEN ASM_REWRITE_TAC[];
6792     REWRITE_TAC[vol_conv; VOLUME_OF_TETRAHEDRON];
6793     SIMP_TAC[VOLUME_FRUSTT_WEDGE; vol_frustt_wedge] THEN
6794     SIMP_TAC[REAL_ARITH `&0 <= h ==> ~(h < &0)`] THEN
6795     SIMP_TAC[REAL_ARITH `a <= &1 ==> (&1 <= a <=> a = &1)`] THEN
6796     REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
6797     REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD;
6798     SIMP_TAC[VOLUME_CONIC_CAP_WEDGE; vol_conic_cap_wedge] THEN
6799     SIMP_TAC[REAL_ARITH `&0 <= r ==> ~(r < &0)`] THEN
6800     SIMP_TAC[REAL_ARITH `c <= &1 ==> ~(&1 < c)`] THEN
6801     ASM_SIMP_TAC[REAL_ARITH `-- &1 <= c ==> max c (-- &1) = c`] THEN
6802     REPEAT STRIP_TAC THEN REAL_ARITH_TAC;
6803     REWRITE_TAC[vol_rect; RECT_INTERVAL; MEASURE_INTERVAL] THEN
6804     REWRITE_TAC[CONTENT_CLOSED_INTERVAL_CASES] THEN
6805     REWRITE_TAC[DIMINDEX_3; FORALL_3; PRODUCT_3] THEN
6806     MAP_EVERY X_GEN_TAC [`a:real^3`; `b:real^3`] THEN
6807     REWRITE_TAC[REAL_LE_LT] THEN
6808     ASM_CASES_TAC `(a:real^3)$1 = (b:real^3)$1` THEN
6809     ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO;
6810                     REAL_SUB_REFL; COND_ID] THEN
6811     ASM_CASES_TAC `(a:real^3)$2 = (b:real^3)$2` THEN
6812     ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO;
6813                     REAL_SUB_REFL; COND_ID] THEN
6814     ASM_CASES_TAC `(a:real^3)$3 = (b:real^3)$3` THEN
6815     ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO;
6816                     REAL_SUB_REFL; COND_ID] THEN
6817     REWRITE_TAC[REAL_MUL_AC];
6818     SIMP_TAC[VOLUME_BALL_WEDGE; NORMBALL_BALL; vol_ball_wedge]]);;
6819
6820 (* ------------------------------------------------------------------------- *)
6821 (* Additional results on polyhedra and relation to fans.                     *)
6822 (* ------------------------------------------------------------------------- *)
6823
6824 let POLYHEDRON_COLLINEAR_FACES_STRONG = prove
6825  (`!P:real^N->bool f f' p q s t.
6826         polyhedron P /\ vec 0 IN relative_interior P /\
6827         f face_of P /\ ~(f = P) /\ f' face_of P /\ ~(f' = P) /\
6828         p IN f /\ q IN f' /\ s > &0 /\ t > &0 /\ s % p = t % q
6829         ==> s = t`,
6830   ONCE_REWRITE_TAC[MESON[]
6831    `(!P f f' p q s t. Q P f f' p q s t) <=>
6832     (!s t P f f' p q. Q P f f' p q s t)`] THEN
6833   MATCH_MP_TAC REAL_WLOG_LT THEN
6834   REWRITE_TAC[real_gt] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
6835   REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `F ==> p`) THEN
6836   FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv s):real^N->real^N`) THEN
6837   ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN
6838   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
6839   REWRITE_TAC[VECTOR_MUL_LID; GSYM real_div] THEN
6840   ABBREV_TAC `u:real = t / s` THEN
6841   SUBGOAL_THEN `&0 < u /\ &1 < u` MP_TAC THENL
6842    [EXPAND_TAC "u" THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ] THEN
6843     ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID];
6844     ALL_TAC] THEN
6845   MAP_EVERY (C UNDISCH_THEN (K ALL_TAC))
6846    [`s < t`; `&0 < s`; `&0 < t`; `t:real / s = u`] THEN
6847   SPEC_TAC(`u:real`,`t:real`) THEN GEN_TAC THEN STRIP_TAC THEN
6848   DISCH_THEN(ASSUME_TAC o SYM) THEN
6849   SUBGOAL_THEN `?g:real^N->bool. g facet_of P /\ f' SUBSET g`
6850   STRIP_ASSUME_TAC THENL
6851    [MATCH_MP_TAC FACE_OF_POLYHEDRON_SUBSET_FACET THEN ASM SET_TAC[];
6852     ALL_TAC] THEN
6853   SUBGOAL_THEN `~((vec 0:real^N) IN g)` ASSUME_TAC THENL
6854    [DISCH_TAC THEN
6855     MP_TAC(ISPECL [`P:real^N->bool`; `g:real^N->bool`; `P:real^N->bool`]
6856                    SUBSET_OF_FACE_OF) THEN
6857     ASM_REWRITE_TAC[SUBSET_REFL; NOT_IMP] THEN CONJ_TAC THENL
6858      [CONJ_TAC THENL [ASM_MESON_TAC[facet_of]; ASM SET_TAC[]];
6859       ASM_MESON_TAC[facet_of; FACET_OF_REFL;
6860                     SUBSET_ANTISYM; FACE_OF_IMP_SUBSET]];
6861     ALL_TAC] THEN
6862   SUBGOAL_THEN `(g:real^N->bool) face_of P` MP_TAC THENL
6863    [ASM_MESON_TAC[facet_of]; ALL_TAC] THEN
6864   REWRITE_TAC[face_of] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN
6865   DISCH_THEN(MP_TAC o SPECL [`vec 0:real^N`; `t % q:real^N`; `q:real^N`]) THEN
6866   ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
6867    [ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET];
6868     ASM_MESON_TAC[FACE_OF_IMP_SUBSET; SUBSET];
6869     ASM_MESON_TAC[FACE_OF_IMP_SUBSET; SUBSET];
6870     ALL_TAC] THEN
6871   EXPAND_TAC "p" THEN REWRITE_TAC[IN_SEGMENT] THEN CONJ_TAC THENL
6872    [CONV_TAC(RAND_CONV SYM_CONV) THEN
6873     ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN ASM SET_TAC[];
6874     EXISTS_TAC `inv t:real` THEN
6875     ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_INV_LT_1] THEN
6876     EXPAND_TAC "p" THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
6877     ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN VECTOR_ARITH_TAC]);;
6878
6879 let POLYHEDRON_COLLINEAR_FACES = prove
6880  (`!P:real^N->bool f f' p q s t.
6881         polyhedron P /\ vec 0 IN interior P /\
6882         f face_of P /\ ~(f = P) /\ f' face_of P /\ ~(f' = P) /\
6883         p IN f /\ q IN f' /\ s > &0 /\ t > &0 /\ s % p = t % q
6884         ==> s = t`,
6885   MESON_TAC[POLYHEDRON_COLLINEAR_FACES_STRONG;
6886             INTERIOR_SUBSET_RELATIVE_INTERIOR; SUBSET]);;
6887
6888 let vertices = new_definition
6889  `vertices s = {x:real^N | x extreme_point_of s}`;;
6890
6891 let edges = new_definition
6892  `edges s = {{v,w} | segment[v,w] edge_of s}`;;
6893
6894 let VERTICES_TRANSLATION = prove
6895  (`!a s. vertices (IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (vertices s)`,
6896   REWRITE_TAC[vertices] THEN GEOM_TRANSLATE_TAC[]);;
6897
6898 let VERTICES_LINEAR_IMAGE = prove
6899  (`!f s. linear f /\ (!x y. f x = f y ==> x = y)
6900          ==> vertices(IMAGE f s) = IMAGE f (vertices s)`,
6901   REWRITE_TAC[vertices; EXTREME_POINTS_OF_LINEAR_IMAGE]);;
6902
6903 let EDGES_TRANSLATION = prove
6904  (`!a s. edges (IMAGE (\x. a + x) s) = IMAGE (IMAGE (\x. a + x)) (edges s)`,
6905   REWRITE_TAC[edges] THEN GEOM_TRANSLATE_TAC[] THEN SET_TAC[]);;
6906
6907 let EDGES_LINEAR_IMAGE = prove
6908  (`!f:real^M->real^N s.
6909         linear f /\ (!x y. f x = f y ==> x = y)
6910         ==> edges(IMAGE f s) = IMAGE (IMAGE f) (edges s)`,
6911   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[edges] THEN
6912   MATCH_MP_TAC SUBSET_ANTISYM THEN
6913   REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; FORALL_IN_IMAGE] THEN CONJ_TAC THENL
6914    [MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
6915     REWRITE_TAC[IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
6916     REWRITE_TAC[EXISTS_IN_GSPEC] THEN
6917     SUBGOAL_THEN `?v w. x = (f:real^M->real^N) v /\ y = f w` MP_TAC THENL
6918      [ASM_MESON_TAC[ENDS_IN_SEGMENT; EDGE_OF_IMP_SUBSET; SUBSET; IN_IMAGE];
6919       REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
6920       DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC)];
6921     MAP_EVERY X_GEN_TAC [`v:real^M`; `w:real^M`] THEN DISCH_TAC THEN
6922     REWRITE_TAC[IN_ELIM_THM] THEN
6923     MAP_EVERY EXISTS_TAC [`(f:real^M->real^N) v`; `(f:real^M->real^N) w`]] THEN
6924   REWRITE_TAC[IMAGE_CLAUSES] THEN
6925   ASM_MESON_TAC[EDGE_OF_LINEAR_IMAGE; CLOSED_SEGMENT_LINEAR_IMAGE]);;
6926
6927 add_translation_invariants [VERTICES_TRANSLATION; EDGES_TRANSLATION];;
6928 add_linear_invariants [VERTICES_LINEAR_IMAGE; EDGES_LINEAR_IMAGE];;
6929
6930 (*** Correspondence with Flypaper:
6931
6932 Definition 4.5:   IS_AFFINE_HULL
6933                   affine / hull
6934                   aff_dim
6935                   AFF_DIM_EMPTY
6936
6937 Definition 4.6 :  IN_INTERIOR
6938                   IN_RELATIVE_INTERIOR
6939                   CLOSURE_APPROACHABLE
6940                   (Don't have definition of relative boundary, but several
6941                    theorems use closure s DIFF relative_interior s.)
6942
6943 Definition 4.7:   face_of
6944                   extreme_point_of (presumably it's meant to be the point not
6945                   the singleton set, which the definition literally gives)
6946                   facet_of
6947                   edge_of
6948                   (Don't have a definition of "proper"; I just use
6949                    ~(f = {}) and/or ~(f = P) as needed.)
6950
6951 Lemma 4.18:       KREIN_MILMAN_MINKOWSKI
6952
6953 Definition 4.8:   polyhedron
6954                   vertices
6955
6956 Lemma 4.19:       AFFINE_IMP_POLYHEDRON
6957
6958 Lemma 4.20 (i):   FACET_OF_POLYHEDRON_EXPLICIT
6959
6960 Lemma 4.20 (ii):  Direct consequence of RELATIVE_INTERIOR_POLYHEDRON
6961
6962 Lemma 4.20 (iii): FACE_OF_POLYHEDRON_EXPLICIT / FACE_OF_POLYHEDRON
6963
6964 Lemma 4.20 (iv):  FACE_OF_TRANS
6965
6966 Lemma 4.20 (v):   EXTREME_POINT_OF_FACE
6967
6968 Lemma 4.20 (vi):  FACE_OF_EQ
6969
6970 Corr. 4.7:        FACE_OF_POLYHEDRON_POLYHEDRON
6971
6972 Lemma 4.21:       POLYHEDRON_COLLINEAR_FACES
6973
6974 Def 4.9:          vertices
6975                   edges
6976
6977 ****)
6978
6979 (* ------------------------------------------------------------------------- *)
6980 (* Temporary backwards-compatible fix for introduction of "sphere" and       *)
6981 (* "relative_frontier".                                                      *)
6982 (* ------------------------------------------------------------------------- *)
6983
6984 let COMPACT_SPHERE =
6985   REWRITE_RULE[sphere; NORM_ARITH `dist(a:real^N,b) = norm(b - a)`]
6986   COMPACT_SPHERE;;
6987
6988 let FRONTIER_CBALL = REWRITE_RULE[sphere] FRONTIER_CBALL;;
6989
6990 let NEGLIGIBLE_SPHERE = REWRITE_RULE[sphere] NEGLIGIBLE_SPHERE;;
6991
6992 let RELATIVE_FRONTIER_OF_POLYHEDRON = RELATIVE_BOUNDARY_OF_POLYHEDRON;;
6993
6994 (* ------------------------------------------------------------------------- *)
6995 (* Fix the congruence rules as expected in Flyspeck.                         *)
6996 (* Should exclude 6 recent mixed real/vector limit results.                  *)
6997 (* ------------------------------------------------------------------------- *)
6998
6999 let bcs =
7000   [`(p <=> p') ==> (p' ==> (q <=> q')) ==> (p ==> q <=> p' ==> q')`;
7001    `(g <=> g')
7002     ==> (g' ==> t = t')
7003     ==> (~g' ==> e = e')
7004     ==> (if g then t else e) = (if g' then t' else e')`;
7005    `(!x. p x ==> f x = g x) ==> nsum {y | p y} (\i. f i) = nsum {y | p y} g`;
7006    `(!i. a <= i /\ i <= b ==> f i = g i)
7007     ==> nsum (a..b) (\i. f i) = nsum (a..b) g`;
7008    `(!x. x IN s ==> f x = g x) ==> nsum s (\i. f i) = nsum s g`;
7009    `(!x. p x ==> f x = g x) ==> sum {y | p y} (\i. f i) = sum {y | p y} g`;
7010    `(!i. a <= i /\ i <= b ==> f i = g i)
7011     ==> sum (a..b) (\i. f i) = sum (a..b) g`;
7012    `(!x. x IN s ==> f x = g x) ==> sum s (\i. f i) = sum s g`;
7013    `(!x. p x ==> f x = g x) ==> vsum {y | p y} (\i. f i) = vsum {y | p y} g`;
7014    `(!i. a <= i /\ i <= b ==> f i = g i)
7015     ==> vsum (a..b) (\i. f i) = vsum (a..b) g`;
7016    `(!x. x IN s ==> f x = g x) ==> vsum s (\i. f i) = vsum s g`;
7017    `(!x. p x ==> f x = g x)
7018     ==> product {y | p y} (\i. f i) = product {y | p y} g`;
7019    `(!i. a <= i /\ i <= b ==> f i = g i)
7020     ==> product (a..b) (\i. f i) = product (a..b) g`;
7021    `(!x. x IN s ==> f x = g x) ==> product s (\i. f i) = product s g`;
7022    `(!x. ~(x = a) ==> f x = g x)
7023     ==> (((\x. f x) --> l) (at a) <=> (g --> l) (at a))`;
7024    `(!x. ~(x = a) ==> f x = g x)
7025     ==> (((\x. f x) --> l) (at a within s) <=> (g --> l) (at a within s))`]
7026 and equiv t1 t2 = can (term_match [] t1) t2 & can (term_match [] t2) t1 in
7027 let congs' =
7028   filter (fun th -> exists (equiv (concl th)) bcs) (basic_congs()) in
7029 set_basic_congs congs';;