Update from HH

[Flyspeck/.git] / text_formalization / trigonometry / trig2.hl

(* ========================================================================== *)\r
(* FLYSPECK - BOOK FORMALIZATION                                              *)\r
(*                                                                            *)\r
(* Chapter: Trigonometry                                                *)\r
(* Author: Nguyen Quang Truong                                          *)\r
(* Date: 2010-02-09                                                           *)\r
(* ========================================================================== *)\r
\r
\r
\r
module type Trigonometry2_type = sig\r
  (* add *)\r
end;;\r
\r
flyspeck_needs "general/sphere.hl";;\r
flyspeck_needs "leg/collect_geom.hl";;\r
flyspeck_needs "trigonometry/trig1.hl";;\r
\r
module Trigonometry2 (* : Trigonometry2_type *) = struct\r
\r
(* imports *)\r
\r
  let delta_x4 = Sphere.delta_x4;;\r
  let atn2 = Sphere.atn2;;\r
(*  let beta = Sphere.beta;; *)\r
  let aff = Sphere.aff;;\r
  let cyclic_set = Sphere.cyclic_set;;\r
  let ups_x = Sphere.ups_x;;\r
\r
  let COL_EQ_UPS_0 =   Collect_geom.COL_EQ_UPS_0;;\r
\r
  let acs_atn2 = Trigonometry1.acs_atn2;;\r
\r
  let BY = Hales_tactic.BY;;\r
\r
(* ========== QUANG TRUONG ========== *)\r
let cosV = new_definition` cosV u v = (u dot v) / (norm u * norm v) `;;\r
let sinV = new_definition` sinV u v = sqrt ( &1 - cosV u v pow 2 ) `;;\r
\r
\r
let SET_TAC =\r
let basicthms =\r
[NOT_IN_EMPTY; IN_UNIV; IN_UNION; IN_INTER; IN_DIFF; IN_INSERT;\r
IN_DELETE; IN_REST; IN_INTERS; IN_UNIONS; IN_IMAGE] in\r
let allthms = basicthms @ map (REWRITE_RULE[IN]) basicthms @\r
[IN_ELIM_THM; IN] in\r
let PRESET_TAC =\r
TRY(POP_ASSUM_LIST(MP_TAC o end_itlist CONJ)) THEN\r
REPEAT COND_CASES_TAC THEN\r
REWRITE_TAC[EXTENSION; SUBSET; PSUBSET; DISJOINT; SING] THEN\r
REWRITE_TAC allthms in\r
fun ths ->\r
PRESET_TAC THEN\r
(if ths = [] then ALL_TAC else MP_TAC(end_itlist CONJ ths)) THEN\r
MESON_TAC[];;\r
\r
let SET_RULE tm = prove(tm,SET_TAC[]);;\r
\r
let PHA = REWRITE_TAC[ MESON[] ` (a/\b)/\c <=> a/\ b /\ c `; MESON[]`\r
a ==> b ==> c <=> a /\ b ==> c `];;\r
\r
let NGOAC = REWRITE_TAC[ MESON[] ` a/\b/\c <=> (a/\b)/\c `];;\r
\r
let DAO = NGOAC THEN REWRITE_TAC[ MESON[]` a /\ b <=> b /\ a`];;\r
\r
let PHAT = REWRITE_TAC[ MESON[] ` (a\/b)\/c <=> a\/b\/c `];;\r
\r
let NGOACT = REWRITE_TAC[ GSYM (MESON[] ` (a\/b)\/c <=> a\/b\/c `)];;\r
\r
let KHANANG = PHA THEN REWRITE_TAC[ MESON[]` ( a\/ b ) /\ c <=> a /\ c \/ b /\ c `] THEN\r
REWRITE_TAC[ MESON[]` a /\ ( b \/ c ) <=> a /\ b \/ a /\ c `];;\r
\r
let ATTACH thm = MATCH_MP (MESON[]` ! a b. ( a ==> b ) ==> ( a <=> a /\ b )`) thm;;\r
\r
let NHANH tm = ONCE_REWRITE_TAC[ ATTACH (SPEC_ALL ( tm ))];;\r
let LET_TR = CONV_TAC (TOP_DEPTH_CONV let_CONV);;\r
\r
let DOWN_TAC = REPEAT (FIRST_X_ASSUM MP_TAC) THEN REWRITE_TAC[IMP_IMP] THEN PHA;;\r
let IMP_IMP_TAC = REWRITE_TAC[GSYM IMP_IMP] ;;\r
\r
\r
\r
\r
let NOT_EQ_IMPCOS_ARC = prove(`~( v0 = (u:real^N) ) /\ ~ ( v0 = w ) ==> cos (arcV v0 u w) =\r
((u - v0) dot (w - v0)) / (norm (u - v0) * norm (w - v0))`,\r
REWRITE_TAC[GSYM VECTOR_SUB_EQ; GSYM NORM_EQ_0] THEN\r
NHANH (MESON[NORM_POS_LE]` ~(norm (x:real^N) = &0 ) ==> &0 <= norm x `) THEN\r
REWRITE_TAC[REAL_ARITH` ~ ( a = &0 ) /\ &0 <= a <=>\r
&0 < a `] THEN\r
SIMP_TAC[NORM_SUB] THEN\r
MP_TAC (SPECL[` u - (v0:real^N)`; `v0 - (w :real^N) `] NORM_CAUCHY_SCHWARZ_ABS) THEN\r
NHANH (REAL_LT_MUL) THEN PHA THEN\r
REWRITE_TAC[MESON[REAL_LE_DIV2_EQ; REAL_FIELD ` &0 < a ==> a / a = &1 `]` a <= b /\ l1 /\ l2 /\ &0 < b <=>\r
a / b <= &1 /\ l1 /\ l2 /\ &0 < b `] THEN\r
NHANH (MESON[REAL_LT_IMP_LE; REAL_ABS_REFL; REAL_ABS_DIV]`\r
abs b / a <= &1 /\ l1 /\ l2 /\ &0 < a ==>\r
abs ( b / a ) <= &1 `) THEN\r
ONCE_REWRITE_TAC[ GSYM REAL_ABS_NEG] THEN\r
REWRITE_TAC[REAL_ARITH` -- ( a / b ) = ( --a ) / b `;\r
VECTOR_ARITH` --((u - v0) dot (v0 - w)) = ((u - v0) dot (w - v0)) `] THEN\r
REWRITE_TAC[REAL_ABS_BOUNDS; arcV] THEN\r
SIMP_TAC[NORM_SUB] THEN MESON_TAC[COS_ACS]);;\r
\r
\r
\r
let COLLINEAR_TRANSABLE = prove(\r
`collinear {(a:real^N), b, c} <=> collinear {vec 0, b - a, c - a}`,\r
REWRITE_TAC[collinear; IN_INSERT; NOT_IN_EMPTY] THEN EQ_TAC THENL\r
[STRIP_TAC THEN EXISTS_TAC `u: real^N` THEN REPEAT GEN_TAC THEN\r
ASM_MESON_TAC[VECTOR_ARITH` ( a - c ) - ( b - c ) = a - (b:real^N)`;\r
VECTOR_SUB_REFL; VECTOR_ARITH` vec 0 - ( a - b ) = b - a `;\r
VECTOR_ARITH` a - vec 0 = a `]; STRIP_TAC THEN EXISTS_TAC `u:real^N`\r
THEN REPEAT GEN_TAC] THEN ASM_MESON_TAC[VECTOR_ARITH` ( a - c ) - ( b - c ) = a - (b:real^N)`;\r
VECTOR_SUB_REFL; VECTOR_ARITH` vec 0 - ( a - b ) = b - a `;\r
VECTOR_ARITH` a - vec 0 = a `]);;\r
\r
\r
\r
\r
\r
let ALLEMI_COLLINEAR = prove(`((vc - v0) dot ((vc: real^N) - v0)) % (va - v0) =\r
((va - v0) dot (vc - v0)) % (vc - v0)\r
==> collinear {v0, vc, va}`,\r
ASM_CASES_TAC ` (vc - v0) dot (vc - (v0:real^N)) = &0 ` THENL\r
[FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[DOT_EQ_0; VECTOR_SUB_EQ] THEN\r
SIMP_TAC[INSERT_INSERT; COLLINEAR_2]; FIRST_X_ASSUM MP_TAC THEN\r
PHA THEN NHANH (MESON[]` ~( a = &0 ) /\ b = c ==> &1 / a % b =\r
&1 / a % c `) THEN SIMP_TAC[VECTOR_MUL_ASSOC] THEN PHA THEN\r
ONCE_REWRITE_TAC[MESON[]` a /\b ==> c <=> a ==> b ==> c `] THEN\r
SIMP_TAC[REAL_FIELD` ~ ( a = &0 ) ==> &1 / a * a = &1 `;\r
VECTOR_MUL_LID] THEN ONCE_REWRITE_TAC[COLLINEAR_TRANSABLE ] THEN\r
MESON_TAC[COLLINEAR_LEMMA]]);;\r
\r
\r
let NOT_VEC0_IMP_LE1 = prove(`~( x = vec 0 ) /\ ~( y = vec 0 ) ==>\r
abs (( x dot y )/ (( norm x ) * ( norm y ))) <= &1 `,\r
REWRITE_TAC[GSYM NORM_POS_LT; REAL_ABS_DIV; REAL_ABS_MUL; REAL_ABS_NORM] THEN\r
NHANH (REAL_LT_MUL) THEN\r
SIMP_TAC[REAL_LE_LDIV_EQ; REAL_MUL_LID; NORM_CAUCHY_SCHWARZ_ABS]);;\r
\r
let sin_acs_t = prove(`! y. (-- &1 <= y /\ y <= &1) ==> (sin (acs(y)) = sqrt(&1 - y pow 2))`,\r
REPEAT STRIP_TAC THEN MATCH_MP_TAC(GSYM SQRT_UNIQUE) THEN\r
ASM_SIMP_TAC[ACS_BOUNDS; SIN_POS_PI_LE; REAL_EQ_SUB_RADD] THEN\r
ASM_MESON_TAC[COS_ACS; SIN_CIRCLE]);;\r
\r
\r
let ABS_LE_1_IMP_SIN_ACS = prove(`!y. abs y <= &1 ==> sin (acs y) = sqrt (&1 - y pow 2)`,\r
SIMP_TAC[REAL_ABS_BOUNDS; sin_acs_t]);;\r
\r
\r
let NOT_2EQ_IMP_SIN_ARCV = prove(`~( v0 = va) /\ ~(v0 = (vb:real^N)) ==>\r
sin ( arcV v0 va vb ) = sqrt\r
(&1 -\r
(((va - v0) dot (vb - v0)) / (norm (va - v0) * norm (vb - v0))) pow 2) `,\r
REWRITE_TAC[arcV] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN\r
ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN NHANH (NOT_VEC0_IMP_LE1 ) THEN\r
SIMP_TAC[ABS_LE_1_IMP_SIN_ACS]);;\r
\r
\r
let ABS_NOT_EQ_NORM_MUL = prove(` ~ ( abs ( x dot y ) = norm x * norm y ) <=>\r
abs ( x dot y ) < norm x * norm y `,\r
SIMP_TAC[REAL_LT_LE; NORM_CAUCHY_SCHWARZ_ABS]);;\r
\r
\r
\r
let SQUARE_NORM_CAUCHY_SCHWARZ_POW2 = prove(`((x:real^N) dot y) pow 2 <= (norm x * norm y) pow 2`,\r
REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN\r
MESON_TAC[GSYM REAL_ABS_REFL; REAL_LE_MUL; NORM_POS_LE;\r
NORM_CAUCHY_SCHWARZ_ABS]);;\r
\r
let REAL_LE_POW_2 = prove(` ! x. &0 <= x pow 2 `,\r
REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]);;\r
\r
let SQRT_SEPARATED = prove(`sqrt (((norm x * norm y) pow 2 - ((x:real^N) dot y) pow 2) / (norm x * norm y) pow 2) =\r
sqrt ((norm x * norm y) pow 2 - (x dot y) pow 2) /\r
sqrt ((norm x * norm y) pow 2)`,\r
MP_TAC SQUARE_NORM_CAUCHY_SCHWARZ_POW2 THEN\r
ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN SIMP_TAC[REAL_LE_POW_2; SQRT_DIV]);;\r
\r
\r
\r
\r
let COMPUTE_NORM_OF_P = prove(`norm ((vc dot vc) % va - (va dot vc) % vc) =\r
sqrt ((vc dot vc) * ((va dot va) * (vc dot vc) - (va dot vc) pow 2))`,\r
REWRITE_TAC[vector_norm; DOT_LSUB; DOT_RSUB; DOT_LMUL; DOT_RMUL] THEN\r
MATCH_MP_TAC (MESON[]` a = b ==> P a = P b `) THEN SIMP_TAC[DOT_SYM] THEN REAL_ARITH_TAC);;\r
\r
\r
\r
\r
let MOVE_NORM_OUT_OF_SQRT = prove(`sqrt (norm (vc:real^N) pow 2 * ((norm va * norm vc) pow 2 - (va dot vc) pow 2)) =\r
norm vc * sqrt ((norm va * norm vc) pow 2 - (va dot vc) pow 2)`,\r
MP_TAC (MESON[SQUARE_NORM_CAUCHY_SCHWARZ_POW2]`\r
((va: real^N) dot vc) pow 2 <= (norm va * norm vc) pow 2 `) THEN\r
ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN\r
SIMP_TAC[REAL_LE_POW_2; SQRT_MUL; NORM_POS_LE; POW_2_SQRT]);;\r
\r
let PI2_EQ_ACS0 = prove(` pi / &2 = acs ( &0 ) `,\r
MP_TAC (REAL_ARITH` -- &1 <= &0 /\ &0 <= &1 `) THEN\r
NHANH ACS_BOUNDS THEN STRIP_TAC THEN MATCH_MP_TAC COS_INJ_PI\r
THEN ASM_SIMP_TAC[COS_PI2; COS_ACS] THEN ASSUME_TAC PI_POS\r
THEN ASM_REAL_ARITH_TAC);;\r
\r
let ANGLE_EQ_ARCV = prove(`! vap vbp. angle (vap,vec 0,vbp) = arcV (vec 0) vap vbp `,\r
REWRITE_TAC[arcV; angle; vector_angle] THEN REPEAT STRIP_TAC THEN\r
COND_CASES_TAC THENL [POP_ASSUM DISJ_CASES_TAC THENL [\r
ASM_SIMP_TAC[DOT_LZERO; REAL_ARITH` &0 / a = &0 `; PI2_EQ_ACS0];\r
ASM_SIMP_TAC[DOT_RZERO; REAL_ARITH` &0 / a = &0 `; PI2_EQ_ACS0]];\r
REWRITE_TAC[]]);;\r
\r
\r
let dihV = prove(`! w0 w1 w2 w3. dihV w0 w1 w2 w3 =\r
(let va = w2 - w0 in\r
let vb = w3 - w0 in\r
let vc = w1 - w0 in\r
let vap = (vc dot vc) % va - (va dot vc) % vc in\r
let vbp = (vc dot vc) % vb - (vb dot vc) % vc in arcV (vec 0) vap vbp)`,\r
SIMP_TAC[dihV; ANGLE_EQ_ARCV]);;\r
(* lemma 16 *)\r
\r
let RLXWSTK = prove(`! (v0: real^N) va vb vc. let gam = dihV v0 vc va vb in\r
let a = arcV v0 vc vb in\r
let b = arcV v0 vc va in\r
let c = arcV v0 va vb in\r
~collinear {v0, vc, va} /\ ~collinear {v0, vc, vb}\r
==> cos gam = (cos c - cos a * cos b) / ( sin a * sin b )`,\r
REPEAT GEN_TAC THEN REPEAT LET_TAC THEN EXPAND_TAC "gam" THEN\r
REWRITE_TAC[dihV] THEN LET_TR THEN\r
NHANH (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] ALLEMI_COLLINEAR) THEN\r
ONCE_REWRITE_TAC[VECTOR_ARITH` a = b <=> vec 0 = a - b `] THEN\r
SIMP_TAC[NOT_EQ_IMPCOS_ARC; VECTOR_SUB_RZERO ] THEN\r
ABBREV_TAC ` (va_v0p: real^N) = ((vc - v0) dot (vc - v0)) % (va - v0) -\r
((va - v0) dot (vc - v0)) % (vc - v0) ` THEN\r
ABBREV_TAC ` (vb_v0p :real^N) = ((vc - v0) dot (vc - v0)) % (vb - v0) -\r
((vb - v0) dot (vc - v0)) % (vc - v0) ` THEN\r
EXPAND_TAC "c" THEN EXPAND_TAC "a" THEN EXPAND_TAC "b" THEN\r
NHANH (MESON[COLLINEAR_2; INSERT_INSERT; INSERT_AC]`\r
~collinear {v0, vc, va} ==> ~( v0 = vc) /\ ~( v0 = va ) `) THEN\r
SIMP_TAC[NOT_2EQ_IMP_SIN_ARCV; NOT_EQ_IMPCOS_ARC] THEN\r
ONCE_REWRITE_TAC[COLLINEAR_TRANSABLE] THEN\r
REWRITE_TAC[GSYM NORM_CAUCHY_SCHWARZ_EQUAL] THEN\r
ONCE_REWRITE_TAC[VECTOR_ARITH` a = b <=> b - a = vec 0`] THEN\r
SIMP_TAC[ GSYM NORM_EQ_0] THEN ONCE_REWRITE_TAC[ GSYM DE_MORGAN_THM] THEN\r
REWRITE_TAC[GSYM REAL_ENTIRE] THEN SIMP_TAC[REAL_FIELD`~ ( c = &0 ) ==>\r
&1 - ( b / c ) pow 2 = ( c pow 2 - b pow 2) / c pow 2 `] THEN\r
SIMP_TAC[SQRT_SEPARATED] THEN SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; POW_2_SQRT] THEN\r
SIMP_TAC[REAL_FIELD` x / (( b / a ) * ( c / aa )) = ( x * a * aa ) / ( b * c ) `] THEN\r
REWRITE_TAC[REAL_SUB_RDISTRIB; REAL_MUL_AC; REAL_ENTIRE; DE_MORGAN_THM] THEN\r
SIMP_TAC[REAL_FIELD` ~( a = &0 ) /\ ~( b = &0 )\r
==> x / ( a * b ) * a * b * c = x * c `;\r
REAL_FIELD` ~( a = &0 ) /\ ~ ( b = &0 ) /\ ~ ( c = &0) ==>\r
x / ( a * c ) * y / ( b * c ) * a * b * c * c = x * y `] THEN\r
STRIP_TAC THEN EXPAND_TAC "va_v0p" THEN EXPAND_TAC "vb_v0p" THEN\r
REWRITE_TAC[COMPUTE_NORM_OF_P] THEN\r
REWRITE_TAC[ GSYM NORM_POW_2; REAL_ARITH` a pow 2 * b pow 2 = ( a * b ) pow 2`] THEN\r
ABBREV_TAC `vaa = ( va - (v0:real^N))` THEN\r
ABBREV_TAC `vbb = ( vb - (v0:real^N))` THEN\r
ABBREV_TAC `vcc = ( vc - (v0:real^N))` THEN\r
SIMP_TAC[MOVE_NORM_OUT_OF_SQRT; DOT_LSUB; DOT_RSUB] THEN\r
SIMP_TAC[MOVE_NORM_OUT_OF_SQRT; DOT_LSUB; DOT_RSUB;\r
DOT_LMUL; DOT_RMUL; DOT_SYM; GSYM NORM_POW_2] THEN\r
REWRITE_TAC[REAL_ARITH` ( a * b ) * a * c = a pow 2 * b * c `] THEN\r
REWRITE_TAC[REAL_FIELD` a / ( b * c ) = ( a / b ) / c `] THEN\r
MATCH_MP_TAC (MESON[]` a = b ==> a / c = b / c `) THEN\r
MATCH_MP_TAC (MESON[]` a = b ==> a / c = b / c `) THEN\r
REWRITE_TAC[REAL_ARITH` norm vcc pow 2 * norm vcc pow 2 * (vaa dot vbb) -\r
norm vcc pow 2 * (vbb dot vcc) * (vaa dot vcc) -\r
((vaa dot vcc) * norm vcc pow 2 * (vbb dot vcc) -\r
(vaa dot vcc) * (vbb dot vcc) * norm vcc pow 2) =\r
norm vcc pow 2 * ( norm vcc pow 2 * (vaa dot vbb) - (vaa dot vcc) * (vbb dot vcc) ) `] THEN\r
UNDISCH_TAC `~ ( norm (vcc:real^N) = &0 ) ` THEN CONV_TAC REAL_FIELD);;\r
\r
\r
\r
\r
\r
\r
let SIN_POW2_EQ_1_SUB_COS_POW2 = prove(` sin x pow 2 = &1 - cos x pow 2 `,\r
MP_TAC (SPEC_ALL SIN_CIRCLE) THEN REAL_ARITH_TAC);;\r
\r
\r
\r
\r
let LE_AND_NOT_0_EQ_LT = REAL_ARITH` &0 <= a /\ ~( a = &0 ) <=> &0 < a `;;\r
\r
let ABS_REFL = REAL_ABS_REFL;;\r
let LT_IMP_ABS_REFL = MESON[REAL_ABS_REFL; REAL_LT_IMP_LE]`&0 < a ==> abs a = a`;;\r
\r
\r
let ABS_MUL = REAL_ABS_MUL;;\r
let NOT_COLLINEAR_IMP_NOT_SIN0 = prove(`~collinear {v0, va, vb} ==> ~(sin ( arcV v0 va vb ) = &0)`,\r
SIMP_TAC[] THEN NHANH (MESON[INSERT_AC; COLLINEAR_2]` ~collinear {v0, va, vb}\r
==> ~( v0 = va ) /\ ~(v0 = vb) `) THEN\r
SIMP_TAC[NOT_2EQ_IMP_SIN_ARCV] THEN\r
ONCE_REWRITE_TAC[VECTOR_ARITH` a = b <=> b - a = vec 0 `] THEN\r
SIMP_TAC[ GSYM NORM_POS_LT] THEN\r
STRIP_TAC THEN\r
MATCH_MP_TAC (MESON[SQRT_EQ_0]` &0 <= x /\ ~( x = &0 ) ==> ~( sqrt x = &0 ) `) THEN\r
DOWN_TAC THEN\r
ONCE_REWRITE_TAC[ COLLINEAR_TRANSABLE ] THEN\r
REWRITE_TAC[ GSYM NORM_CAUCHY_SCHWARZ_EQUAL; ABS_NOT_EQ_NORM_MUL;\r
LE_AND_NOT_0_EQ_LT ] THEN\r
SIMP_TAC[REAL_FIELD`&0 < a /\ &0 < aa ==> &1 - ( b / ( a * aa )) pow 2\r
= ( ( a * aa ) pow 2 - b pow 2 ) / ( a * aa ) pow 2 `] THEN\r
STRIP_TAC THEN\r
MATCH_MP_TAC (SPEC_ALL REAL_LT_DIV) THEN\r
REWRITE_TAC[REAL_SUB_LT; GSYM REAL_LT_SQUARE_ABS] THEN\r
ONCE_REWRITE_TAC[REAL_ARITH` &0 = &0 pow 2 `] THEN\r
DOWN_TAC THEN\r
REWRITE_TAC[REAL_SUB_LT; GSYM REAL_LT_SQUARE_ABS; REAL_ABS_0;\r
ABS_MUL] THEN\r
SIMP_TAC[LT_IMP_ABS_REFL; REAL_LT_MUL ]);;\r
let REAL_LE_LDIV =\r
MESON[REAL_LE_LDIV_EQ; REAL_MUL_LID]`\r
! x z. &0 < z /\ x <= z ==> x / z <= &1 `;;\r
let NOT_IDEN_IMP_ABS_LE = prove(`~(v0 = va) /\ ~(v0 = vb)\r
==> abs (((va - v0) dot (vb - v0)) / (norm (va - v0) * norm (vb - v0))) <=\r
&1`, ONCE_REWRITE_TAC[VECTOR_ARITH` a = b <=> b - a = vec 0`] THEN\r
SIMP_TAC[REAL_ABS_DIV; REAL_ABS_MUL; REAL_ABS_NORM; GSYM NORM_POS_LT] THEN\r
STRIP_TAC THEN MATCH_MP_TAC REAL_LE_LDIV\r
THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_MUL_LID;\r
REAL_DIV_1; NORM_CAUCHY_SCHWARZ_ABS]);;\r
\r
let ABS_1 = REAL_ABS_1;;\r
let PROVE_SIN_LE = prove(`~(v0 = va) /\ ~(v0 = vb) ==> &0 <= sin ( arcV v0 va vb )`,\r
SIMP_TAC[NOT_2EQ_IMP_SIN_ARCV; arcV] THEN\r
NGOAC THEN NHANH (NOT_IDEN_IMP_ABS_LE ) THEN\r
SIMP_TAC[ABS_LE_1_IMP_SIN_ACS] THEN STRIP_TAC THEN MATCH_MP_TAC SQRT_POS_LE THEN\r
DOWN_TAC THEN ONCE_REWRITE_TAC[ GSYM ABS_1] THEN\r
ASM_SIMP_TAC[REAL_SUB_LE; GSYM ABS_1; REAL_LE_SQUARE_ABS] THEN\r
SIMP_TAC[REAL_ARITH`( &1 ) pow 2 = &1`; ABS_1]);;\r
\r
\r
\r
let MUL_POW2 = REAL_ARITH` (a*b) pow 2 = a pow 2 * b pow 2 `;;\r
\r
\r
\r
\r
let COMPUTE_SIN_DIVH_POW2 = prove(`! (v0: real^N) va vb vc.\r
let betaa = dihV v0 vc va vb in\r
let a = arcV v0 vc vb in\r
let b = arcV v0 vc va in\r
let c = arcV v0 va vb in\r
let p =\r
&1 - cos a pow 2 - cos b pow 2 - cos c pow 2 +\r
&2 * cos a * cos b * cos c in\r
~collinear {v0, vc, va} /\ ~collinear {v0, vc, vb} ==>\r
( sin betaa ) pow 2 = p / ((sin a * sin b) pow 2) `,\r
\r
REPEAT STRIP_TAC THEN MP_TAC (SPEC_ALL RLXWSTK ) THEN\r
REPEAT LET_TAC THEN SIMP_TAC[SIN_POW2_EQ_1_SUB_COS_POW2 ] THEN\r
REPEAT STRIP_TAC THEN REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN\r
NHANH (NOT_COLLINEAR_IMP_NOT_SIN0) THEN\r
EXPAND_TAC "a" THEN EXPAND_TAC "b" THEN PHA THEN\r
SIMP_TAC[REAL_FIELD` ~( a = &0 ) /\ ~ ( b = &0 ) ==>\r
&1 - ( x / ( a * b )) pow 2 = (( a * b ) pow 2 - x pow 2 ) / (( a * b ) pow 2 ) `] THEN\r
ASM_SIMP_TAC[] THEN STRIP_TAC THEN\r
MATCH_MP_TAC (MESON[]` a = b ==> a / x = b / x `) THEN\r
EXPAND_TAC "p" THEN SIMP_TAC[MUL_POW2; SIN_POW2_EQ_1_SUB_COS_POW2] THEN\r
REAL_ARITH_TAC);;\r
\r
\r
\r
\r
let PROVE_P_LE = prove(`!(v0:real^N) va vb vc.\r
let a = arcV v0 vc vb in\r
let b = arcV v0 vc va in\r
let c = arcV v0 va vb in\r
let p =\r
&1 - cos a pow 2 - cos b pow 2 - cos c pow 2 +\r
&2 * cos a * cos b * cos c in\r
~collinear {v0, vc, va} /\ ~collinear {v0, vc, vb} ==> &0 <= p`,\r
REPEAT GEN_TAC THEN MP_TAC (SPEC_ALL COMPUTE_SIN_DIVH_POW2 ) THEN\r
REPEAT LET_TAC THEN REWRITE_TAC[MESON[]` ( a ==> b ) ==> a ==> c <=>\r
a /\ b ==> c `] THEN NHANH (NOT_COLLINEAR_IMP_NOT_SIN0) THEN\r
ASM_SIMP_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM MP_TAC THEN\r
ASM_SIMP_TAC[REAL_FIELD` ~( a = &0 ) /\ ~( b = &0 ) ==>\r
( x = y / ( a * b ) pow 2 <=> x * ( a * b ) pow 2 = y ) `] THEN\r
MESON_TAC[GSYM MUL_POW2; REAL_LE_POW_2]);;\r
\r
\r
let POW2_COND = MESON[REAL_ABS_REFL; REAL_LE_SQUARE_ABS]` ! a b. &0 <= a /\ &0 <= b ==>\r
( a <= b <=> a pow 2 <= b pow 2 ) `;;\r
\r
\r
let EQ_POW2_COND = prove(`!a b. &0 <= a /\ &0 <= b ==> (a = b <=> a pow 2 = b pow 2)`,\r
REWRITE_TAC[REAL_ARITH` a = b <=> a <= b /\ b <= a `] THEN SIMP_TAC[POW2_COND]);;\r
\r
let NOT_COLLINEAR_IMP_2_UNEQUAL = MESON[INSERT_INSERT; COLLINEAR_2; INSERT_AC]`\r
~collinear {v0, va, vb} ==> ~(v0 = va) /\ ~(v0 = vb) `;;\r
\r
\r
let NOT_COLL_IM_SIN_LT = prove(`~collinear {v0, va, vb} ==> &0 < sin (arcV v0 va vb)`,\r
REWRITE_TAC[GSYM LE_AND_NOT_0_EQ_LT] THEN\r
NHANH (NOT_COLLINEAR_IMP_2_UNEQUAL ) THEN\r
SIMP_TAC[NOT_COLLINEAR_IMP_NOT_SIN0; PROVE_SIN_LE]);;\r
\r
let ARC_SYM = prove(` arcV v0 vc vb = arcV v0 vb vc `,\r
SIMP_TAC[arcV; DOT_SYM; REAL_MUL_SYM]);;\r
\r
\r
let DIV_POW2 = REAL_FIELD` ( a / b ) pow 2 = a pow 2 / b pow 2 `;;\r
\r
\r
ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] ALLEMI_COLLINEAR;;\r
\r
let SIN_MUL_EXPAND = prove(` !(v0:real^N) va vb vc.\r
let gam = dihV v0 vc va vb in\r
let bet = dihV v0 vb vc va in\r
let a = arcV v0 vc vb in\r
let b = arcV v0 vc va in\r
let c = arcV v0 va vb in\r
let p =\r
&1 - cos a pow 2 - cos b pow 2 - cos c pow 2 +\r
&2 * cos a * cos b * cos c in\r
~collinear {v0, vc, va} /\ ~collinear {v0, vc, vb} /\\r
~ collinear {v0,va,vb} ==>\r
sin gam * sin bet = p / ( sin b * sin c * ( sin a pow 2 )) `,\r
REPEAT GEN_TAC THEN\r
MP_TAC (COMPUTE_SIN_DIVH_POW2) THEN\r
REPEAT LET_TAC THEN\r
REPEAT STRIP_TAC THEN\r
MATCH_MP_TAC (MESON[EQ_POW2_COND]` &0 <= a /\ &0 <= b /\ a pow 2 = b pow 2\r
==> a = b `) THEN\r
CONJ_TAC THENL [ REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC) THEN\r
EXPAND_TAC "gam" THEN EXPAND_TAC "betaa" THEN\r
EXPAND_TAC "bet" THEN REWRITE_TAC[dihV] THEN LET_TR THEN\r
NHANH (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] ALLEMI_COLLINEAR) THEN\r
ONCE_REWRITE_TAC[SET_RULE` {a,b} = {b,a}`] THEN\r
NHANH (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] ALLEMI_COLLINEAR) THEN\r
ONCE_REWRITE_TAC[VECTOR_ARITH ` a = b <=> vec 0 = a - b `] THEN\r
REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN\r
ASM_SIMP_TAC[PROVE_SIN_LE]; REWRITE_TAC[]] THEN\r
CONJ_TAC THENL [MP_TAC (SPEC_ALL PROVE_P_LE ) THEN\r
REPEAT LET_TAC THEN\r
DOWN_TAC THEN\r
ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN\r
STRIP_TAC THEN\r
FIRST_X_ASSUM MP_TAC THEN\r
ASM_SIMP_TAC[] THEN\r
MATCH_MP_TAC (MESON[]` (! a. a = b ==> &0 <= a ==> P a )\r
==> &0 <= b ==> P b `) THEN\r
GEN_TAC THEN STRIP_TAC THEN\r
UNDISCH_TAC `~collinear {v0, vc, (vb: real^N)}` THEN\r
UNDISCH_TAC `~collinear {v0, vc, (va: real^N)}` THEN\r
UNDISCH_TAC `~collinear {v0, va, (vb: real^N)}` THEN\r
NHANH (NOT_COLL_IM_SIN_LT ) THEN\r
NHANH (REAL_LT_IMP_LE) THEN\r
REPEAT STRIP_TAC THEN\r
MATCH_MP_TAC REAL_LE_DIV THEN\r
ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_POW_2]; REWRITE_TAC[]] THEN\r
EXPAND_TAC "gam" THEN EXPAND_TAC "betaa" THEN EXPAND_TAC "bet" THEN\r
SIMP_TAC[MUL_POW2] THEN\r
REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC) THEN\r
PHA THEN\r
FIRST_X_ASSUM MP_TAC THEN\r
SIMP_TAC[] THEN\r
DISCH_TAC THEN\r
ONCE_REWRITE_TAC[SET_RULE` {a,b} = {b,a}`] THEN\r
FIRST_X_ASSUM MP_TAC THEN\r
SIMP_TAC[] THEN\r
REWRITE_TAC[REAL_FIELD` a / x * aa / y = ( a * aa ) / ( x * y ) `] THEN\r
REPEAT STRIP_TAC THEN\r
ASM_SIMP_TAC[ARC_SYM] THEN\r
ONCE_REWRITE_TAC[ARC_SYM] THEN\r
ASM_SIMP_TAC[] THEN\r
SIMP_TAC[DIV_POW2; REAL_ARITH` ((sin a * sin b) pow 2 * (sin c * sin a) pow 2) =\r
(sin b * sin c * sin a pow 2) pow 2 `] THEN\r
MATCH_MP_TAC (MESON[]` a = b ==> a / x = b / x `) THEN\r
EXPAND_TAC "p'" THEN\r
EXPAND_TAC "p" THEN\r
EXPAND_TAC "a" THEN\r
EXPAND_TAC "b" THEN\r
EXPAND_TAC "c" THEN\r
EXPAND_TAC "a'" THEN\r
EXPAND_TAC "b'" THEN\r
EXPAND_TAC "c'" THEN\r
SIMP_TAC[ARC_SYM] THEN\r
REAL_ARITH_TAC);;\r
\r
(*\r
let DIHV_SYM = prove(`dihV a b x y = dihV a b y x `,\r
REWRITE_TAC[dihV] THEN LET_TR THEN SIMP_TAC[DOT_SYM; ARC_SYM]);;\r
replaced Feb 13, 2013.  Merged with version in Multivariate/flyspeck.ml.\r
*)\r
\r
let DIHV_SYM = prove\r
 (`!v0 v1 v2 v3:real^N.\r
        dihV v0 v1 v3 v2 = dihV v0 v1 v2 v3`,\r
  REPEAT GEN_TAC THEN REWRITE_TAC[DIHV] THEN\r
  CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN\r
  REWRITE_TAC[DOT_SYM; ANGLE_SYM]);;\r
\r
\r
(* lemma 17 *)\r
\r
(*  (* redone below *)\r
let NLVWBBW = prove(` !(v0:real^N) va vb vc.\r
let al = dihV v0 va vb vc in\r
let ga = dihV v0 vc va vb in\r
let be = dihV v0 vb vc va in\r
let a = arcV v0 vc vb in\r
let b = arcV v0 vc va in\r
let c = arcV v0 va vb in\r
let p =\r
&1 - cos a pow 2 - cos b pow 2 - cos c pow 2 +\r
&2 * cos a * cos b * cos c in\r
~collinear {v0, vc, va} /\ ~collinear {v0, vc, vb} /\\r
~ collinear {v0,va,vb} ==>\r
cos c * sin al * sin be = cos ga + cos al * cos be `,\r
REPEAT GEN_TAC THEN MP_TAC RLXWSTK THEN REPEAT LET_TAC THEN\r
EXPAND_TAC "al" THEN EXPAND_TAC "be" THEN EXPAND_TAC "ga" THEN\r
EXPAND_TAC "gam" THEN SIMP_TAC[INSERT_AC] THEN STRIP_TAC THEN\r
MP_TAC SIN_MUL_EXPAND THEN REPEAT LET_TAC THEN EXPAND_TAC "bet" THEN\r
SIMP_TAC[INSERT_AC; DIHV_SYM; ARC_SYM] THEN\r
ONCE_REWRITE_TAC[MESON[DIHV_SYM]` aa * sin (dihV v0 va vb vc) * sin (dihV v0 vb va vc) =\r
aa * sin (dihV v0 va vc vb) * sin (dihV v0 vb vc va)`] THEN\r
DISCH_TAC THEN ONCE_REWRITE_TAC[MESON[INSERT_AC]`~collinear {v0, va, vc} /\\r
~collinear {v0, vb, vc} /\ ~collinear {v0, va, vb} <=>\r
~collinear {v0, vc, va} /\ ~collinear {v0, vb, va} /\\r
~collinear {v0, vc, vb} `] THEN FIRST_X_ASSUM MP_TAC THEN\r
SIMP_TAC[] THEN DOWN_TAC THEN SIMP_TAC[ARC_SYM; DIHV_SYM] THEN\r
STRIP_TAC THEN REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC) THEN\r
NHANH (NOT_COLLINEAR_IMP_NOT_SIN0) THEN ASM_SIMP_TAC[ARC_SYM] THEN\r
REPEAT STRIP_TAC THEN UNDISCH_TAC `~( sin a = &0 )` THEN\r
UNDISCH_TAC `~( sin b = &0 )` THEN UNDISCH_TAC `~( sin c = &0 )` THEN\r
PHA THEN SIMP_TAC[REAL_FIELD `~(c = &0) /\ ~(b = &0) /\ ~(a = &0)\r
==> x / (a * b) + y / (b * c) * z / (c * a) = ( x * c pow 2 + y * z ) / ( b * a * c pow 2 ) `] THEN\r
STRIP_TAC THEN REWRITE_TAC[REAL_ARITH` a * ( x / y ) = ( a * x ) / y `] THEN\r
MATCH_MP_TAC (MESON[]` a = b ==> a / x = b / x `) THEN\r
SIMP_TAC[SIN_POW2_EQ_1_SUB_COS_POW2] THEN REAL_ARITH_TAC);;\r
*)\r
\r
(* tchales removed extraneous p from statement *)\r
\r
let NLVWBBW = prove(` !(v0:real^N) va vb vc.\r
let al = dihV v0 va vb vc in\r
let ga = dihV v0 vc va vb in\r
let be = dihV v0 vb vc va in\r
let a = arcV v0 vc vb in\r
let b = arcV v0 vc va in\r
let c = arcV v0 va vb in\r
~collinear {v0, vc, va} /\ ~collinear {v0, vc, vb} /\\r
~ collinear {v0,va,vb} ==>\r
cos c * sin al * sin be = cos ga + cos al * cos be `,\r
REPEAT GEN_TAC THEN MP_TAC RLXWSTK THEN REPEAT LET_TAC THEN\r
EXPAND_TAC "al" THEN EXPAND_TAC "be" THEN EXPAND_TAC "ga" THEN\r
EXPAND_TAC "gam" THEN SIMP_TAC[INSERT_AC] THEN STRIP_TAC THEN\r
MP_TAC SIN_MUL_EXPAND THEN REPEAT LET_TAC THEN EXPAND_TAC "bet" THEN\r
SIMP_TAC[INSERT_AC; DIHV_SYM; ARC_SYM] THEN\r
ONCE_REWRITE_TAC[MESON[DIHV_SYM]` aa * sin (dihV v0 va vb vc) * sin (dihV v0 vb va vc) =\r
aa * sin (dihV v0 va vc vb) * sin (dihV v0 vb vc va)`] THEN\r
DISCH_TAC THEN ONCE_REWRITE_TAC[MESON[INSERT_AC]`~collinear {v0, va, vc} /\\r
~collinear {v0, vb, vc} /\ ~collinear {v0, va, vb} <=>\r
~collinear {v0, vc, va} /\ ~collinear {v0, vb, va} /\\r
~collinear {v0, vc, vb} `] THEN FIRST_X_ASSUM MP_TAC THEN\r
SIMP_TAC[] THEN DOWN_TAC THEN SIMP_TAC[ARC_SYM; DIHV_SYM] THEN\r
STRIP_TAC THEN REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC) THEN\r
NHANH (NOT_COLLINEAR_IMP_NOT_SIN0) THEN ASM_SIMP_TAC[ARC_SYM] THEN\r
REPEAT STRIP_TAC THEN UNDISCH_TAC `~( sin a = &0 )` THEN\r
UNDISCH_TAC `~( sin b = &0 )` THEN UNDISCH_TAC `~( sin c = &0 )` THEN\r
PHA THEN SIMP_TAC[REAL_FIELD `~(c = &0) /\ ~(b = &0) /\ ~(a = &0)\r
==> x / (a * b) + y / (b * c) * z / (c * a) = ( x * c pow 2 + y * z ) / ( b * a * c pow 2 ) `] THEN\r
STRIP_TAC THEN REWRITE_TAC[REAL_ARITH` a * ( x / y ) = ( a * x ) / y `] THEN\r
MATCH_MP_TAC (MESON[]` a = b ==> a / x = b / x `) THEN\r
SIMP_TAC[SIN_POW2_EQ_1_SUB_COS_POW2] THEN REAL_ARITH_TAC);;\r
\r
\r
let COMPUTE_NORM_POW2 = prove(`\r
norm ((vc dot vc) % vb - (vb dot vc) % vc ) pow 2 = ((norm vc pow 2 + norm vc pow 2) - dist (vc,vc) pow 2) / &2 *\r
(((norm vc pow 2 + norm vc pow 2) - dist (vc,vc) pow 2) / &2 *\r
((norm vb pow 2 + norm vb pow 2) - dist (vb,vb) pow 2) / &2 -\r
((norm vb pow 2 + norm vc pow 2) - dist (vb,vc) pow 2) / &2 *\r
((norm vb pow 2 + norm vc pow 2) - dist (vb,vc) pow 2) / &2) -\r
((norm vb pow 2 + norm vc pow 2) - dist (vb,vc) pow 2) / &2 *\r
(((norm vc pow 2 + norm vc pow 2) - dist (vc,vc) pow 2) / &2 *\r
((norm vc pow 2 + norm vb pow 2) - dist (vc,vb) pow 2) / &2 -\r
((norm vb pow 2 + norm vc pow 2) - dist (vb,vc) pow 2) / &2 *\r
((norm vc pow 2 + norm vc pow 2) - dist (vc,vc) pow 2) / &2) `,\r
MATCH_MP_TAC (MESON[]`(! c. c = b ==> a = c ) ==> a = b`) THEN REPEAT STRIP_TAC THEN\r
SIMP_TAC[NORM_POW_2] THEN SIMP_TAC[GSYM dist;\r
VECTOR_SUB_RZERO; DOT_LSUB; DOT_RSUB; DOT_LMUL;\r
DOT_RMUL; DOT_NORM_NEG] THEN ASM_SIMP_TAC[]);;\r
\r
\r
let UPS_X_AND_HERON = prove(`ups_x (x1 pow 2) (x2 pow 2) (x6 pow 2) =\r
(x1 + x2 + x6) * (x1 + x2 - x6) * (x2 + x6 - x1) * (x6 + x1 - x2)`,\r
SIMP_TAC[ups_x] THEN REAL_ARITH_TAC);;\r
\r
\r
let UPS_X_POS = prove(`dist (v0,v1) pow 2 = v01 /\\r
dist (v0,v2) pow 2 = v02 /\\r
dist (v1,v2) pow 2 = v12\r
==> &0 <= ups_x v01 v02 v12`,\r
ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN\r
SIMP_TAC[UPS_X_AND_HERON] THEN\r
DISCH_TAC THEN\r
MATCH_MP_TAC REAL_LE_MUL THEN\r
SIMP_TAC[DIST_POS_LE; REAL_LE_ADD] THEN\r
MATCH_MP_TAC REAL_LE_MUL THEN\r
CONJ_TAC THENL [\r
MESON_TAC[ONCE_REWRITE_RULE[REAL_ARITH` a <= b + c <=> &0 <= b + c - a `]\r
DIST_TRIANGLE; DIST_SYM; DIST_POS_LE];\r
MATCH_MP_TAC REAL_LE_MUL] THEN\r
MESON_TAC[ONCE_REWRITE_RULE[REAL_ARITH` a <= b + c <=> &0 <= b + c - a `]\r
DIST_TRIANGLE; DIST_SYM; DIST_POS_LE]);;\r
\r
\r
let DIST_TRANSABLE = prove(` dist ( a - v0, b ) = dist ( a , b + v0 ) `,\r
REWRITE_TAC[dist; VECTOR_ARITH` a - v0 - b = (a:real^N) - ( b + v0 ) `]);;\r
\r
prove(` v2 - v0 = va /\\r
v3 - v0 = vb ==> dist (va,vb) = dist ( v2,v3) `,\r
ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN\r
SIMP_TAC[DIST_TRANSABLE; VECTOR_ARITH` a - b + b = ( a:real^N)`]);;\r
\r
let REAL_LE_SQUARE_POW =\r
MESON[REAL_POW_2; REAL_LE_SQUARE]`! x. &0 <= x pow 2 `;;\r
\r
\r
(*\r
g ` dist ((v0:real^N),v1) pow 2 = v01 /\\r
dist (v0,v2) pow 2 = v02 /\\r
dist (v0,v3) pow 2 = v03 /\\r
dist (v1,v2) pow 2 = v12 /\\r
dist (v1,v3) pow 2 = v13 /\\r
dist (v2,v3) pow 2 = v23 /\\r
~collinear {v0, v1, v2} /\\r
~collinear {v0, v1, v3}\r
==> (let va = v2 - v0 in\r
let vb = v3 - v0 in\r
let vc = v1 - v0 in\r
let vap = (vc dot vc) % va - (va dot vc) % vc in\r
let vbp = (vc dot vc) % vb - (vb dot vc) % vc in\r
(((vap - vec 0) dot (vbp - vec 0)) /\r
(norm (vap - vec 0) * norm (vbp - vec 0)))) =\r
(delta_x4 v01 v02 v03 v23 v13 v12 /\r
sqrt (ups_x v01 v02 v12 * ups_x v01 v03 v13))`;;\r
\r
e (REPEAT LET_TAC THEN STRIP_TAC);;\r
e (EXPAND_TAC "vap" THEN EXPAND_TAC "vbp");;\r
e (ONCE_REWRITE_TAC[MESON[NORM_POS_LE; POW_2_SQRT]` norm x = sqrt ( norm x pow 2 ) `] THEN REWRITE_TAC[MESON[REAL_LE_POW_2; SQRT_MUL]` sqrt ( x pow 2 ) * sqrt ( y pow 2 ) = sqrt ( x pow 2 * y pow 2 ) `]);;\r
e (SIMP_TAC[VECTOR_SUB_RZERO; COMPUTE_NORM_POW2 ] THEN REWRITE_TAC[GSYM (MESON[NORM_POS_LE; POW_2_SQRT]` norm x = sqrt ( norm x pow 2 ) `)] THEN REWRITE_TAC[DIST_REFL; REAL_SUB_RZERO; REAL_ARITH` &0 pow 2 = &0`] THEN EXPAND_TAC "va" THEN EXPAND_TAC "vb" THEN EXPAND_TAC "vc" THEN SIMP_TAC[VECTOR_ARITH` a - b - (c - b ) = a -(c:real^N)`; GSYM dist] THEN FIRST_X_ASSUM MP_TAC);;\r
 e (NHANH (MESON[COLLINEAR_2; INSERT_INSERT]` ~ collinear {a,b,c} ==> ~( a = b ) `) THEN REWRITE_TAC[DIST_NZ] THEN NHANH (REAL_FIELD` &0 < a ==> &1 = ( &1 / &4 * (a pow 2 ))/ ( &1 / &4 * (a pow 2 )) `) THEN ONCE_REWRITE_TAC[MESON[REAL_MUL_LID]` l ==> a = b <=> l ==> a = &1 * b `]);;\r
e (ABBREV_TAC ` as = (&1 / &4 * dist ((v0:real^N),v1) pow 2 ) ` THEN SIMP_TAC[REAL_FIELD` a / b * aa / bb = ( a * aa ) / ( b * bb ) `] THEN STRIP_TAC THEN MATCH_MP_TAC (MESON[]` a = aa /\ b = bb ==> a / b = aa / bb `));;\r
e (CONJ_TAC THENL [ SIMP_TAC[GSYM NORM_POW_2; GSYM dist] THEN ASM_SIMP_TAC[] THEN SIMP_TAC[DIST_SYM; DOT_LSUB; DOT_RSUB; DOT_LMUL; DOT_RMUL] THEN SIMP_TAC[DOT_NORM_NEG] THEN EXPAND_TAC "va" THEN EXPAND_TAC "vb" THEN EXPAND_TAC "vc" THEN REWRITE_TAC[ VECTOR_ARITH` a - b - ( c - b ) = a - (c:real^N)`] THEN REWRITE_TAC[GSYM dist] THEN EXPAND_TAC "as" THEN UNDISCH_TAC `&1 / &4 * dist ((v0:real^N),v1) pow 2 = as` THEN FIRST_X_ASSUM MP_TAC THEN PHA THEN MATCH_MP_TAC (MESON[]` a ==> b ==> a `) THEN ASM_SIMP_TAC[DIST_SYM; DIST_REFL; delta_x4] THEN REAL_ARITH_TAC; UNDISCH_TAC`&1 / &4 * dist ((v0:real^N),v1) pow 2 = as`] THEN MP_TAC (SPEC ` dist ((v0:real^N),v1)` REAL_LE_POW_2) THEN PHA THEN NHANH (REAL_ARITH `&0 <= a /\ &1 / &4 * a = as ==> &0 <= as `) THEN REWRITE_TAC[MESON[POW_2_SQRT]` da /\ &0 <= a ==> p1 = a * p2 <=> da /\ &0 <= a ==> p1 = sqrt ( a pow 2 ) * p2 `] THEN DOWN_TAC THEN NHANH (MESON[UPS_X_POS; DIST_SYM ]`dist (v0,v1) pow 2 = v01 /\ dist (v0,v2) pow 2 = v02 /\ dist (v0,v3) pow 2 = v03 /\ dist (v1,v2) pow 2 = v12 /\ dist (v1,v3) pow 2 = v13 /\ dist (v2,v3) pow 2 = v23 /\ l ==> &0 <= ups_x v01 v02 v12 /\ &0 <= ups_x v01 v03 v13 `) THEN NHANH (REAL_LE_MUL));;\r
e (SIMP_TAC[REAL_LE_SQUARE_POW; GSYM SQRT_MUL] THEN STRIP_TAC THEN MATCH_MP_TAC (MESON[]` a = b ==> p a = p b `) THEN REPLICATE_TAC 6 (FIRST_X_ASSUM MP_TAC) THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[DIST_SYM] THEN DOWN_TAC THEN NHANH (MESON[prove(` v2 - v0 = va /\ v3 - v0 = vb ==> dist (va,vb) = dist ( v2,v3) `, ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN SIMP_TAC[DIST_TRANSABLE; VECTOR_ARITH` a - b + b = ( a:real^N)`]); DIST_SYM]` v2 - v0 = va /\ v3 - v0 = vb /\ v1 - v0 = vc /\ l ==> dist (va,vb ) = dist (v2,v3) /\ dist (vb,vc) = dist(v1,v3) /\ dist (va,vc) = dist (v1,v2)`) THEN SIMP_TAC[ups_x] THEN STRIP_TAC THEN REAL_ARITH_TAC);;\r
\r
let PROVE_DELTA_OVER_SQRT_2UPS = top_thm();;\r
*)\r
\r
let PROVE_DELTA_OVER_SQRT_2UPS = prove_by_refinement(\r
` dist ((v0:real^N),v1) pow 2 = v01 /\\r
dist (v0,v2) pow 2 = v02 /\\r
dist (v0,v3) pow 2 = v03 /\\r
dist (v1,v2) pow 2 = v12 /\\r
dist (v1,v3) pow 2 = v13 /\\r
dist (v2,v3) pow 2 = v23 /\\r
~collinear {v0, v1, v2} /\\r
~collinear {v0, v1, v3}\r
==> (let va = v2 - v0 in\r
let vb = v3 - v0 in\r
let vc = v1 - v0 in\r
let vap = (vc dot vc) % va - (va dot vc) % vc in\r
let vbp = (vc dot vc) % vb - (vb dot vc) % vc in\r
(((vap - vec 0) dot (vbp - vec 0)) /\r
(norm (vap - vec 0) * norm (vbp - vec 0)))) =\r
(delta_x4 v01 v02 v03 v23 v13 v12 /\r
sqrt (ups_x v01 v02 v12 * ups_x v01 v03 v13))`,\r
  (* {{{ proof *)\r
  [\r
  (REPEAT LET_TAC THEN STRIP_TAC);\r
  (EXPAND_TAC "vap" THEN EXPAND_TAC "vbp");\r
  (ONCE_REWRITE_TAC[MESON[NORM_POS_LE; POW_2_SQRT]` norm x = sqrt ( norm x pow 2 ) `] THEN REWRITE_TAC[MESON[REAL_LE_POW_2; SQRT_MUL]` sqrt ( x pow 2 ) * sqrt ( y pow 2 ) = sqrt ( x pow 2 * y pow 2 ) `]);\r
  (SIMP_TAC[VECTOR_SUB_RZERO; COMPUTE_NORM_POW2 ] THEN REWRITE_TAC[GSYM (MESON[NORM_POS_LE; POW_2_SQRT]` norm x = sqrt ( norm x pow 2 ) `)] THEN REWRITE_TAC[DIST_REFL; REAL_SUB_RZERO; REAL_ARITH` &0 pow 2 = &0`] THEN EXPAND_TAC "va" THEN EXPAND_TAC "vb" THEN EXPAND_TAC "vc" THEN SIMP_TAC[VECTOR_ARITH` a - b - (c - b ) = a -(c:real^N)`; GSYM dist] THEN FIRST_X_ASSUM MP_TAC);\r
   (NHANH (MESON[COLLINEAR_2; INSERT_INSERT]` ~ collinear {a,b,c} ==> ~( a = b ) `) THEN REWRITE_TAC[DIST_NZ] THEN NHANH (REAL_FIELD` &0 < a ==> &1 = ( &1 / &4 * (a pow 2 ))/ ( &1 / &4 * (a pow 2 )) `) THEN ONCE_REWRITE_TAC[MESON[REAL_MUL_LID]` l ==> a = b <=> l ==> a = &1 * b `]);\r
  (ABBREV_TAC ` as = (&1 / &4 * dist ((v0:real^N),v1) pow 2 ) ` THEN SIMP_TAC[REAL_FIELD` a / b * aa / bb = ( a * aa ) / ( b * bb ) `] THEN STRIP_TAC THEN MATCH_MP_TAC (MESON[]` a = aa /\ b = bb ==> a / b = aa / bb `));\r
  (CONJ_TAC THENL [ SIMP_TAC[GSYM NORM_POW_2; GSYM dist] THEN ASM_SIMP_TAC[] THEN SIMP_TAC[DIST_SYM; DOT_LSUB; DOT_RSUB; DOT_LMUL; DOT_RMUL] THEN SIMP_TAC[DOT_NORM_NEG] THEN EXPAND_TAC "va" THEN EXPAND_TAC "vb" THEN EXPAND_TAC "vc" THEN REWRITE_TAC[ VECTOR_ARITH` a - b - ( c - b ) = a - (c:real^N)`] THEN REWRITE_TAC[GSYM dist] THEN EXPAND_TAC "as" THEN UNDISCH_TAC `&1 / &4 * dist ((v0:real^N),v1) pow 2 = as` THEN FIRST_X_ASSUM MP_TAC THEN PHA THEN MATCH_MP_TAC (MESON[]` a ==> b ==> a `) THEN ASM_SIMP_TAC[DIST_SYM; DIST_REFL; delta_x4] THEN REAL_ARITH_TAC; UNDISCH_TAC`&1 / &4 * dist ((v0:real^N),v1) pow 2 = as`] THEN MP_TAC (SPEC ` dist ((v0:real^N),v1)` REAL_LE_POW_2) THEN PHA THEN NHANH (REAL_ARITH `&0 <= a /\ &1 / &4 * a = as ==> &0 <= as `) THEN REWRITE_TAC[MESON[POW_2_SQRT]` da /\ &0 <= a ==> p1 = a * p2 <=> da /\ &0 <= a ==> p1 = sqrt ( a pow 2 ) * p2 `] THEN DOWN_TAC THEN NHANH (MESON[UPS_X_POS; DIST_SYM ]`dist (v0,v1) pow 2 = v01 /\ dist (v0,v2) pow 2 = v02 /\ dist (v0,v3) pow 2 = v03 /\ dist (v1,v2) pow 2 = v12 /\ dist (v1,v3) pow 2 = v13 /\ dist (v2,v3) pow 2 = v23 /\ l ==> &0 <= ups_x v01 v02 v12 /\ &0 <= ups_x v01 v03 v13 `) THEN NHANH (REAL_LE_MUL));\r
  BY((SIMP_TAC[REAL_LE_SQUARE_POW; GSYM SQRT_MUL] THEN STRIP_TAC THEN MATCH_MP_TAC (MESON[]` a = b ==> p a = p b `) THEN REPLICATE_TAC 6 (FIRST_X_ASSUM MP_TAC) THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[DIST_SYM] THEN DOWN_TAC THEN NHANH (MESON[prove(` v2 - v0 = va /\ v3 - v0 = vb ==> dist (va,vb) = dist ( v2,v3) `, ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN SIMP_TAC[DIST_TRANSABLE; VECTOR_ARITH` a - b + b = ( a:real^N)`]); DIST_SYM]` v2 - v0 = va /\ v3 - v0 = vb /\ v1 - v0 = vc /\ l ==> dist (va,vb ) = dist (v2,v3) /\ dist (vb,vc) = dist(v1,v3) /\ dist (va,vc) = dist (v1,v2)`) THEN SIMP_TAC[ups_x] THEN STRIP_TAC THEN REAL_ARITH_TAC))\r
  ]);;\r
  (* }}} *)\r
\r
let FOR_LEMMA19 = prove(`!(v0:real^N) v1 v2 v3.\r
let ga = dihV v0 v1 v2 v3 in\r
let v01 = dist (v0,v1) pow 2 in\r
let v02 = dist (v0,v2) pow 2 in\r
let v03 = dist (v0,v3) pow 2 in\r
let v12 = dist (v1,v2) pow 2 in\r
let v13 = dist (v1,v3) pow 2 in\r
let v23 = dist (v2,v3) pow 2 in\r
~collinear {v0, v1, v2} /\ ~collinear {v0, v1, v3}\r
==> ga =\r
acs\r
(delta_x4 v01 v02 v03 v23 v13 v12 /\r
sqrt (ups_x v01 v02 v12 * ups_x v01 v03 v13))`,\r
REPEAT STRIP_TAC THEN REPEAT LET_TAC THEN EXPAND_TAC "ga" THEN\r
SIMP_TAC[dihV; arcV] THEN REPEAT LET_TAC THEN REPEAT STRIP_TAC THEN\r
MATCH_MP_TAC (MESON[]` a = b ==> p a = p b `) THEN MP_TAC\r
PROVE_DELTA_OVER_SQRT_2UPS THEN REPEAT LET_TAC THEN\r
ASM_MESON_TAC[]);;\r
\r
\r
let COMPUTE_DELTA_OVER = prove(`dist ((v0:real^N),v1) pow 2 = v01 /\\r
dist (v0,v2) pow 2 = v02 /\\r
dist (v0,v3) pow 2 = v03 /\\r
dist (v1,v2) pow 2 = v12 /\\r
dist (v1,v3) pow 2 = v13 /\\r
dist (v2,v3) pow 2 = v23 /\\r
~collinear {v0, v1, v2} /\\r
~collinear {v0, v1, v3}\r
==> ((((v1 - v0) dot (v1 - v0)) % (v2 - v0) -\r
((v2 - v0) dot (v1 - v0)) % (v1 - v0)) dot\r
(((v1 - v0) dot (v1 - v0)) % (v3 - v0) -\r
((v3 - v0) dot (v1 - v0)) % (v1 - v0))) /\r
(norm\r
(((v1 - v0) dot (v1 - v0)) % (v2 - v0) -\r
((v2 - v0) dot (v1 - v0)) % (v1 - v0)) *\r
norm\r
(((v1 - v0) dot (v1 - v0)) % (v3 - v0) -\r
((v3 - v0) dot (v1 - v0)) % (v1 - v0))) =\r
delta_x4 v01 v02 v03 v23 v13 v12 /\r
sqrt (ups_x v01 v02 v12 * ups_x v01 v03 v13)`,\r
MP_TAC PROVE_DELTA_OVER_SQRT_2UPS THEN REWRITE_TAC[VECTOR_ARITH` a - vec 0 = a `]\r
THEN LET_TR THEN SIMP_TAC[]);;\r
\r
\r
\r
\r
\r
\r
\r
\r
let POS_COMPATIBLE_WITH_ATN2 = prove(` &0 < a ==> atn2 (x,y) = atn2 (a * x,a * y)`,\r
SIMP_TAC[atn2; REAL_FIELD` &0 < a ==> ( a * b ) / (a * c ) = b / c `] THEN\r
SIMP_TAC[ABS_MUL] THEN REWRITE_TAC[REAL_ARITH` a * y < &0 <=> &0 < a * ( -- y )`;\r
REAL_ARITH` b < &0 <=> &0 < -- b `] THEN\r
SIMP_TAC[ABS_MUL; LT_IMP_ABS_REFL; REAL_LT_LMUL_EQ; REAL_LT_MUL_EQ]);;\r
\r
\r
\r
let NOT_COLLINEAR_IMP_UPS_LT = prove( `\r
~( collinear {(v0:real^3),v1,v2} ) ==>\r
let v01 = dist (v0,v1) pow 2 in\r
let v02 = dist (v0,v2) pow 2 in\r
let v12 = dist (v1,v2) pow 2 in\r
&0 < ups_x v01 v02 v12 `,\r
REPEAT (LET_TAC THEN (REPEAT STRIP_TAC)) THEN\r
REWRITE_TAC[REAL_ARITH `&0 < x <=> (&0 <= x /\ ~(x = &0))`] THEN\r
ASM_MESON_TAC[COL_EQ_UPS_0;UPS_X_POS]);;\r
\r
(*\r
let NOT_COLLINEAR_IMP_UPS_LT = New_axiom `\r
~( collinear {(v0:real^N),v1,v2} ) ==>\r
let v01 = dist (v0,v1) pow 2 in\r
let v02 = dist (v0,v2) pow 2 in\r
let v12 = dist (v1,v2) pow 2 in\r
&0 < ups_x v01 v02 v12 `;;\r
*)\r
\r
(* Jason have proved the following lemma in the first half\r
of this file *)\r
\r
(*\r
let acs_atn2_t = `!y. (-- &1 <= y /\ y <= &1) ==> (acs y = pi/(&2) - atn2(sqrt(&1 - y pow 2),y))`;;\r
let acs_atn2 = new_axiom acs_atn2_t;;\r
*)\r
\r
let REAL_LT_DIV_0 = prove(` ! a b. &0 < b ==> ( &0 < a / b <=> &0 < a ) `,\r
REPEAT STRIP_TAC THEN EQ_TAC THENL\r
[ASSUME_TAC (UNDISCH (SPEC `b:real` REAL_LT_IMP_NZ)) THEN\r
ASM_MESON_TAC[REAL_LT_MUL; REAL_DIV_LMUL];\r
ASM_SIMP_TAC[REAL_LT_DIV]]);;\r
\r
let REAL_LE_RDIV_0 = prove(` ! a b. &0 < b ==> ( &0 <= a / b <=> &0 <= a ) `,\r
REWRITE_TAC[REAL_ARITH ` &0 <= a <=> &0 < a \/ a = &0 `] THEN\r
SIMP_TAC[REAL_LT_DIV_0] THEN\r
SIMP_TAC[REAL_FIELD `&0 < b ==> ( a / b = &0 <=> a = &0 ) `]);;\r
\r
let POW_2 = REAL_POW_2;;\r
\r
let NOT_ZERO_EQ_POW2_LT = prove(` ~( a = &0 ) <=> &0 < a pow 2 `,\r
SIMP_TAC[GSYM LE_AND_NOT_0_EQ_LT; POW_2;\r
REAL_ENTIRE; REAL_LE_SQUARE]);;\r
\r
(* lemma 18 *)\r
let OJEKOJF = prove(`!(v0:real^3) v1 v2 v3.\r
                    let ga = dihV v0 v1 v2 v3 in\r
                    let v01 = dist (v0,v1) pow 2 in\r
                    let v02 = dist (v0,v2) pow 2 in\r
                    let v03 = dist (v0,v3) pow 2 in\r
                    let v12 = dist (v1,v2) pow 2 in\r
                    let v13 = dist (v1,v3) pow 2 in\r
                    let v23 = dist (v2,v3) pow 2 in\r
                      ~collinear {v0, v1, v2} /\ ~collinear {v0, v1, v3}\r
                      ==> ga = acs (delta_x4 v01 v02 v03 v23 v13 v12 /\r
                                      sqrt (ups_x v01 v02 v12 * ups_x v01 v03 v13)) /\\r
                          ga = pi / &2 - atn2( sqrt ( &4 * v01 * delta_x v01 v02 v03 v23 v13 v12 ),\r
                                               delta_x4 v01 v02 v03 v23 v13 v12 ) `, \r
REPEAT STRIP_TAC THEN\r
MP_TAC (SPEC_ALL (INST_TYPE [`:3`,`:N`] FOR_LEMMA19) ) THEN REPEAT LET_TAC THEN\r
SIMP_TAC[] THEN DOWN_TAC THEN NGOAC THEN \r
REWRITE_TAC[MESON[]`l/\ ( a ==> b ) <=>( a ==> b ) /\ l `] THEN PHA THEN \r
NHANH (COMPUTE_DELTA_OVER ) THEN\r
NHANH (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] ALLEMI_COLLINEAR) THEN\r
ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN\r
ABBREV_TAC ` (w1:real^3) = ((v1 - v0) dot (v1 - v0)) % (v2 - v0) -((v2 - v0) dot (v1 - v0)) % (v1 - v0)` THEN\r
ABBREV_TAC ` (w2:real^3) = ((v1 - v0) dot (v1 - v0)) % (v3 - v0) -((v3 - v0) dot (v1 - v0)) % (v1 - v0) ` THEN\r
ONCE_REWRITE_TAC[MESON[]`( a/\ b ) /\ c /\ d <=>a /\ c /\ b /\ d `] THEN \r
NHANH (NOT_VEC0_IMP_LE1) THEN PHA THEN\r
REWRITE_TAC[MESON[]` P a /\ a = b <=> a = b /\ P b `] THEN\r
SIMP_TAC[REAL_ABS_BOUNDS; acs_atn2; REAL_ARITH ` a - x =a - y <=> x = y `] THEN \r
NHANH (NOT_COLLINEAR_IMP_UPS_LT ) THEN\r
LET_TR THEN \r
PHA THEN \r
NHANH (MESON[REAL_LT_MUL]` &0 < x /\ a1 /\ &0 < y /\ a2 ==> &0 < x * y `) THEN \r
STRIP_TAC THEN FIRST_X_ASSUM MP_TAC THEN\r
ASM_SIMP_TAC[] THEN NHANH SQRT_POS_LT THEN\r
SIMP_TAC[MESON[POS_COMPATIBLE_WITH_ATN2]` &0 < a ==>atn2 ( x, y / a ) = atn2 ( a * x , a * ( y / a ) ) `] THEN\r
SIMP_TAC[REAL_FIELD` &0 < a ==> a * ( y / a ) = y `] THEN\r
REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN\r
PHA THEN NGOAC THEN REWRITE_TAC[GSYM REAL_ABS_BOUNDS] THEN\r
ONCE_REWRITE_TAC[GSYM ABS_1] THEN\r
SIMP_TAC[REAL_LE_SQUARE_ABS; REAL_ARITH` a <= &1 <=> &0 <= &1 - a `; REAL_ARITH` ( &1 ) pow 2 = &1 `; ABS_1] THEN\r
DAO THEN ONCE_REWRITE_TAC[GSYM IMP_IMP] THEN\r
SIMP_TAC[REAL_FIELD` &0 < a ==> &1 - ( b / a ) pow 2= ( a pow 2 - b pow 2 ) / ( a pow 2 ) `] THEN\r
NHANH (REAL_LT_IMP_NZ) THEN NHANH (REAL_LT_IMP_LE) THEN\r
SIMP_TAC[NOT_ZERO_EQ_POW2_LT; REAL_LE_RDIV_0 ; SQRT_DIV] THEN\r
NHANH (REAL_LT_IMP_LE) THEN SIMP_TAC[SQRT_DIV; REAL_LE_POW2] THEN\r
SIMP_TAC[SQRT_DIV; REAL_LE_POW2; POW_2_SQRT; REAL_FIELD` &0 < a ==>a * b / a = b `] THEN \r
REPEAT STRIP_TAC THEN \r
MATCH_MP_TAC(MESON[]` a = b ==> atn2 ( sqrt a, c ) = atn2 ( sqrt b, c ) `) THEN \r
ASM_SIMP_TAC[SQRT_WORKS; ups_x; delta_x4; delta_x] THEN\r
REAL_ARITH_TAC\r
);;\r
\r
(* Thales note: 2010-2-7,  Here is N.Q. Truong's version that relied on an axiom. *)\r
\r
(*\r
\r
let OJEKOJF = prove(`!(v0:real^3) v1 v2 v3.\r
let ga = dihV v0 v1 v2 v3 in\r
let v01 = dist (v0,v1) pow 2 in\r
let v02 = dist (v0,v2) pow 2 in\r
let v03 = dist (v0,v3) pow 2 in\r
let v12 = dist (v1,v2) pow 2 in\r
let v13 = dist (v1,v3) pow 2 in\r
let v23 = dist (v2,v3) pow 2 in\r
~collinear {v0, v1, v2} /\ ~collinear {v0, v1, v3}\r
==> ga = acs (delta_x4 v01 v02 v03 v23 v13 v12 /\r
sqrt (ups_x v01 v02 v12 * ups_x v01 v03 v13)) /\\r
ga = pi / &2 - atn2( sqrt ( &4 * v01 * delta_x v01 v02 v03 v23 v13 v12 ),\r
delta_x4 v01 v02 v03 v23 v13 v12 ) `, \r
REPEAT STRIP_TAC THEN\r
MP_TAC (SPEC_ALL FOR_LEMMA19 ) THEN REPEAT LET_TAC THEN\r
SIMP_TAC[] THEN DOWN_TAC THEN NGOAC THEN \r
REWRITE_TAC[MESON[]`l/\ ( a ==> b ) <=>( a ==> b ) /\ l `] THEN PHA THEN \r
NHANH (COMPUTE_DELTA_OVER ) THEN\r
NHANH (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] ALLEMI_COLLINEAR) THEN\r
ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN\r
ABBREV_TAC ` (w1:real^3) = ((v1 - v0) dot (v1 - v0)) % (v2 - v0) -\r
((v2 - v0) dot (v1 - v0)) % (v1 - v0)` THEN\r
ABBREV_TAC ` (w2:real^3) = ((v1 - v0) dot (v1 - v0)) % (v3 - v0) -\r
((v3 - v0) dot (v1 - v0)) % (v1 - v0) ` THEN\r
ONCE_REWRITE_TAC[MESON[]`( a/\ b ) /\ c /\ d <=>\r
a /\ c /\ b /\ d `] THEN NHANH (NOT_VEC0_IMP_LE1) THEN PHA THEN\r
REWRITE_TAC[MESON[]` P a /\ a = b <=> a = b /\ P b `] THEN\r
SIMP_TAC[REAL_ABS_BOUNDS; acs_atn2; REAL_ARITH ` a - x =\r
a - y <=> x = y `] THEN NHANH (NOT_COLLINEAR_IMP_UPS_LT ) THEN\r
LET_TR THEN PHA THEN NHANH (MESON[REAL_LT_MUL]` &0 < x /\ a1 /\ &0 < y /\ a2 ==>\r
&0 < x * y `) THEN STRIP_TAC THEN FIRST_X_ASSUM MP_TAC THEN\r
ASM_SIMP_TAC[] THEN NHANH SQRT_POS_LT THEN\r
SIMP_TAC[MESON[POS_COMPATIBLE_WITH_ATN2]` &0 < a ==>\r
atn2 ( x, y / a ) = atn2 ( a * x , a * ( y / a ) ) `] THEN\r
SIMP_TAC[REAL_FIELD` &0 < a ==> a * ( y / a ) = y `] THEN\r
REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN\r
PHA THEN NGOAC THEN REWRITE_TAC[GSYM REAL_ABS_BOUNDS] THEN\r
ONCE_REWRITE_TAC[GSYM ABS_1] THEN\r
SIMP_TAC[REAL_LE_SQUARE_ABS; REAL_ARITH` a <= &1 <=>\r
&0 <= &1 - a `; REAL_ARITH` ( &1 ) pow 2 = &1 `; ABS_1] THEN\r
DAO THEN ONCE_REWRITE_TAC[GSYM IMP_IMP] THEN\r
SIMP_TAC[REAL_FIELD` &0 < a ==> &1 - ( b / a ) pow 2\r
= ( a pow 2 - b pow 2 ) / ( a pow 2 ) `] THEN\r
NHANH (REAL_LT_IMP_NZ) THEN NHANH (REAL_LT_IMP_LE) THEN\r
SIMP_TAC[NOT_ZERO_EQ_POW2_LT; REAL_LE_RDIV_0 ; SQRT_DIV] THEN\r
NHANH (REAL_LT_IMP_LE) THEN SIMP_TAC[SQRT_DIV; REAL_LE_POW2] THEN\r
SIMP_TAC[SQRT_DIV; REAL_LE_POW2; POW_2_SQRT; REAL_FIELD` &0 < a ==>\r
a * b / a = b `] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC\r
(MESON[]` a = b ==> atn2 ( sqrt a, c ) = atn2 ( sqrt b, c ) `) THEN\r
ASM_SIMP_TAC[SQRT_WORKS; ups_x; delta_x4; delta_x] THEN\r
REAL_ARITH_TAC);;\r
*)\r
\r
\r
\r
\r
let LEMMA16_INTERPRETE = prove(`!(v0: real^N) va vb vc.\r
~collinear {v0, vc, va} /\ ~collinear {v0, vc, vb}\r
==> cos (dihV v0 vc va vb) =\r
(cos (arcV v0 va vb) -\r
cos (arcV v0 vc vb) * cos (arcV v0 vc va)) /\r
(sin (arcV v0 vc vb) * sin (arcV v0 vc va))`,\r
MP_TAC RLXWSTK THEN REPEAT LET_TAC THEN SIMP_TAC[]);;\r
\r
\r
\r
let NOT_COLLINEAR_IMP_VEC_FOR_DIHV = ONCE_REWRITE_RULE[GSYM VECTOR_SUB_EQ]\r
(ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] ALLEMI_COLLINEAR);;\r
\r
let ACS = ACS_BOUNDS;;\r
let NOT_COLLINEAR_IMP_DIHV_BOUNDED = prove(\r
` ~( collinear {v0,v1,v2} ) /\ ~( collinear {v0,v1,v3} )\r
==> &0 <= dihV v0 v1 v2 v3 /\ dihV v0 v1 v2 v3 <= pi`,\r
REWRITE_TAC[dihV; arcV] THEN REPEAT LET_TAC THEN\r
NHANH (NOT_COLLINEAR_IMP_VEC_FOR_DIHV ) THEN\r
ASM_SIMP_TAC[VECTOR_SUB_RZERO] THEN\r
ONCE_REWRITE_TAC[MESON[]` ( a/\b) /\c /\d <=>\r
a /\c/\b/\d`] THEN NHANH (NOT_VEC0_IMP_LE1) THEN\r
SIMP_TAC[REAL_ABS_BOUNDS; ACS]) ;;\r
\r
\r
\r
let DIHV_FORMULAR = prove(` dihV v0 v1 v2 v3 = arcV (vec 0)\r
(((v1 - v0) dot (v1 - v0)) % (v2 - v0) -\r
((v2 - v0) dot (v1 - v0)) % (v1 - v0))\r
(((v1 - v0) dot (v1 - v0)) % (v3 - v0) -\r
((v3 - v0) dot (v1 - v0)) % (v1 - v0)) `, REWRITE_TAC[dihV]\r
THEN REPEAT LET_TAC THEN REWRITE_TAC[]);;\r
\r
\r
let COS_POW2_INTER = prove(` cos x pow 2 = &1 - sin x pow 2 `,\r
MP_TAC (SPEC_ALL SIN_CIRCLE) THEN REAL_ARITH_TAC);;\r
\r
(* lemma 19 *)\r
(*\r
let ISTYLPH = prove(` ! (v0:real^N) v1 v2 v3.\r
&0 <= cos (arcV (v0:real^N) v2 v3) /\\r
dihV v0 v3 v1 v2 = pi / &2 /\\r
~ collinear {v0,v1,v2} /\\r
~ collinear {v0,v1,v3} /\\r
~ collinear {v0,v2,v3} /\\r
psi = arcV v0 v2 v3 /\\r
tte = arcV v0 v1 v2 ==>\r
dihV v0 v1 v2 v3 = beta psi tte `,\r
REPEAT GEN_TAC THEN\r
ONCE_REWRITE_TAC[MESON[]` a /\ b ==> c <=>\r
a ==> b ==> c `] THEN\r
DISCH_TAC THEN\r
ONCE_REWRITE_TAC[SET_RULE` {a,b} = {b,a} `] THEN\r
REWRITE_TAC[ MESON[]` a /\ b /\ c /\ d /\ e <=>\r
a /\ b /\ (c /\ d )/\ e`] THEN\r
NHANH (LEMMA16_INTERPRETE ) THEN\r
PURE_ONCE_REWRITE_TAC[MESON[]` a = b /\ P a <=> a = b\r
/\ P b `] THEN\r
SIMP_TAC[COS_PI2] THEN\r
NHANH (NOT_COLLINEAR_IMP_NOT_SIN0) THEN\r
PHA THEN\r
ONCE_REWRITE_TAC[MESON[REAL_ENTIRE]`~( a = &0 ) /\ a1 /\ ~( b = &0 ) /\ &0 = l /\ ll\r
<=> a1 /\ ~ ( b * a = &0 ) /\ &0 = l /\ ll`] THEN\r
ONCE_REWRITE_TAC[SET_RULE` {a,b} = {b,a} `] THEN\r
ONCE_REWRITE_TAC[MESON[]`a /\ ~( aa = &0 ) /\ b /\ c <=>\r
~( aa = &0 ) /\ c /\ a /\ b `] THEN\r
ABBREV_TAC `TU = sin (arcV v0 v3 v2) * sin (arcV v0 v3 (v1:real^N))` THEN\r
ABBREV_TAC `MA = (cos (arcV v0 v1 v2) - cos (arcV v0 v3 v2) * cos (arcV v0 v3 (v1:real^N)))` THEN\r
NHANH (MESON[REAL_FIELD`~( b = &0 ) /\ a / b = &0 ==> a = &0 `]`\r
~(TU = &0) /\\r
&0 = MA / TU /\ ll ==> MA = &0 `) THEN\r
REWRITE_TAC[dihV;beta; arcV] THEN\r
REPEAT LET_TAC THEN\r
STRIP_TAC THEN\r
MATCH_MP_TAC (MESON[]` a = b ==> P a = P b `) THEN\r
REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN\r
NHANH ( NOT_COLLINEAR_IMP_VEC_FOR_DIHV ) THEN\r
ASM_SIMP_TAC[] THEN\r
PHA THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN\r
SIMP_TAC[GSYM NOT_EQ_IMPCOS_ARC] THEN\r
DOWN_TAC THEN\r
ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN\r
SIMP_TAC[] THEN\r
STRIP_TAC THEN\r
EXPAND_TAC "va" THEN\r
EXPAND_TAC "vb" THEN\r
EXPAND_TAC "vc" THEN\r
UNDISCH_TAC `vb' = v2 - (v0:real^N)` THEN\r
UNDISCH_TAC `va' = v1 - (v0:real^N)` THEN\r
UNDISCH_TAC `vc' = v3 - (v0:real^N)` THEN\r
PHA THEN SIMP_TAC[GSYM DIHV_FORMULAR] THEN\r
ASM_SIMP_TAC[LEMMA16_INTERPRETE] THEN\r
DISCH_TAC THEN\r
UNDISCH_TAC `&0 = MA ` THEN\r
ASM_SIMP_TAC[REAL_ARITH` &0 = a - b <=> a = b `; ARC_SYM;\r
REAL_ARITH` a * b * a = b * a pow 2 `] THEN\r
SIMP_TAC[COS_POW2_INTER; REAL_SUB_LDISTRIB; REAL_MUL_RID;\r
REAL_ARITH` a - ( a - b ) = b `] THEN\r
UNDISCH_TAC `~collinear {v0, v1,(v3:real^N)}` THEN\r
NHANH (NOT_COLLINEAR_IMP_NOT_SIN0) THEN\r
PHA THEN SIMP_TAC[REAL_FIELD` ~( a = &0 ) ==>\r
( b * a pow 2) / ( a * c ) = (b * a) / c `] THEN\r
UNDISCH_TAC` ~collinear {v0, v1, (v2:real^N)}` THEN\r
NHANH (NOT_COLL_IM_SIN_LT) THEN\r
NHANH (REAL_LT_IMP_LE) THEN\r
UNDISCH_TAC `&0 <= cos (arcV v0 v2 (v3:real^N))` THEN\r
PHA THEN\r
NHANH (MESON[REAL_LE_MUL; REAL_LE_DIV]`\r
&0 <= a1 /\aa /\aa1/\\r
&0 <= a3 /\aa2/\aa3/\\r
&0 <= a2 /\ lll ==> &0 <= ( a1 * a2 )/ a3 `) THEN\r
STRIP_TAC THEN\r
FIRST_X_ASSUM MP_TAC THEN\r
SIMP_TAC[MESON[POW_2_SQRT]`&0 <= a ==> ( a = b\r
<=> sqrt ( a pow 2 ) = b )`] THEN\r
STRIP_TAC THEN\r
MATCH_MP_TAC (MESON[]` a = b ==> P a = P b `) THEN\r
EXPAND_TAC "psi" THEN\r
EXPAND_TAC "tte" THEN\r
UNDISCH_TAC `va' = (vc:real^N)` THEN\r
UNDISCH_TAC `vb' = (va:real^N)` THEN\r
UNDISCH_TAC `vc' = (vb:real^N)` THEN\r
UNDISCH_TAC ` vb = v3 - v0 /\ vc = v1 - v0 /\ va = v2 - (v0 :real^N)` THEN\r
PHA THEN SIMP_TAC[GSYM arcV] THEN\r
STRIP_TAC THEN\r
SIMP_TAC[REAL_FIELD` ( a / b ) pow 2 = a pow 2 / b pow 2 `] THEN\r
MATCH_MP_TAC (MESON[]` a = b /\ aa = bb ==> a / aa\r
= b / bb `) THEN\r
SIMP_TAC[SIN_POW2_EQ_1_SUB_COS_POW2; GSYM POW_2] THEN\r
SIMP_TAC[REAL_ARITH`(A * B ) pow 2 = A pow 2 *\r
B pow 2 `; SIN_POW2_EQ_1_SUB_COS_POW2] THEN\r
ASM_SIMP_TAC[] THEN REAL_ARITH_TAC);;\r
*)\r
\r
\r
\r
\r
\r
\r
\r
\r
let INTERS_SUBSET = SET_RULE` P a ==> INTERS { x | P x } SUBSET a `;;\r
\r
let AFFINE_SET_GENERARTED2 = prove(` affine {x | ? t. x = t % u + ( &1 - t ) % v } `,\r
REWRITE_TAC[affine; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN\r
EXISTS_TAC `t * u' + (t':real) * v'` THEN FIRST_X_ASSUM MP_TAC THEN\r
SIMP_TAC[REAL_ARITH` a + b = c <=> a = c - b `] THEN\r
DISCH_TAC THEN ASM_SIMP_TAC[] THEN CONV_TAC VECTOR_ARITH);;\r
\r
let BASED_POINT2 = prove(` {(u:real^N),v} SUBSET {x | ? t. x = t % u + ( &1 - t ) % v } `,\r
SIMP_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL\r
[EXISTS_TAC ` &1 ` THEN CONV_TAC VECTOR_ARITH; EXISTS_TAC ` &0 `] THEN\r
CONV_TAC VECTOR_ARITH);;\r
\r
let AFFINE_AFF = prove(` affine ( aff s ) `,\r
SIMP_TAC[aff; AFFINE_AFFINE_HULL]);;\r
\r
let INSERT_EMPTY_SUBSET = prove(`(x INSERT s SUBSET t <=> x IN t /\ s SUBSET t)\r
/\ (!s. {} SUBSET s)`, SIMP_TAC[INSERT_SUBSET; EMPTY_SUBSET]);;\r
\r
\r
\r
let IN_P_HULL_INSERT = prove(`a IN P hull (a INSERT s)`,\r
MATCH_MP_TAC (SET_RULE` a IN A /\ A SUBSET P hull A ==> a IN P hull A `) THEN\r
SIMP_TAC[IN_INSERT; HULL_SUBSET]);;\r
\r
let UV_IN_AFF2 = MESON[INSERT_AC;IN_P_HULL_INSERT ]`\r
u IN affine hull {u,v}/\ v IN affine hull {u,v}`;;\r
\r
\r
let AFF2 = prove(` ! u (v:real^N). aff {u,v} = {x | ? t. x = t % u + ( &1 - t ) % v } `,\r
SIMP_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REPEAT STRIP_TAC THENL\r
[SIMP_TAC[aff; hull] THEN MATCH_MP_TAC (INTERS_SUBSET) THEN\r
SIMP_TAC[BASED_POINT2 ;AFFINE_SET_GENERARTED2 ];\r
SIMP_TAC[SUBSET; IN_ELIM_THM]] THEN REPEAT STRIP_TAC THEN\r
MP_TAC (MESON[AFFINE_AFF]` affine ( aff {u, (v:real^N)})`) THEN\r
ASM_SIMP_TAC[aff; affine] THEN\r
MESON_TAC[UV_IN_AFF2; REAL_RING` a + &1 - a = &1 `]);;\r
\r
\r
GEN_ALL (SPECL [`p - (v0:real^N)`;`(u:real^N) - v0 `]\r
VECTOR_SUB_PROJECT_ORTHOGONAL);;\r
\r
SPECL[` (u - (v:real^N))`;` (p:real^N)`]\r
VECTOR_SUB_PROJECT_ORTHOGONAL;;\r
\r
\r
let EXISTS_PROJECTING_POINT = prove(\r
`! (p:real^N) u v. ? pp. (u + pp ) IN aff {u,v} /\ (p - pp ) dot ( u - v ) = &0 `,\r
REPEAT STRIP_TAC THEN MP_TAC (SPECL[` (u - (v:real^N))`;` (p:real^N)`]\r
VECTOR_SUB_PROJECT_ORTHOGONAL) THEN STRIP_TAC THEN\r
EXISTS_TAC `((u - v) dot p) / ((u - v) dot (u - v)) % (u - (v:real^N))` THEN\r
ONCE_REWRITE_TAC[DOT_SYM] THEN\r
CONJ_TAC THENL [SIMP_TAC[AFF2; IN_ELIM_THM; VECTOR_ARITH` a + x % ( a - b ) =\r
(&1 + x ) % a + ( &1 - ( &1 + x )) % b `] THEN MESON_TAC[] ;\r
ASM_MESON_TAC[DOT_SYM]]);;\r
\r
\r
let UV_IN_AFF2_IMP_TRANSABLE = prove(`! v0 v1 u v.\r
u IN aff {v0,v1} /\ v IN aff {v0,v1} ==>\r
( ( u - v0 ) dot ( v1 - v0 )) * ( ( v - v0) dot ( v1 - v0 )) =\r
(( v1 - v0 ) dot ( v1 - v0 ) ) * ((u - v0 ) dot ( v - v0 )) `,\r
REPEAT GEN_TAC THEN REWRITE_TAC[AFF2; IN_ELIM_THM] THEN\r
STRIP_TAC THEN ASM_SIMP_TAC[VECTOR_ARITH`(t % v0 + (&1 - t) % v1) - v0\r
= ( &1 - t ) % ( v1 - v0 )`] THEN SIMP_TAC[DOT_LMUL; DOT_RMUL] THEN\r
REAL_ARITH_TAC);;\r
\r
let WHEN_K_POS_ARCV_STABLE = prove(` &0 < k ==>\r
arcV ( vec 0 ) u v = arcV ( vec 0 ) u ( k % v ) `,\r
REWRITE_TAC[arcV; VECTOR_SUB_RZERO; DOT_RMUL; NORM_MUL] THEN\r
SIMP_TAC[LT_IMP_ABS_REFL; REAL_FIELD`&0 < a ==> ( a * b ) /\r
( d * a * s ) = b / ( d * s ) `]);;\r
\r
\r
let ARCV_VEC0_FORM = prove(`arcV v0 u v = arcV (vec 0) (u - v0) (v - v0)`,\r
REWRITE_TAC[arcV; VECTOR_SUB_RZERO]);;\r
\r
let WHEN_K_POS_ARCV_STABLE2 = prove(` k < &0 ==>\r
arcV ( vec 0 ) u v = arcV ( vec 0 ) u ( ( -- k) % v ) `,\r
REWRITE_TAC[REAL_ARITH` n < &0 <=> &0 < -- n `;\r
WHEN_K_POS_ARCV_STABLE ]);;\r
\r
let WHEN_K_DIFF0_ARCV = prove(` ~ ( k = &0 ) ==>\r
arcV ( vec 0 ) u v = arcV ( vec 0 ) u ( ( abs k ) % v ) `,\r
REWRITE_TAC[REAL_ABS_NZ; WHEN_K_POS_ARCV_STABLE ]);;\r
\r
\r
\r
let PITHAGO_THEOREM = prove(`x dot y = &0\r
==> norm (x + y) pow 2 = norm x pow 2 + norm y pow 2 /\\r
norm (x - y) pow 2 = norm x pow 2 + norm y pow 2`,\r
SIMP_TAC[NORM_POW_2; DOT_LADD; DOT_RADD; DOT_RSUB; DOT_LSUB; DOT_SYM] THEN\r
REAL_ARITH_TAC);;\r
\r
\r
let NORM_SUB_INVERTABLE = NORM_ARITH` norm (x - y) = norm (y - x)`;;\r
\r
\r
\r
let OTHORGONAL_WITH_COS = prove(` ! v0 v1 w (p:real^N).\r
~(v0 = w) /\\r
~(v0 = v1) /\\r
(w - p) dot (v1 - v0) = &0\r
==> cos (arcV v0 v1 w) =\r
((p - v0) dot (v1 - v0)) / (norm (v1 - v0) * norm (w - v0))`,\r
REPEAT GEN_TAC THEN SIMP_TAC[NOT_EQ_IMPCOS_ARC] THEN\r
REPEAT STRIP_TAC THEN\r
MATCH_MP_TAC (MESON[]` a = b ==> a / c = b / c `) THEN\r
ONCE_REWRITE_TAC[REAL_RING` a = b <=> a - b = &0 `] THEN\r
ONCE_REWRITE_TAC[MESON[DOT_SYM]` a dot b - c = b dot a - c `] THEN\r
FIRST_X_ASSUM MP_TAC THEN SIMP_TAC[GSYM DOT_LSUB; VECTOR_ARITH`\r
w - v0 - (p - v0) = w - (p:real^N)`; REAL_SUB_RZERO; DOT_SYM]);;\r
\r
\r
let SIMPLIZE_COS_IF_OTHOR = prove(` ! v0 v1 w (p:real^N).\r
~(v0 = w) /\\r
~(v0 = v1) /\ ( p - v0 ) = k % (v1 - v0 ) /\\r
(w - p) dot (v1 - v0) = &0\r
==> cos (arcV v0 v1 w) =\r
k * norm ( v1 - v0 ) / norm (w - v0) `,\r
SIMP_TAC[OTHORGONAL_WITH_COS; DOT_LMUL; GSYM NORM_POW_2] THEN\r
REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN\r
ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN REWRITE_TAC[GSYM NORM_POS_LT]\r
THEN CONV_TAC REAL_FIELD);;\r
\r
\r
let SIN_EQ_SQRT_ONE_SUB = prove(` ~((v0:real^N) = va) /\ ~(v0 = vb) ==>\r
sin ( arcV v0 va vb ) = sqrt ( &1 - cos ( arcV v0 va vb ) pow 2 ) `,\r
DISCH_TAC THEN MATCH_MP_TAC (SIN_COS_SQRT) THEN ASM_SIMP_TAC[PROVE_SIN_LE]);;\r
\r
\r
\r
let SIN_DI_HOC = prove(`~((v0:real^N) = w) /\ ~(v0 = vb) /\ p IN aff {v0, w} /\ (p - vb) dot (w - v0) = &0\r
==> sin (arcV v0 w vb) = norm (p - vb) / norm (vb - v0)`,\r
SIMP_TAC[SIN_EQ_SQRT_ONE_SUB] THEN ONCE_REWRITE_TAC[REAL_ARITH` a = &0 <=> -- a = &0 `] THEN\r
SIMP_TAC[GSYM DOT_LNEG; VECTOR_NEG_SUB; OTHORGONAL_WITH_COS] THEN\r
SIMP_TAC[AFF2; IN_ELIM_THM; VECTOR_ARITH` p = t % v0 + (&1 - t) % w\r
<=> p - v0 = (&1 - t ) % ( w - v0 ) `] THEN\r
STRIP_TAC THEN ASM_SIMP_TAC[DOT_LMUL; GSYM NORM_POW_2] THEN\r
ONCE_REWRITE_TAC[MESON[REAL_LE_DIV; POW_2_SQRT; NORM_POS_LE]`\r
norm a / norm b = sqrt (( norm a / norm b ) pow 2 ) `] THEN\r
MATCH_MP_TAC (MESON[]` a = b ==> p a = p b `) THEN\r
UNDISCH_TAC` ~(v0 = (w:real^N))` THEN UNDISCH_TAC`~(v0 = (vb:real^N))` THEN\r
ONCE_REWRITE_TAC[VECTOR_ARITH` a = b <=> (b:real^N) - a = vec 0 `] THEN\r
SIMP_TAC[ GSYM NORM_POS_LT; REAL_FIELD` &0 < a ==>\r
( c * a pow 2 ) / ( a * b ) = (c * a )/ b /\\r
&1 - ( b / a ) pow 2 = ( a pow 2 - b pow 2 ) / a pow 2 `] THEN\r
REPEAT STRIP_TAC THEN SIMP_TAC[DIV_POW2] THEN\r
MATCH_MP_TAC (MESON[]` a = b ==> a / x = b / x `) THEN\r
SIMP_TAC[MUL_POW2] THEN ONCE_REWRITE_TAC[MESON[REAL_POW2_ABS]`\r
a pow 2 * t = ( abs a ) pow 2 * t`] THEN\r
SIMP_TAC[GSYM MUL_POW2; GSYM NORM_MUL] THEN DOWN_TAC THEN\r
ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN SIMP_TAC[] THEN\r
NHANH (MESON[]` a = b ==> ( vb - (p:real^N)) dot a\r
= ( vb - (p:real^N)) dot b `) THEN\r
REWRITE_TAC[DOT_RMUL; MESON[]` ( a /\ x * t = c ) /\\r
&0 = t /\ l <=> a /\ c = x * ( &0 ) /\ t = &0 /\ l `;\r
REAL_MUL_RZERO] THEN NHANH (PITHAGO_THEOREM) THEN\r
SIMP_TAC[VECTOR_ARITH` vb - p + p - v0 = vb - (v0:real^N)`] THEN\r
STRIP_TAC THEN SIMP_TAC[NORM_SUB] THEN REAL_ARITH_TAC );;\r
\r
\r
let CHANG_BIET_GI = prove(`pu - p = (&1 - t) % (w - p) ==> pu IN aff {p, w}`,\r
REWRITE_TAC[AFF2; IN_ELIM_THM; VECTOR_ARITH`pu - p = (&1 - t) % (w - p) <=>\r
pu = t % p + ( &1 - t ) % w `] THEN MESON_TAC[]);;\r
\r
\r
let SUB_DOT_EQ_0_INVERTALE = prove(` ( a - b ) dot c = &0 <=> ( b - a ) dot c = &0 `,\r
SIMP_TAC[DOT_LSUB] THEN REAL_ARITH_TAC);;\r
\r
\r
let SIN_DI_HOC2 = ONCE_REWRITE_RULE[SUB_DOT_EQ_0_INVERTALE] SIN_DI_HOC;;\r
\r
\r
\r
let KEY_LEMMA_FOR_ANGLES = prove(`! (p:real^N) u v w pu pv. pu IN aff {p,w} /\ pv IN aff {p,w} /\\r
( u - pu ) dot (w - p ) = &0 /\\r
( v - pv ) dot (w - p ) = &0 /\\r
~( p = u \/ p = v \/ p = w ) ==>\r
cos ( arcV p w u + arcV p w v ) - cos ( arcV p u v ) =\r
(-- ( v - pv ) dot ( u - pu ) - norm ( v - pv ) * norm ( u - pu )) /\r
(norm ( p - u ) * norm ( p - v ))`,\r
SIMP_TAC[COS_ADD; AFF2; IN_ELIM_THM; VECTOR_ARITH` pu = t % p + (&1 - t) % w <=> pu - p = ( &1 - t ) % (w - p ) `;\r
DE_MORGAN_THM] THEN\r
REPEAT STRIP_TAC THEN\r
DOWN_TAC THEN\r
NHANH (MESON[SIMPLIZE_COS_IF_OTHOR]` pu - p = (&1 - t) % (w - p) /\\r
pv - p = (&1 - t') % (w - p) /\\r
(u - pu) dot (w - p) = &0 /\\r
(v - pv) dot (w - p) = &0 /\\r
~(p = u) /\\r
~(p = v) /\\r
~(p = w) ==> cos (arcV p w u) =\r
(&1 - t ) * norm (w - p) / norm (u - p) /\\r
cos (arcV p w v) =\r
( &1 - t') * norm (w - p ) / norm ( v - p ) `) THEN\r
NHANH (CHANG_BIET_GI) THEN\r
NHANH (MESON[SIN_DI_HOC2]`(a11 /\ pu IN aff {p, w}) /\\r
(a22 /\ pv IN aff {p, w}) /\\r
(u - pu) dot (w - p) = &0 /\\r
(v - pv) dot (w - p) = &0 /\\r
~(p = u) /\\r
~(p = v) /\\r
~(p = w) ==>\r
sin (arcV p w u) = norm ( pu - u ) / norm ( u - p ) /\\r
sin (arcV p w v) = norm ( pv - v ) / norm ( v - p ) `) THEN\r
STRIP_TAC THEN\r
ASM_SIMP_TAC[NOT_EQ_IMPCOS_ARC; REAL_FIELD` a / b * aa / bb\r
= ( a * aa ) / ( b * bb ) `; REAL_RING` (a * b ) * c * d = a * c * b * d `;\r
REAL_FIELD` a * b / c = ( a * b ) / c `; REAL_FIELD ` a / b - c / b\r
= ( a - c ) / b `; NORM_SUB] THEN\r
MATCH_MP_TAC (MESON[]` a = b ==> a / x = b / x `) THEN\r
SIMP_TAC[NORM_SUB; REAL_MUL_SYM; REAL_ARITH` a - b - c = v - b <=>\r
a - c - v = &0 `] THEN\r
REWRITE_TAC[MESON[VECTOR_ARITH` a - b = a - x + x - (b:real^N)`]`\r
a - (u - p) dot (v - p) = a - (u - pu + pu - p) dot (v - pv + pv - p) `;\r
DOT_LADD; DOT_RADD] THEN\r
ASM_SIMP_TAC[DOT_LMUL; DOT_RMUL; DOT_SYM; REAL_MUL_RZERO;\r
REAL_ADD_RID; GSYM NORM_POW_2; GSYM POW_2; NORM_SUB;DOT_LNEG;\r
REAL_ADD_LID] THEN REAL_ARITH_TAC);;\r
\r
\r
\r
\r
\r
let ARCV_BOUNDED = prove(` ~( v0 = u ) /\ ~ ( v0 = v ) ==>\r
&0 <= arcV v0 u v /\ arcV v0 u v <= pi`,\r
NHANH (NOT_IDEN_IMP_ABS_LE) THEN REWRITE_TAC[arcV; REAL_ABS_BOUNDS]\r
THEN SIMP_TAC[ACS_BOUNDS]);;\r
\r
\r
(* This lemma in Multivariate/transc.ml\r
let COS_MONO_LT_EQ = new_axiom\r
`!x y. &0 <= x /\ x <= pi /\ &0 <= y /\ y <= pi\r
==> (cos(x) < cos(y) <=> y < x)`;;\r
*)\r
\r
\r
let COS_MONOPOLY = prove(\r
` ! a b. &0 <= a /\ a <= pi /\ &0 <= b /\ b <= pi ==>\r
( a < b <=> cos b < cos a ) `, MESON_TAC[COS_MONO_LT_EQ]);;\r
\r
let COS_MONOPOLY_EQ = prove(\r
` ! a b. &0 <= a /\ a <= pi /\ &0 <= b /\ b <= pi ==>\r
( a <= b <=> cos b <= cos a ) `,\r
REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT]\r
THEN ASM_MESON_TAC[COS_MONOPOLY ]);;\r
\r
\r
let END_POINT_ADD_IN_AFF2 = prove(`!k (u:real^N) v. u + k % (u - v) IN aff {u, v} /\\r
u + k % (v - u ) IN aff {u,v} `,\r
REWRITE_TAC[AFF2; VECTOR_ARITH` u + k % (u - v) =\r
( &1 + k ) % u + ( &1 - ( &1 + k )) % v `] THEN\r
SIMP_TAC[VECTOR_ARITH` u + k % (v - u) =\r
(&1 - k) % u + (&1 - (&1 - k)) % v`] THEN SET_TAC[]);;\r
\r
let EXISTS_PROJECTING_POINT2 = prove(`!(p:real^N) u v0 . ?pp. pp IN aff {u, v0} /\ (p - pp) dot (u - v0) = &0`,\r
REPEAT GEN_TAC THEN MP_TAC (SPECL[` u - (v0:real^N) `; `p - ( v0 :real^N)`]\r
VECTOR_SUB_PROJECT_ORTHOGONAL) THEN\r
SIMP_TAC[DOT_SYM; VECTOR_ARITH` a - b - c = a - ( b + (c:real^N))`] THEN\r
ONCE_REWRITE_TAC[INSERT_AC] THEN MESON_TAC[END_POINT_ADD_IN_AFF2 ]);;\r
\r
\r
let KEY_LEMMA_FOR_ANGLES1 =\r
ONCE_REWRITE_RULE[ INSERT_AC] KEY_LEMMA_FOR_ANGLES;;\r
\r
SPECL[`p:real^N`; `u:real^N`; `v:real^N`;`x:real^N`;`ux:real^N`;`vx:real^N`]\r
KEY_LEMMA_FOR_ANGLES1;;\r
\r
let ARCV_INEQUALTY = prove(`! p u v (x:real^N). ~ ( p = x ) /\ ~( p = u ) /\ ~( p = v ) ==>\r
arcV p u v <= arcV p u x + arcV p x v `,\r
NHANH (ARCV_BOUNDED) THEN\r
REPEAT GEN_TAC THEN\r
ASM_CASES_TAC` pi <= arcV p u x + arcV p x (v:real^N)` THENL\r
[ASM_MESON_TAC[REAL_LE_TRANS];\r
PHA THEN\r
NHANH (MESON[ARCV_BOUNDED ]`~(p = x) /\ ~(p = u) /\ ~(p = v) /\ l\r
==> &0 <= arcV p u x /\ &0 <= arcV p x v `) THEN\r
NHANH (REAL_LE_ADD) THEN\r
DOWN_TAC THEN\r
NHANH (REAL_ARITH` ~(a <= b ) ==> b <= a `) THEN\r
SIMP_TAC[COS_MONOPOLY_EQ ] THEN\r
MP_TAC (MESON[EXISTS_PROJECTING_POINT2]` ? (ux:real^N) vx.\r
ux IN aff {x,p} /\ vx IN aff {x,p} /\\r
( u - ux ) dot (x - p ) = &0 /\\r
( v - vx ) dot ( x - p ) = &0 `) THEN\r
REPEAT STRIP_TAC THEN\r
DOWN_TAC THEN\r
REWRITE_TAC[MESON[]` ux IN aff {x, p} /\\r
vx IN aff {x, p} /\\r
(u - ux) dot (x - p) = &0 /\\r
(v - vx) dot (x - p) = &0 /\a11/\a22 /\\r
~(p = x) /\\r
~(p = u) /\\r
~(p = v) /\ l <=> a11 /\ a22 /\ l /\ ux IN aff {x, p} /\\r
vx IN aff {x, p} /\\r
(u - ux) dot (x - p) = &0 /\\r
(v - vx) dot (x - p) = &0 /\\r
~(p = u \/ p = v \/ p = x) `] THEN\r
NHANH (SPECL[`p:real^N`; `u:real^N`; `v:real^N`;`x:real^N`;`ux:real^N`;`vx:real^N`]\r
KEY_LEMMA_FOR_ANGLES1) THEN\r
ONCE_REWRITE_TAC[REAL_ARITH` a <= b <=> a - b <= &0 `] THEN\r
SIMP_TAC[ARC_SYM; DE_MORGAN_THM] THEN\r
ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN\r
SIMP_TAC[GSYM NORM_POS_LT; REAL_FIELD` a / ( b * c ) = ( a / b) / c `] THEN\r
SIMP_TAC[REAL_ARITH` (a/ b ) / c <= &0 <=> &0 <= (( -- a ) / b ) / c `;\r
REAL_LE_RDIV_0] THEN\r
STRIP_TAC THEN\r
REWRITE_TAC[REAL_ARITH`&0 <= -- ( a - b ) <=> a <= b `] THEN\r
MESON_TAC[NORM_NEG; NORM_CAUCHY_SCHWARZ]]);;\r
\r
let KEITDWB = ARCV_INEQUALTY;;\r
(* June *)\r
\r
(*\r
g `! (p:real^N) (n:num) fv.\r
2 <= n /\ (!i. i <= n ==> ~(p = fv i))\r
==> arcV p (fv 0) (fv n) <=\r
sum (0..n - 1) (\i. arcV p (fv i) (fv (i + 1)))`;;\r
\r
e (GEN_TAC);;\r
e (INDUCT_TAC);;\r
e (SIMP_TAC[ARITH_RULE` ~( 2 <= 0 ) `]);;\r
e (SPEC_TAC (`n:num`,` a:num`));;\r
e (INDUCT_TAC);;\r
e (SIMP_TAC[ONE; ARITH_RULE` ~(2 <= SUC 0) `]);;\r
e (SPEC_TAC(`a:num`,`u:num`));;\r
e (INDUCT_TAC);;\r
e (SIMP_TAC[ARITH_RULE` 2 <= 2 `;ARITH_RULE `SUC ( SUC 0 ) = 2 ` ]);;\r
e (SIMP_TAC[ARITH_RULE` 0 < 1 /\ 2 - 1 = 1 `;ARITH_RULE` 0 <= 1 `; SUM_CLAUSES_RIGHT]);;\r
e (SIMP_TAC[SUB_REFL; SUM_SING_NUMSEG; ADD; ARITH_RULE` 1 + 1 = 2 `; ARITH_RULE` i <= 2 <=> i = 0 \/ i = 1 \/ i = 2 `]);;\r
e (SIMP_TAC[MESON[]` (! a. a = x \/ a = y \/ a = z ==> Q a ) <=> Q x /\ Q y /\ Q z `]);;\r
e (MP_TAC ARCV_INEQUALTY );;\r
e (SIMP_TAC[IN_INSERT; NOT_IN_EMPTY]);;\r
e (GEN_TAC);;\r
e (MP_TAC (ARITH_RULE` 2 <= SUC ( SUC u )`));;\r
e (ABBREV_TAC ` ed = ( SUC (SUC u ))`);;\r
e (REWRITE_TAC[ADD1; ARITH_RULE` a <= b + 1 <=> a <= b \/ a = b + 1 `; MESON[]` (! x. p x \/ x = a ==> h x ) <=> (! x. p x ==> h x ) /\ h a `]);;\r
e (PHA);;\r
e (ONCE_REWRITE_TAC[MESON[]` a /\ b/\ c/\ d <=> b /\ d /\ a /\ c `]);;\r
e (REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC));;\r
e (PHA);;\r
e (NHANH (MESON[]`(!fv. 2 <= ed /\ (!i. i <= ed ==> ~(p = fv i)) ==> Q fv) /\a1 /\a2 /\a3 /\ 2 <= ed /\ (!i. i <= ed ==> ~(p = fv i)) ==> Q fv `));;\r
e (NHANH (ARITH_RULE` 2 <= d ==> 0 < d - 1 + 1 /\ 0 <= d - 1 + 1 `));;\r
e (SIMP_TAC[ARITH_RULE` 2 <= a ==> ( a + 1 ) - 1 = a - 1 + 1 `; SUM_CLAUSES_RIGHT]);;\r
e (ASM_SIMP_TAC[ARITH_RULE` (ed - 1 + 1) - 1 = ed - 1 `]);;\r
e (SIMP_TAC[ARITH_RULE` 2 <= d ==> d - 1 + 1 = d `]);;\r
e (PHA);;\r
e (REWRITE_TAC[MESON[ARITH_RULE` 2 = ed + 1 ==> ~( 2 <= ed ) `]` ( a \/ 2 = ed + 1) /\ aa /\ 2 <= ed /\ ll <=> a /\ aa /\ 2 <= ed /\ ll `]);;\r
e (STRIP_TAC THEN FIRST_X_ASSUM MP_TAC);;\r
e (MATCH_MP_TAC (REAL_ARITH` a <= b + c ==> b <= x ==> a <= x + c `));;\r
e (FIRST_X_ASSUM MP_TAC);;\r
e (NHANH (MESON[LE_REFL; LE_0]` (! i. i <= d ==> p i ) ==> p ( 0 ) /\ p ( d ) `));;\r
e (MP_TAC (ARCV_INEQUALTY));;\r
e (ASM_SIMP_TAC[IN_INSERT; NOT_IN_EMPTY]);;\r
\r
let FGNMPAV = top_thm();;\r
*)\r
\r
let FGNMPAV = prove_by_refinement(\r
`! (p:real^N) (n:num) fv.\r
2 <= n /\ (!i. i <= n ==> ~(p = fv i))\r
==> arcV p (fv 0) (fv n) <=\r
sum (0..n - 1) (\i. arcV p (fv i) (fv (i + 1)))`,\r
  (* {{{ proof *)\r
  [\r
  (GEN_TAC);\r
  (INDUCT_TAC);\r
    BY((SIMP_TAC[ARITH_RULE` ~( 2 <= 0 ) `]));\r
  (SPEC_TAC (`n:num`,` a:num`));\r
  (INDUCT_TAC);\r
    BY((SIMP_TAC[ONE; ARITH_RULE` ~(2 <= SUC 0) `]));\r
  (SPEC_TAC(`a:num`,`u:num`));\r
  (INDUCT_TAC);\r
    (SIMP_TAC[ARITH_RULE` 2 <= 2 `;ARITH_RULE `SUC ( SUC 0 ) = 2 ` ]);\r
    (SIMP_TAC[ARITH_RULE` 0 < 1 /\ 2 - 1 = 1 `;ARITH_RULE` 0 <= 1 `; SUM_CLAUSES_RIGHT]);\r
    (SIMP_TAC[SUB_REFL; SUM_SING_NUMSEG; ADD; ARITH_RULE` 1 + 1 = 2 `; ARITH_RULE` i <= 2 <=> i = 0 \/ i = 1 \/ i = 2 `]);\r
    (SIMP_TAC[MESON[]` (! a. a = x \/ a = y \/ a = z ==> Q a ) <=> Q x /\ Q y /\ Q z `]);\r
    (MP_TAC ARCV_INEQUALTY );\r
    BY((SIMP_TAC[IN_INSERT; NOT_IN_EMPTY]));\r
  (GEN_TAC);\r
  (MP_TAC (ARITH_RULE` 2 <= SUC ( SUC u )`));\r
  (ABBREV_TAC ` ed = ( SUC (SUC u ))`);\r
  (REWRITE_TAC[ADD1; ARITH_RULE` a <= b + 1 <=> a <= b \/ a = b + 1 `; MESON[]` (! x. p x \/ x = a ==> h x ) <=> (! x. p x ==> h x ) /\ h a `]);\r
  (PHA);\r
  (ONCE_REWRITE_TAC[MESON[]` a /\ b/\ c/\ d <=> b /\ d /\ a /\ c `]);\r
  (REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC));\r
  (PHA);\r
  (NHANH (MESON[]`(!fv. 2 <= ed /\ (!i. i <= ed ==> ~(p = fv i)) ==> Q fv) /\a1 /\a2 /\a3 /\ 2 <= ed /\ (!i. i <= ed ==> ~(p = fv i)) ==> Q fv `));\r
  (NHANH (ARITH_RULE` 2 <= d ==> 0 < d - 1 + 1 /\ 0 <= d - 1 + 1 `));\r
  (SIMP_TAC[ARITH_RULE` 2 <= a ==> ( a + 1 ) - 1 = a - 1 + 1 `; SUM_CLAUSES_RIGHT]);\r
  (ASM_SIMP_TAC[ARITH_RULE` (ed - 1 + 1) - 1 = ed - 1 `]);\r
  (SIMP_TAC[ARITH_RULE` 2 <= d ==> d - 1 + 1 = d `]);\r
  (PHA);\r
  (REWRITE_TAC[MESON[ARITH_RULE` 2 = ed + 1 ==> ~( 2 <= ed ) `]` ( a \/ 2 = ed + 1) /\ aa /\ 2 <= ed /\ ll <=> a /\ aa /\ 2 <= ed /\ ll `]);\r
  (STRIP_TAC THEN FIRST_X_ASSUM MP_TAC);\r
  (MATCH_MP_TAC (REAL_ARITH` a <= b + c ==> b <= x ==> a <= x + c `));\r
  (FIRST_X_ASSUM MP_TAC);\r
  (NHANH (MESON[LE_REFL; LE_0]` (! i. i <= d ==> p i ) ==> p ( 0 ) /\ p ( d ) `));\r
  (MP_TAC (ARCV_INEQUALTY));\r
  BY((ASM_SIMP_TAC[IN_INSERT; NOT_IN_EMPTY]))\r
  ]);;\r
  (* }}} *)\r
\r
let IMP_TAC = ONCE_REWRITE_TAC[MESON[]` a/\ b ==> c\r
<=> a ==> b ==> c `];;\r
\r
(*\r
g ` &0 <= t12 /\ t12 < &2 * pi /\ t12 = &2 * pi * real_of_int k12\r
==> t12 = &0 `;;\r
\r
e (ASM_CASES_TAC` (k12:int) < &0 `);;\r
e (MP_TAC (PI_POS));;\r
e (DOWN_TAC);;\r
e (SIMP_TAC[GSYM REAL_NEG_GT0; int_lt; int_of_num_th]);;\r
e (NGOAC THEN NHANH (REAL_LT_MUL));;\r
e (REWRITE_TAC[REAL_ARITH` &0 < -- a * b <=> &2 * b * a < &0 `]);;\r
e (MESON_TAC[REAL_ARITH` ~( a < &0 /\ &0 <= a ) `]);;\r
e (ASM_CASES_TAC `(k12:int) = &0 `);;\r
e (ASM_SIMP_TAC[int_of_num_th; REAL_MUL_RZERO]);;\r
e (DOWN_TAC);;\r
e (NGOAC);;\r
e (REWRITE_TAC[ARITH_RULE` ~(k12 < &0) /\ ~((k12:int) = &0) <=> &1 <= k12 `]);;\r
e (SIMP_TAC[int_le; int_of_num_th]);;\r
e (MP_TAC PI_POS);;\r
e (PHA);;\r
e (ONCE_REWRITE_TAC[MESON[REAL_LE_LMUL_EQ]` &0 < pi /\ &1 <= aa /\ l <=> &0 < pi /\ pi * &1 <= pi * aa /\ l `]);;\r
e (REWRITE_TAC[REAL_ARITH` a * &1 <= b <=> &2 * a <= &2 * b `]);;\r
e (MESON_TAC[REAL_ARITH` ~( a < b /\ b <= a ) `]);;\r
\r
let IN_A_PERIOD_IDE0 = top_thm();;\r
*)\r
\r
let IN_A_PERIOD_IDE0 = prove_by_refinement(\r
` &0 <= t12 /\ t12 < &2 * pi /\ t12 = &2 * pi * real_of_int k12\r
==> t12 = &0 `,\r
  (* {{{ proof *)\r
  [\r
  (ASM_CASES_TAC` (k12:int) < &0 `);\r
    (MP_TAC (PI_POS));\r
    (DOWN_TAC);\r
    (SIMP_TAC[GSYM REAL_NEG_GT0; int_lt; int_of_num_th]);\r
    (NGOAC THEN NHANH (REAL_LT_MUL));\r
    (REWRITE_TAC[REAL_ARITH` &0 < -- a * b <=> &2 * b * a < &0 `]);\r
    BY((MESON_TAC[REAL_ARITH` ~( a < &0 /\ &0 <= a ) `]));\r
  (ASM_CASES_TAC `(k12:int) = &0 `);\r
    BY((ASM_SIMP_TAC[int_of_num_th; REAL_MUL_RZERO]));\r
  (DOWN_TAC);\r
  (NGOAC);\r
  (REWRITE_TAC[ARITH_RULE` ~(k12 < &0) /\ ~((k12:int) = &0) <=> &1 <= k12 `]);\r
  (SIMP_TAC[int_le; int_of_num_th]);\r
  (MP_TAC PI_POS);\r
  (PHA);\r
  (ONCE_REWRITE_TAC[MESON[REAL_LE_LMUL_EQ]` &0 < pi /\ &1 <= aa /\ l <=> &0 < pi /\ pi * &1 <= pi * aa /\ l `]);\r
  (REWRITE_TAC[REAL_ARITH` a * &1 <= b <=> &2 * a <= &2 * b `]);\r
  BY((MESON_TAC[REAL_ARITH` ~( a < b /\ b <= a ) `]))\r
  ]);;\r
  (* }}} *)\r
\r
\r
\r
let UNIQUE_PROPERTY_IN_A_PERIOD = prove(\r
`&0 <= t12 /\ t12 < &2 * pi /\ &0 <= a /\ a < &2 * pi /\\r
t12 = a + &2 * pi * real_of_int k12 ==> t12 = a `,\r
NHANH (REAL_FIELD` &0 <= t12 /\\r
t12 < &2 * pi /\\r
&0 <= a /\\r
a < &2 * pi /\ ll ==> t12 + -- a < &2 * pi /\\r
-- ( t12 + -- a ) < &2 * pi `) THEN\r
ASM_CASES_TAC` &0 <= t12 + -- a ` THENL [\r
REWRITE_TAC[REAL_ARITH` a = b + c <=> a + -- b = c `] THEN\r
STRIP_TAC THEN\r
ONCE_REWRITE_TAC[REAL_ARITH` a = b <=> a + -- b = &0 `] THEN\r
DOWN_TAC THEN\r
MESON_TAC[IN_A_PERIOD_IDE0 ];\r
SIMP_TAC[REAL_ARITH` a = b + c * d * e <=>\r
-- ( a + -- b ) = c * d * ( -- e ) `; GSYM int_neg_th] THEN\r
STRIP_TAC THEN\r
ONCE_REWRITE_TAC[REAL_ARITH` a = b <=> -- ( a + -- b ) = &0 `] THEN\r
DOWN_TAC THEN\r
NHANH (REAL_ARITH` ~(&0 <= b ) ==> &0 <= -- b `) THEN\r
MESON_TAC[IN_A_PERIOD_IDE0 ]]);;\r
\r
\r
(*\r
g `!t1 t2 k12 k21.\r
&0 <= t1 /\\r
t1 < &2 * pi /\\r
&0 <= t2 /\\r
t2 < &2 * pi /\\r
&0 <= t12 /\\r
t12 < &2 * pi /\\r
&0 <= t21 /\\r
t21 < &2 * pi /\\r
t12 = t1 - t2 + &2 * pi * real_of_int k12 /\\r
t21 = t2 - t1 + &2 * pi * real_of_int k21\r
==> (t1 = t2 ==> t12 + t21 = &0) /\ (~(t1 = t2) ==> t12 + t21 = &2 * pi)`;;\r
\r
e (REPEAT STRIP_TAC);;\r
e (DOWN_TAC);;\r
e (DAO);;\r
e (IMP_TAC);;\r
e (SIMP_TAC[REAL_SUB_REFL; REAL_ADD_LID; REAL_ADD_RID]);;\r
e (NHANH (MESON[IN_A_PERIOD_IDE0]` t21 = &2 * pi * real_of_int k21 /\ t12 = &2 * pi * real_of_int k12 /\ t21 < &2 * pi /\ &0 <= t21 /\ t12 < &2 * pi /\ &0 <= t12 /\ l ==> &0 = t12 /\ &0 = t21 `));;\r
e (ONCE_REWRITE_TAC[EQ_SYM_EQ]);;\r
e (SIMP_TAC[REAL_ADD_LID]);;\r
 \r
e (DOWN_TAC);;\r
e (SPEC_TAC(`t1:real`,` t1:real`));;\r
e (SPEC_TAC(`t2:real`,` t2:real`));;\r
e (SPEC_TAC(`t12:real`,` t12:real`));;\r
e (SPEC_TAC(`t21:real`,` t21:real`));;\r
e (SPEC_TAC(`k12:int`,` k12:int`));;\r
e (SPEC_TAC(`k21:int`,` k21:int`));;\r
e (MATCH_MP_TAC (MESON[REAL_ARITH` a <= b \/ b <= a `]` (! a1 b1 a2 b2 a b. P a1 b1 a2 b2 a b <=> P b1 a1 b2 a2 b a ) /\ (! a2 b2. L a2 b2 <=> L b2 a2 ) /\ (! a1 b1 a2 b2 a b. P a1 b1 a2 b2 a b /\ a <= (b:real) ==> L a2 b2 ) ==> (! a1 b1 a2 b2 a b. P a1 b1 a2 b2 a b ==> L a2 b2 ) `));;\r
e (CONJ_TAC);;\r
e (MESON_TAC[]);;\r
 e (CONJ_TAC);;\r
e (SIMP_TAC[REAL_ADD_SYM]);;\r
e (NHANH (REAL_FIELD` &0 <= t1 /\ t1 < &2 * pi /\ &0 <= t2 /\ t2 < &2 * pi /\ &0 <= t12 /\ t12 < &2 * pi /\ l ==> t1 - t2 < &2 * pi`));;\r
e (REPEAT STRIP_TAC);;\r
e (REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC));;\r
e (ONCE_REWRITE_TAC[REAL_ARITH` a <= b <=> &0 <= b - a `]);;\r
e (PHA);;\r
e (ONCE_REWRITE_TAC[GSYM REAL_SUB_0]);;\r
e (NHANH (REAL_FIELD` ~( t2 = &0) /\ t2 < pp /\ &0 <= t2 ==> &0 <= pp - t2 /\ pp - t2 < pp `));;\r
e (FIRST_X_ASSUM MP_TAC);;\r
e (ONCE_REWRITE_TAC[REAL_ARITH` a - b + &2* pi * c = &2 * pi - ( b - a ) + &2 * pi * ( c - &1 ) `]);;\r
e (ABBREV_TAC ` ttt = &2 * pi - (t1 - t2)`);;\r
e (ONCE_REWRITE_TAC[MESON[int_of_num_th]` &1 = real_of_int (&1)`]);;\r
e (DOWN_TAC);;\r
e (REWRITE_TAC[GSYM int_sub_th]);;\r
e (NHANH (MESON[UNIQUE_PROPERTY_IN_A_PERIOD]` &0 <= t12 /\ t12 < &2 * pi /\ &0 <= t21 /\ t21 < &2 * pi /\ t12 = t1 - t2 + &2 * pi * real_of_int k12 /\ &2 * pi - (t1 - t2) = ttt /\ t21 = ttt + &2 * pi * real_of_int (k21 - &1) /\ ~(t1 - t2 = &0) /\ t1 - t2 < &2 * pi /\ &0 <= t1 - t2 /\ &0 <= ttt /\ ttt < &2 * pi ==> t1 - t2 = t12 /\ ttt = t21 `));;\r
e (ONCE_REWRITE_TAC[EQ_SYM_EQ]);;\r
e (SIMP_TAC[]);;\r
e (STRIP_TAC);;\r
e (CONV_TAC REAL_RING);;\r
\r
let PDPFQUK = top_thm();;\r
*)\r
\r
let PDPFQUK  = prove_by_refinement(\r
`!t1 t2 k12 k21.\r
&0 <= t1 /\\r
t1 < &2 * pi /\\r
&0 <= t2 /\\r
t2 < &2 * pi /\\r
&0 <= t12 /\\r
t12 < &2 * pi /\\r
&0 <= t21 /\\r
t21 < &2 * pi /\\r
t12 = t1 - t2 + &2 * pi * real_of_int k12 /\\r
t21 = t2 - t1 + &2 * pi * real_of_int k21\r
==> (t1 = t2 ==> t12 + t21 = &0) /\ (~(t1 = t2) ==> t12 + t21 = &2 * pi)`,\r
  (* {{{ proof *)\r
  [\r
  (REPEAT STRIP_TAC);\r
    (DOWN_TAC);\r
    (DAO);\r
    (IMP_TAC);\r
    (SIMP_TAC[REAL_SUB_REFL; REAL_ADD_LID; REAL_ADD_RID]);\r
    (NHANH (MESON[IN_A_PERIOD_IDE0]` t21 = &2 * pi * real_of_int k21 /\ t12 = &2 * pi * real_of_int k12 /\ t21 < &2 * pi /\ &0 <= t21 /\ t12 < &2 * pi /\ &0 <= t12 /\ l ==> &0 = t12 /\ &0 = t21 `));\r
    (ONCE_REWRITE_TAC[EQ_SYM_EQ]);\r
    BY((SIMP_TAC[REAL_ADD_LID]));\r
  (DOWN_TAC);\r
  (SPEC_TAC(`t1:real`,` t1:real`));\r
  (SPEC_TAC(`t2:real`,` t2:real`));\r
  (SPEC_TAC(`t12:real`,` t12:real`));\r
  (SPEC_TAC(`t21:real`,` t21:real`));\r
  (SPEC_TAC(`k12:int`,` k12:int`));\r
  (SPEC_TAC(`k21:int`,` k21:int`));\r
  (MATCH_MP_TAC (MESON[REAL_ARITH` a <= b \/ b <= a `]` (! a1 b1 a2 b2 a b. P a1 b1 a2 b2 a b <=> P b1 a1 b2 a2 b a ) /\ (! a2 b2. L a2 b2 <=> L b2 a2 ) /\ (! a1 b1 a2 b2 a b. P a1 b1 a2 b2 a b /\ a <= (b:real) ==> L a2 b2 ) ==> (! a1 b1 a2 b2 a b. P a1 b1 a2 b2 a b ==> L a2 b2 ) `));\r
  (CONJ_TAC);\r
    BY((MESON_TAC[]));\r
   (CONJ_TAC);\r
    BY((SIMP_TAC[REAL_ADD_SYM]));\r
  (NHANH (REAL_FIELD` &0 <= t1 /\ t1 < &2 * pi /\ &0 <= t2 /\ t2 < &2 * pi /\ &0 <= t12 /\ t12 < &2 * pi /\ l ==> t1 - t2 < &2 * pi`));\r
  (REPEAT STRIP_TAC);\r
  (REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC));\r
  (ONCE_REWRITE_TAC[REAL_ARITH` a <= b <=> &0 <= b - a `]);\r
  (PHA);\r
  (ONCE_REWRITE_TAC[GSYM REAL_SUB_0]);\r
  (NHANH (REAL_FIELD` ~( t2 = &0) /\ t2 < pp /\ &0 <= t2 ==> &0 <= pp - t2 /\ pp - t2 < pp `));\r
  (FIRST_X_ASSUM MP_TAC);\r
  (ONCE_REWRITE_TAC[REAL_ARITH` a - b + &2* pi * c = &2 * pi - ( b - a ) + &2 * pi * ( c - &1 ) `]);\r
  (ABBREV_TAC ` ttt = &2 * pi - (t1 - t2)`);\r
  (ONCE_REWRITE_TAC[MESON[int_of_num_th]` &1 = real_of_int (&1)`]);\r
  (DOWN_TAC);\r
  (REWRITE_TAC[GSYM int_sub_th]);\r
  (NHANH (MESON[UNIQUE_PROPERTY_IN_A_PERIOD]` &0 <= t12 /\ t12 < &2 * pi /\ &0 <= t21 /\ t21 < &2 * pi /\ t12 = t1 - t2 + &2 * pi * real_of_int k12 /\ &2 * pi - (t1 - t2) = ttt /\ t21 = ttt + &2 * pi * real_of_int (k21 - &1) /\ ~(t1 - t2 = &0) /\ t1 - t2 < &2 * pi /\ &0 <= t1 - t2 /\ &0 <= ttt /\ ttt < &2 * pi ==> t1 - t2 = t12 /\ ttt = t21 `));\r
  (ONCE_REWRITE_TAC[EQ_SYM_EQ]);\r
  (SIMP_TAC[]);\r
  (STRIP_TAC);\r
  BY((CONV_TAC REAL_RING))\r
  ]);;\r
  (* }}} *)\r
\r
\r
(* June, 2009 *)\r
\r
\r
(* June, 2009 *)\r
let QAFHJNM = prove(`! (v:real^N) w x .\r
let e3 = ( &1 / norm ( w - v )) % (w - v ) in\r
let r = norm ( x - v ) in\r
let phi = arcV v w x in\r
~( v = x ) /\ ~ ( v = w )\r
==> (? u'. u' dot e3 = &0 /\\r
x = v + u' + ( r * cos phi ) % e3 ) `,\r
NHANH (MESON[EXISTS_PROJECTING_POINT2]`l /\ ~(v = w) ==> (?pp. (pp:real^N) IN aff {w, v}\r
/\ (x - pp) dot (w - v) = &0 ) `) THEN REPEAT STRIP_TAC THEN REPEAT LET_TAC THEN\r
SIMP_TAC[AFF2; IN_ELIM_THM; VECTOR_ARITH` pp = t % w + (&1 - t) % v <=> pp - v = t % ( w - v ) `]\r
THEN EXPAND_TAC "phi" THEN STRIP_TAC THEN EXISTS_TAC ` x - (pp:real^N)` THEN\r
REPLICATE_TAC 4 (FIRST_X_ASSUM MP_TAC) THEN PHA THEN NHANH (SIMPLIZE_COS_IF_OTHOR) THEN\r
EXPAND_TAC "e3" THEN SIMP_TAC[DOT_RMUL; REAL_MUL_RZERO; VECTOR_MUL_ASSOC] THEN\r
ONCE_REWRITE_TAC[VECTOR_ARITH` a = b <=> b - a = vec 0 `] THEN\r
SIMP_TAC[GSYM NORM_EQ_0] THEN EXPAND_TAC "r" THEN SIMP_TAC[GSYM NORM_EQ_0; REAL_FIELD`\r
~(x = &0) /\ ~(w = &0) ==> ( x * t * w / x ) * &1 / w = t `] THEN\r
SIMP_TAC[VECTOR_ARITH` (v + x - pp + tt ) - x = (tt: real^N) - (pp - v) `]);;\r
\r
(* August, 2009 *)\r
let YBXRVTS = prove(`! v w (u:real^3) x.\r
~collinear {v,w,u} /\\r
n = (w - v) cross (u - v ) /\\r
x IN aff {v,w,u} ==>\r
angle (( v + n ), v, x) = pi / &2 `,\r
REWRITE_TAC[aff;AFFINE_HULL_3; IN_ELIM_THM;angle; vector_angle] THEN\r
REPEAT STRIP_TAC THEN COND_CASES_TAC THENL [REWRITE_TAC[];\r
UNDISCH_TAC ` u' + v' + w' = &1 ` THEN\r
ASM_SIMP_TAC[VECTOR_ARITH`(a + b ) - a = (b:real^N)`; REAL_ARITH` a + b = &1 <=> a = &1 - b `;\r
VECTOR_ARITH` ((&1 - (v' + w')) % v + v' % w + w' % u) - v = v' % ( w - v ) + w' % ( u - v ) `;\r
DOT_RADD; DOT_RMUL; DOT_CROSS_SELF;REAL_MUL_RZERO ;REAL_ADD_RID; REAL_ARITH` &0 / a = &0`; PI2_EQ_ACS0]]);;\r
\r
\r
\r
(*\r
let types_thm th = let cl = concl th in\r
List.map dest_var (frees cl );;\r
\r
let seans_fn () =\r
let (tms,tm) = top_goal () in\r
let vss = map frees (tm::tms) in\r
let vs = setify (flat vss) in\r
map dest_var vs;;\r
*)\r
\r
\r
(* ========= NEW RULES and TAC TIC ============================= *)\r
(* ============================================================= *)\r
(* ============================================================= *)\r
\r
\r
let PAT_REWRITE_TAC tm thms =\r
(CONV_TAC (PAT_CONV tm (REWRITE_CONV thms )));;\r
\r
let FOR_ASM th =\r
let th1 = REWRITE_RULE[MESON[]` a /\ b ==> c <=>\r
a ==> b ==> c `] th in\r
let th2 = SPEC_ALL th1 in UNDISCH_ALL th2;;\r
\r
(* change a th having form |- A ==> t to the form A |- t\r
to get ready to some other commands\r
\r
\r
|- A ==> t\r
----------- FOR_ASM\r
A |- t\r
*)\r
\r
let ASSUME_TAC2 = ASSUME_TAC o FOR_ASM;;\r
\r
\r
let PAT_ONCE_REWRITE_TAC tm thms =\r
(CONV_TAC (PAT_CONV tm (ONCE_REWRITE_CONV thms )));;\r
\r
let ASM_PAT_RW_TAC tm thms = EVERY_ASSUM (fun th ->\r
(CONV_TAC (PAT_CONV tm (ONCE_REWRITE_CONV\r
( th ::[ thms ] )))));;\r
\r
let PAT_TH_TAC tm th =\r
(CONV_TAC (PAT_CONV tm (REWRITE_CONV[th] )));;\r
\r
(* rewurte a goal with one theorem *)\r
\r
let IMP_TO_EQ_RULE th = MATCH_MP (TAUT` (a ==> b ) ==>\r
( a <=> a /\ b )`) (SPEC_ALL th);;\r
\r
let NHANH_PAT tm th = PAT_ONCE_REWRITE_TAC tm\r
[ IMP_TO_EQ_RULE th ];;\r
\r
\r
\r
let USE_FIRST tm tac = UNDISCH_TAC tm THEN DISCH_TAC THEN\r
FIRST_ASSUM tac;;\r
\r
\r
let ONCE_SIMP_IDENT tm tth = (UNDISCH_TAC tm) THEN\r
DISCH_TAC THEN FIRST_ASSUM ( fun th ->\r
ONCE_REWRITE_TAC[(MATCH_MP tth th)] );;\r
\r
\r
let SIMP_TAC1 th = SIMP_TAC[ th];;\r
\r
let SIMP_TACC1 th = ASSUME_TAC2 th THEN FIRST_X_ASSUM\r
SIMP_TAC1;;\r
\r
let SIMP_IDENT thms tm = UNDISCH_TAC tm THEN (SIMP_TAC thms)\r
THEN DISCH_TAC;;\r
USE_FIRST;;\r
\r
\r
\r
\r
let ELIM_IDENTS th = ASSUME_TAC2 th THEN FIRST_X_ASSUM\r
( fun thh -> SIMP_TAC[ thh]);;\r
\r
(* ============================================================== *)\r
(* ============================================================== *)\r
(* ============================================================== *)\r
\r
\r
\r
\r
\r
let GIVEN_POINT_EXISTS_2_NOT_COLLINEAR = prove(` !(x:real^3). ? y z. ~ collinear {x,y,z} `,\r
GEOM_ORIGIN_TAC `x:real^3` THEN EXISTS_TAC` (vector [&1; &0; &0 ]) : real^3` THEN\r
EXISTS_TAC` (vector [&0; &1; &0 ]) : real^3` THEN\r
REWRITE_TAC[GSYM CROSS_EQ_0; cross; VECTOR_3] THEN\r
CONV_TAC REAL_RAT_REDUCE_CONV THEN\r
REWRITE_TAC[VECTOR_EQ; DOT_LZERO; DOT_3; VECTOR_3] THEN REAL_ARITH_TAC);;\r
\r
\r
let NOT_BASISES_EQ_VEC0 = prove(` ~( basis 1 = ((vec 0): real^3) \/\r
basis 2 = ((vec 0): real^3) \/ basis 3 = ((vec 0): real^3) ) `,\r
REWRITE_TAC[DE_MORGAN_THM] THEN CONJ_TAC THENL [\r
MATCH_MP_TAC BASIS_NONZERO THEN REWRITE_TAC[DIMINDEX_3] THEN ARITH_TAC; CONJ_TAC THENL [\r
MATCH_MP_TAC BASIS_NONZERO THEN REWRITE_TAC[DIMINDEX_3] THEN ARITH_TAC;\r
MATCH_MP_TAC BASIS_NONZERO THEN REWRITE_TAC[DIMINDEX_3] THEN ARITH_TAC]]);;\r
\r
\r
let TOW_DISTINCT_POINTS_EXISTS_RD_NOT_COLLINEAR = prove(\r
`! x (y: real^3). ~( x = y ) ==> (? z. ~ collinear {x,y,z} )`,\r
GEOM_ORIGIN_TAC `x:real^3` THEN GEOM_BASIS_MULTIPLE_TAC 1 `y:real^3` THEN\r
ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN\r
REPEAT STRIP_TAC THEN EXISTS_TAC ` (basis 2) :real^3` THEN\r
REWRITE_TAC[GSYM CROSS_EQ_0; CROSS_LMUL; CROSS_BASIS] THEN\r
REWRITE_TAC[VECTOR_MUL_EQ_0] THEN FIRST_X_ASSUM MP_TAC THEN\r
SIMP_TAC[REWRITE_RULE[DE_MORGAN_THM] NOT_BASISES_EQ_VEC0 ]);;\r
\r
\r
let SUBSET_IMP_SUBSET_HULL = prove(`a SUBSET b ==> a SUBSET P hull b `,\r
MATCH_MP_TAC (SET_RULE`b SUBSET P hull b ==> a SUBSET b ==> a SUBSET P hull b `) THEN\r
REWRITE_TAC[HULL_SUBSET]);;\r
\r
\r
let THREE_POINT_IMP_EXISTS_3 = prove(`! (v1:real^3) v2 v3. ? w2 w3.\r
~( collinear {v1,w2,w3} ) /\ {v1,v2,v3} SUBSET affine hull {v1,w2,w3} `,\r
REPEAT GEN_TAC THEN ASM_CASES_TAC` collinear {(v1: real^3),v2,v3} ` THENL\r
[FIRST_X_ASSUM MP_TAC THEN GEOM_ORIGIN_TAC `v1: real^3` THEN\r
REPEAT GEN_TAC THEN PAT_REWRITE_TAC `\x. x ==> _ ` [COLLINEAR_LEMMA] THEN\r
SPEC_TAC (`v3:real^3`,`v3: real^3`) THEN SPEC_TAC (`v2:real^3`,`v2: real^3`) THEN\r
MATCH_MP_TAC (MESON[]`(!a b. P a b <=> P b a) /\ (!v w. v = vec 0 \/ l v w ==> P v w)\r
==> (!v w. v = vec 0 \/ w = vec 0 \/ l v w ==> P v w)`) THEN\r
SIMP_TAC[INSERT_AC] THEN REPEAT STRIP_TAC THENL [\r
ONCE_REWRITE_TAC[SET_RULE` {a,b,c} = {c,a,b} `] THEN\r
ASM_CASES_TAC `(v3:real^3) = vec 0 ` THENL [\r
MP_TAC (SPEC`(vec 0) :real^3` GIVEN_POINT_EXISTS_2_NOT_COLLINEAR) THEN\r
STRIP_TAC THEN\r
EXISTS_TAC `y: real^3` THEN\r
EXISTS_TAC `z: real^3` THEN\r
ASM_SIMP_TAC[INSERT_EMPTY_SUBSET] THEN\r
MATCH_MP_TAC HULL_INC THEN\r
SET_TAC[];\r
FIRST_X_ASSUM MP_TAC THEN NHANH TOW_DISTINCT_POINTS_EXISTS_RD_NOT_COLLINEAR THEN\r
STRIP_TAC THEN\r
EXISTS_TAC `v3: real^3` THEN\r
EXISTS_TAC `z: real^3` THEN\r
FIRST_X_ASSUM MP_TAC THEN\r
SIMP_TAC[INSERT_COMM] THEN\r
STRIP_TAC THEN\r
MATCH_MP_TAC SUBSET_IMP_SUBSET_HULL THEN\r
ASM_SIMP_TAC[] THEN\r
SET_TAC[]]; ONCE_REWRITE_TAC[SET_RULE` {a,b,c} = {c,a,b} `] THEN\r
ASM_CASES_TAC`v2: real^3 = vec 0 ` THENL [UNDISCH_TAC `v3 = c % (v2: real^3)` THEN\r
MATCH_MP_TAC (TAUT` a ==> b ==> a `) THEN\r
ASM_CASES_TAC `(v3:real^3) = vec 0 ` THENL [\r
MP_TAC (SPEC`(vec 0) :real^3` GIVEN_POINT_EXISTS_2_NOT_COLLINEAR) THEN\r
STRIP_TAC THEN\r
EXISTS_TAC `y: real^3` THEN\r
EXISTS_TAC `z: real^3` THEN\r
ASM_SIMP_TAC[INSERT_EMPTY_SUBSET] THEN\r
MATCH_MP_TAC HULL_INC THEN\r
SET_TAC[];\r
FIRST_X_ASSUM MP_TAC THEN NHANH TOW_DISTINCT_POINTS_EXISTS_RD_NOT_COLLINEAR THEN\r
STRIP_TAC THEN\r
EXISTS_TAC `v3: real^3` THEN\r
EXISTS_TAC `z: real^3` THEN\r
FIRST_X_ASSUM MP_TAC THEN\r
SIMP_TAC[INSERT_COMM] THEN\r
STRIP_TAC THEN\r
MATCH_MP_TAC SUBSET_IMP_SUBSET_HULL THEN\r
ASM_SIMP_TAC[] THEN\r
SET_TAC[]]; FIRST_X_ASSUM MP_TAC] THEN\r
ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN\r
NHANH TOW_DISTINCT_POINTS_EXISTS_RD_NOT_COLLINEAR THEN\r
STRIP_TAC THEN\r
EXISTS_TAC`v2:real^3` THEN\r
EXISTS_TAC`z:real^3` THEN\r
ASM_SIMP_TAC[INSERT_EMPTY_SUBSET] THEN\r
ASM_SIMP_TAC[INSERT_EMPTY_SUBSET; IN_P_HULL_INSERT] THEN\r
ONCE_REWRITE_TAC[INSERT_AC] THEN\r
ASM_SIMP_TAC[AFFINE_HULL_3; IN_P_HULL_INSERT; IN_ELIM_THM] THEN\r
EXISTS_TAC `c: real` THEN\r
EXISTS_TAC `&1 - (c: real)` THEN\r
EXISTS_TAC `&0` THEN\r
SIMP_TAC[REAL_ARITH`c + &1 - c + &0 = &1 `] THEN\r
CONV_TAC VECTOR_ARITH]; ASM_MESON_TAC[HULL_SUBSET]]);;\r
\r
\r
\r
let SUBSET_AFFINE_HULL3_EQ_SUB_PLANE = prove(`\r
(? (u: real^3 ) v w. S SUBSET affine hull {u, v, w}) <=> (?x. plane x /\ S SUBSET x)`,\r
REWRITE_TAC[plane] THEN EQ_TAC THENL [STRIP_TAC THEN\r
MP_TAC (SPECL [`u: real^3`;`v:real^3`;`w:real^3`] THREE_POINT_IMP_EXISTS_3) THEN\r
STRIP_TAC THEN EXISTS_TAC` affine hull {u, w2, (w3: real^3)}` THEN CONJ_TAC THENL [\r
ASM_MESON_TAC[]; FIRST_X_ASSUM MP_TAC THEN\r
NHANH_PAT `\x. x ==> y ` (MESON[HULL_MONO]` s SUBSET t ==> affine hull s SUBSET affine hull t`)\r
THEN ASM_SIMP_TAC[HULL_HULL] THEN ASM_MESON_TAC[SUBSET_TRANS]]; MESON_TAC[]]);;\r
\r
let coplanar2 = coplanar;;\r
\r
\r
\r
let NOT_COPLANAR_0_4_IMP_INDEPENDENT = prove\r
(`!v1 v2 v3:real^N. ~coplanar {vec 0,v1,v2,v3} ==> independent {v1,v2,v3}`,\r
REPEAT GEN_TAC THEN REWRITE_TAC[independent; CONTRAPOS_THM] THEN\r
REWRITE_TAC[dependent] THEN\r
SUBGOAL_THEN\r
`!v1 v2 v3:real^N. v1 IN span {v2,v3} ==> coplanar{vec 0,v1,v2,v3}`\r
ASSUME_TAC THENL\r
[REPEAT STRIP_TAC THEN REWRITE_TAC[coplanar] THEN\r
MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `v2:real^N`; `v3:real^N`] THEN\r
SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT] THEN\r
REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN\r
ASM_SIMP_TAC[SPAN_SUPERSET; IN_INSERT] THEN\r
POP_ASSUM MP_TAC THEN SPEC_TAC(`v1:real^N`,`v1:real^N`) THEN\r
REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[];\r
REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN\r
STRIP_TAC THEN ASM_REWRITE_TAC[] THEN\r
FIRST_X_ASSUM SUBST_ALL_TAC THENL\r
[FIRST_X_ASSUM(MP_TAC o SPECL [`v1:real^N`; `v2:real^N`; `v3:real^N`]);\r
FIRST_X_ASSUM(MP_TAC o SPECL [`v2:real^N`; `v3:real^N`; `v1:real^N`]);\r
FIRST_X_ASSUM(MP_TAC o SPECL [`v3:real^N`; `v1:real^N`; `v2:real^N`])]\r
THEN REWRITE_TAC[INSERT_AC] THEN DISCH_THEN MATCH_MP_TAC THEN\r
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE\r
`a IN s ==> s SUBSET t ==> a IN t`)) THEN\r
MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]]);;\r
\r
let NONCOPLANAR_3_BASIS = prove\r
(`!v1 v2 v3 v0 v:real^3.\r
~coplanar {v0, v1, v2, v3}\r
==> ?t1 t2 t3.\r
v = t1 % (v1 - v0) + t2 % (v2 - v0) + t3 % (v3 - v0) /\\r
(!ta tb tc.\r
v = ta % (v1 - v0) + tb % (v2 - v0) + tc % (v3 - v0)\r
==> ta = t1 /\ tb = t2 /\ tc = t3)`,\r
GEN_GEOM_ORIGIN_TAC `v0:real^3` ["v"] THEN REPEAT GEN_TAC THEN\r
MAP_EVERY (fun t ->\r
ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[INSERT_AC; COPLANAR_3]; ALL_TAC])\r
[`v1:real^3 = vec 0`; `v2:real^3 = vec 0`; `v3:real^3 = vec 0`;\r
`v2:real^3 = v1`; `v3:real^3 = v1`; `v3:real^3 = v2`] THEN\r
DISCH_THEN(ASSUME_TAC o MATCH_MP NOT_COPLANAR_0_4_IMP_INDEPENDENT) THEN\r
REWRITE_TAC[VECTOR_SUB_RZERO] THEN\r
MP_TAC(ISPECL [`(:real^3)`; `{v1,v2,v3}:real^3->bool`]\r
CARD_GE_DIM_INDEPENDENT) THEN\r
ASM_REWRITE_TAC[SUBSET_UNIV; DIM_UNIV; DIMINDEX_3] THEN\r
ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN\r
ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH; SUBSET; IN_UNIV] THEN\r
DISCH_THEN(MP_TAC o SPEC `v:real^3`) THEN\r
REWRITE_TAC[SPAN_BREAKDOWN_EQ; SPAN_EMPTY; IN_SING] THEN\r
REWRITE_TAC[VECTOR_ARITH `a - b:real^3 = c <=> a = b + c`] THEN\r
REWRITE_TAC[VECTOR_ADD_RID] THEN\r
MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t1:real` THEN\r
MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t2:real` THEN\r
MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t3:real` THEN\r
DISCH_TAC THEN ASM_REWRITE_TAC[] THEN\r
MAP_EVERY X_GEN_TAC [`ta:real`; `tb:real`; `tc:real`] THEN DISCH_TAC THEN\r
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INDEPENDENT_EXPLICIT]) THEN\r
REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN\r
DISCH_THEN(MP_TAC o SPEC\r
`(\x. if x = v1 then t1 - ta\r
else if x = v2 then t2 - tb else t3 - tc):real^3->real`) THEN\r
REWRITE_TAC[FORALL_IN_INSERT] THEN\r
SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN\r
ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; VECTOR_ADD_RID] THEN\r
REWRITE_TAC[REAL_ARITH `s - t = &0 <=> t = s`] THEN\r
DISCH_THEN MATCH_MP_TAC THEN UNDISCH_TAC\r
`t1 % v1 + t2 % v2 + t3 % v3:real^3 = ta % v1 + tb % v2 + tc % v3` THEN\r
VECTOR_ARITH_TAC);;\r
\r
\r
let coplanar = prove(` ! (S:real^3 -> bool ). coplanar S <=> (?x. plane x /\ S SUBSET x)`,\r
REWRITE_TAC[SUBSET_AFFINE_HULL3_EQ_SUB_PLANE; coplanar]);;\r
\r
\r
let COPLANAR_DET_EQ_0 = prove\r
(`!v0 v1 (v2: real^3) v3.\r
coplanar {v0,v1,v2,v3} <=>\r
det(vector[v1 - v0; v2 - v0; v3 - v0]) = &0`,\r
REPEAT GEN_TAC THEN REWRITE_TAC[DET_EQ_0_RANK; RANK_ROW] THEN\r
REWRITE_TAC[rows; row; LAMBDA_ETA] THEN\r
ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN\r
REWRITE_TAC[GSYM numseg; DIMINDEX_3] THEN\r
CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN\r
SIMP_TAC[IMAGE_CLAUSES; VECTOR_3] THEN EQ_TAC THENL\r
[REWRITE_TAC[coplanar; plane; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN\r
MAP_EVERY X_GEN_TAC\r
[`p:real^3->bool`; `a:real^3`; `b:real^3`; `c:real^3`] THEN\r
DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN\r
FIRST_X_ASSUM SUBST1_TAC THEN\r
W(MP_TAC o PART_MATCH lhand AFFINE_HULL_INSERT_SUBSET_SPAN o\r
rand o lhand o goal_concl) THEN\r
REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN\r
DISCH_THEN(MP_TAC o MATCH_MP SUBSET_TRANS) THEN\r
DISCH_THEN(MP_TAC o ISPEC `\x:real^3. x - a` o MATCH_MP IMAGE_SUBSET) THEN\r
ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN\r
REWRITE_TAC[IMAGE_CLAUSES; GSYM IMAGE_o; o_DEF; VECTOR_ADD_SUB; IMAGE_ID;\r
SIMPLE_IMAGE] THEN\r
REWRITE_TAC[INSERT_SUBSET] THEN STRIP_TAC THEN\r
GEN_REWRITE_TAC LAND_CONV [GSYM DIM_SPAN] THEN MATCH_MP_TAC LET_TRANS THEN\r
EXISTS_TAC `CARD {b - a:real^3,c - a}` THEN\r
CONJ_TAC THENL\r
[MATCH_MP_TAC SPAN_CARD_GE_DIM;\r
SIMP_TAC[CARD_CLAUSES; FINITE_RULES] THEN ARITH_TAC] THEN\r
REWRITE_TAC[FINITE_INSERT; FINITE_RULES] THEN\r
GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_SPAN] THEN\r
MATCH_MP_TAC SPAN_MONO THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN\r
MP_TAC(VECTOR_ARITH `!x y:real^3. x - y = (x - a) - (y - a)`) THEN\r
DISCH_THEN(fun th -> REPEAT CONJ_TAC THEN\r
GEN_REWRITE_TAC LAND_CONV [th]) THEN\r
MATCH_MP_TAC SPAN_SUB THEN ASM_REWRITE_TAC[];\r
\r
\r
DISCH_TAC THEN\r
MP_TAC(ISPECL [`{v1 - v0,v2 - v0,v3 - v0}:real^3->bool`; `2`]\r
LOWDIM_EXPAND_BASIS) THEN\r
ASM_REWRITE_TAC[ARITH_RULE `n <= 2 <=> n < 3`; DIMINDEX_3; ARITH] THEN\r
DISCH_THEN(X_CHOOSE_THEN `t:real^3->bool`\r
(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN\r
CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN\r
REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN\r
MAP_EVERY X_GEN_TAC [`a:real^3`; `b:real^3`] THEN\r
DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN\r
REWRITE_TAC[coplanar; plane] THEN\r
EXISTS_TAC `affine hull {v0,v0 + a,v0 + b}:real^3->bool` THEN\r
CONJ_TAC THENL\r
[MAP_EVERY EXISTS_TAC [`v0:real^3`; `v0 + a:real^3`; `v0 + b:real^3`] THEN\r
REWRITE_TAC[COLLINEAR_3; COLLINEAR_LEMMA;\r
VECTOR_ARITH `--x = vec 0 <=> x = vec 0`;\r
VECTOR_ARITH `u - (u + a):real^3 = --a`;\r
VECTOR_ARITH `(u + b) - (u + a):real^3 = b - a`] THEN\r
REWRITE_TAC[DE_MORGAN_THM; VECTOR_SUB_EQ;\r
VECTOR_ARITH `b - a = c % -- a <=> (c - &1) % a + &1 % b = vec 0`] THEN\r
ASM_REWRITE_TAC[] THEN CONJ_TAC THENL\r
[ASM_MESON_TAC[IN_INSERT; INDEPENDENT_NONZERO]; ALL_TAC] THEN\r
DISCH_THEN(X_CHOOSE_TAC `u:real`) THEN\r
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN\r
REWRITE_TAC[DEPENDENT_EXPLICIT] THEN\r
MAP_EVERY EXISTS_TAC [`{a:real^3,b}`;\r
`\x:real^3. if x = a then u - &1 else &1`] THEN\r
REWRITE_TAC[FINITE_INSERT; FINITE_RULES; SUBSET_REFL] THEN\r
CONJ_TAC THENL\r
[EXISTS_TAC `b:real^3` THEN ASM_REWRITE_TAC[IN_INSERT] THEN\r
REAL_ARITH_TAC;\r
ALL_TAC] THEN\r
SIMP_TAC[VSUM_CLAUSES; FINITE_RULES] THEN\r
ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; VECTOR_ADD_RID];\r
ALL_TAC] THEN\r
W(MP_TAC o PART_MATCH (lhs o rand) AFFINE_HULL_INSERT_SPAN o\r
rand o goal_concl) THEN\r
ANTS_TAC THENL\r
[REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN\r
REWRITE_TAC[VECTOR_ARITH `u = u + a <=> a = vec 0`] THEN\r
ASM_MESON_TAC[INDEPENDENT_NONZERO; IN_INSERT];\r
ALL_TAC] THEN\r
DISCH_THEN SUBST1_TAC THEN\r
ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN\r
REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; IMAGE_ID; VECTOR_ADD_SUB] THEN\r
MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC\r
`IMAGE (\v:real^3. v0 + v) (span{v1 - v0, v2 - v0, v3 - v0})` THEN\r
ASM_SIMP_TAC[IMAGE_SUBSET] THEN\r
REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_IMAGE] THEN CONJ_TAC THENL\r
[EXISTS_TAC `vec 0:real^3` THEN REWRITE_TAC[SPAN_0] THEN VECTOR_ARITH_TAC;\r
REWRITE_TAC[VECTOR_ARITH `v1:real^N = v0 + x <=> x = v1 - v0`] THEN\r
REWRITE_TAC[UNWIND_THM2] THEN REPEAT CONJ_TAC THEN\r
MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_INSERT]]]);;\r
\r
\r
let det_vec3 = new_definition ` det_vec3 (a:real^3) (b:real^3) (c:real^3) =\r
a$1 * b$2 * c$3 + b$1 * c$2 * a$3 + c$1 * a$2 * b$3 -\r
( a$1 * c$2 * b$3 + b$1 * a$2 * c$3 + c$1 * b$2 * a$3 ) `;;\r
\r
\r
let DET_VEC3_EXPAND = prove\r
(`det (vector [a; b; (c:real^3)] ) = det_vec3 a b c`,\r
REWRITE_TAC[det_vec3; DET_3; VECTOR_3] THEN REAL_ARITH_TAC);;\r
\r
let COPLANAR_DET_VEC3_EQ_0 = prove( `!v0 v1 (v2: real^3) v3.\r
coplanar {v0,v1,v2,v3} <=>\r
det_vec3 ( v1 - v0 ) ( v2 - v0 ) ( v3 - v0 ) = &0`, REWRITE_TAC[COPLANAR_DET_EQ_0; DET_VEC3_EXPAND]);;\r
\r
\r
let coplanar1 = coplanar;;\r
let coplanar = coplanar2;;\r
\r
\r
\r
let DET_VEC3_AS_CROSS_DOT = prove(` det_vec3 v1 v2 v3 = (v1 cross v2 ) dot v3 `,\r
REWRITE_TAC[det_vec3; cross; DOT_3; VECTOR_3]\r
THEN REAL_ARITH_TAC);;\r
\r
\r
let ORTHONORMAL_IMP_NONZERO = prove\r
(`!e1 e2 e3. orthonormal e1 e2 e3\r
==> ~(e1 = vec 0) /\ ~(e2 = vec 0) /\ ~(e3 = vec 0)`,\r
REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN\r
REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN\r
ASM_REWRITE_TAC[orthonormal; DOT_LZERO] THEN REAL_ARITH_TAC);;\r
\r
let ORTHONORMAL_IMP_DISTINCT = prove\r
(`!e1 e2 e3. orthonormal e1 e2 e3 ==> ~(e1 = e2) /\ ~(e1 = e3) /\ ~(e2 = e3)`,\r
REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN\r
REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN\r
ASM_REWRITE_TAC[orthonormal; DOT_LZERO] THEN REAL_ARITH_TAC);;\r
\r
let ORTHONORMAL_IMP_INDEPENDENT = prove\r
(`!e1 e2 e3. orthonormal e1 e2 e3 ==> independent {e1,e2,e3}`,\r
REPEAT STRIP_TAC THEN MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN\r
CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[ORTHONORMAL_IMP_NONZERO]] THEN\r
RULE_ASSUM_TAC(REWRITE_RULE[orthonormal]) THEN\r
REWRITE_TAC[pairwise; IN_INSERT; NOT_IN_EMPTY] THEN\r
REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[orthogonal] THEN\r
ASM_MESON_TAC[DOT_SYM]);;\r
\r
let ORTHONORMAL_IMP_SPANNING = prove\r
(`!e1 e2 e3. orthonormal e1 e2 e3 ==> span {e1,e2,e3} = (:real^3)`,\r
REPEAT STRIP_TAC THEN\r
MP_TAC(ISPECL [`(:real^3)`; `{e1:real^3,e2,e3}`] CARD_EQ_DIM) THEN\r
ASM_SIMP_TAC[ORTHONORMAL_IMP_INDEPENDENT; SUBSET_UNIV] THEN\r
REWRITE_TAC[DIM_UNIV; DIMINDEX_3; HAS_SIZE; FINITE_INSERT; FINITE_EMPTY] THEN\r
SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; IN_INSERT] THEN\r
FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHONORMAL_IMP_DISTINCT) THEN\r
ASM_REWRITE_TAC[NOT_IN_EMPTY; ARITH] THEN SET_TAC[]);;\r
\r
let th = prove\r
(`!e1 e2 e3.\r
orthonormal e1 e2 e3\r
==> !x. ?t1 t2 t3.\r
x = t1 % e1 + t2 % e2 + t3 % e3 /\\r
!tt1 tt2 tt3.\r
x = tt1 % e1 + tt2 % e2 + tt3 % e3\r
==> tt1 = t1 /\ tt2 = t2 /\ tt3 = t3`,\r
REPEAT STRIP_TAC THEN\r
FIRST_ASSUM(MP_TAC o MATCH_MP ORTHONORMAL_IMP_SPANNING) THEN\r
DISCH_THEN(MP_TAC o AP_TERM `(IN) (x:real^3)`) THEN\r
REWRITE_TAC[IN_UNIV; SPAN_BREAKDOWN_EQ; SPAN_EMPTY; IN_SING] THEN\r
SIMP_TAC[VECTOR_ARITH `x - a - b - c = vec 0 <=> x:real^3 = a + b + c`] THEN\r
MAP_EVERY (fun t -> MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC t)\r
[`t1:real`; `t2:real`; `t3:real`] THEN\r
DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[] THEN REPEAT GEN_TAC THEN\r
ONCE_REWRITE_TAC[REAL_ARITH `x:real = y <=> y - x = &0`] THEN\r
REWRITE_TAC[VECTOR_ARITH\r
`a % x + b % y + c % z:real^3 = a' % x + b' % y + c' % z <=>\r
(a - a') % x + (b - b') % y + (c - c') % z = vec 0`] THEN\r
DISCH_TAC THEN\r
FIRST_ASSUM(MP_TAC o MATCH_MP ORTHONORMAL_IMP_INDEPENDENT) THEN\r
REWRITE_TAC[INDEPENDENT_EXPLICIT] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN\r
DISCH_THEN(MP_TAC o SPEC\r
`\x:real^3. if x = e1 then t1 - tt1:real\r
else if x = e2 then t2 - tt2\r
else t3 - tt3`) THEN\r
FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHONORMAL_IMP_DISTINCT) THEN\r
ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN\r
ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; VECTOR_ADD_RID] THEN\r
DISCH_THEN(fun th -> MAP_EVERY (MP_TAC o C SPEC th)\r
[`e1:real^3`; `e2:real^3`; `e3:real^3`]) THEN\r
ASM_SIMP_TAC[]);;\r
\r
(* the following lemma are in collect_geom.ml *)\r
(* Hi Truong,\r
\r
In the very latest snapshot there is a theorem COPLANAR_DET_EQ_0\r
(I think I proved it because you asked for it some time ago). By\r
combing that with DET_3 you should be able to get your first\r
theorem COPLANAR_DET_VEC3_EQ_0.\r
\r
I will work on the other one NONCOPLANAR_3_BASIS and send it later\r
today.*)\r
\r
\r
(*\r
Hi Truong,\r
\r
Here is the other theorem. Fortunately I proved the rather tedious\r
lemma NOT_COPLANAR_0_4_IMP_INDEPENDENT earlier in this week for use\r
in the volume properties.\r
\r
John.\r
\r
have been in trig.ml\r
\r
let NOT_COPLANAR_0_4_IMP_INDEPENDENT = prove\r
(`!v1 v2 v3:real^N. ~coplanar {vec 0,v1,v2,v3} ==> independent {v1,v2,v3}`,\r
REPEAT GEN_TAC THEN REWRITE_TAC[independent; CONTRAPOS_THM] THEN\r
REWRITE_TAC[dependent] THEN\r
SUBGOAL_THEN\r
`!v1 v2 v3:real^N. v1 IN span {v2,v3} ==> coplanar{vec 0,v1,v2,v3}`\r
ASSUME_TAC THENL\r
[REPEAT STRIP_TAC THEN REWRITE_TAC[coplanar] THEN\r
MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `v2:real^N`; `v3:real^N`] THEN\r
SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT] THEN\r
REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN\r
ASM_SIMP_TAC[SPAN_SUPERSET; IN_INSERT] THEN\r
POP_ASSUM MP_TAC THEN SPEC_TAC(`v1:real^N`,`v1:real^N`) THEN\r
REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[];\r
REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN\r
STRIP_TAC THEN ASM_REWRITE_TAC[] THEN\r
FIRST_X_ASSUM SUBST_ALL_TAC THENL\r
[FIRST_X_ASSUM(MP_TAC o SPECL [`v1:real^N`; `v2:real^N`; `v3:real^N`]);\r
FIRST_X_ASSUM(MP_TAC o SPECL [`v2:real^N`; `v3:real^N`; `v1:real^N`]);\r
FIRST_X_ASSUM(MP_TAC o SPECL [`v3:real^N`; `v1:real^N`; `v2:real^N`])]\r
THEN REWRITE_TAC[INSERT_AC] THEN DISCH_THEN MATCH_MP_TAC THEN\r
FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE\r
`a IN s ==> s SUBSET t ==> a IN t`)) THEN\r
MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]]);;\r
\r
let NONCOPLANAR_3_BASIS = prove\r
(`!v1 v2 v3 v0 v:real^3.\r
~coplanar {v0, v1, v2, v3}\r
==> ?t1 t2 t3.\r
v = t1 % (v1 - v0) + t2 % (v2 - v0) + t3 % (v3 - v0) /\\r
(!ta tb tc.\r
v = ta % (v1 - v0) + tb % (v2 - v0) + tc % (v3 - v0)\r
==> ta = t1 /\ tb = t2 /\ tc = t3)`,\r
GEN_GEOM_ORIGIN_TAC `v0:real^3` ["v"] THEN REPEAT GEN_TAC THEN\r
MAP_EVERY (fun t ->\r
ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[INSERT_AC; COPLANAR_3]; ALL_TAC])\r
[`v1:real^3 = vec 0`; `v2:real^3 = vec 0`; `v3:real^3 = vec 0`;\r
`v2:real^3 = v1`; `v3:real^3 = v1`; `v3:real^3 = v2`] THEN\r
DISCH_THEN(ASSUME_TAC o MATCH_MP NOT_COPLANAR_0_4_IMP_INDEPENDENT) THEN\r
REWRITE_TAC[VECTOR_SUB_RZERO] THEN\r
MP_TAC(ISPECL [`(:real^3)`; `{v1,v2,v3}:real^3->bool`]\r
CARD_GE_DIM_INDEPENDENT) THEN\r
ASM_REWRITE_TAC[SUBSET_UNIV; DIM_UNIV; DIMINDEX_3] THEN\r
ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN\r
ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH; SUBSET; IN_UNIV] THEN\r
DISCH_THEN(MP_TAC o SPEC `v:real^3`) THEN\r
REWRITE_TAC[SPAN_BREAKDOWN_EQ; SPAN_EMPTY; IN_SING] THEN\r
REWRITE_TAC[VECTOR_ARITH `a - b:real^3 = c <=> a = b + c`] THEN\r
REWRITE_TAC[VECTOR_ADD_RID] THEN\r
MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t1:real` THEN\r
MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t2:real` THEN\r
MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t3:real` THEN\r
DISCH_TAC THEN ASM_REWRITE_TAC[] THEN\r
MAP_EVERY X_GEN_TAC [`ta:real`; `tb:real`; `tc:real`] THEN DISCH_TAC THEN\r
FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INDEPENDENT_EXPLICIT]) THEN\r
REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN\r
DISCH_THEN(MP_TAC o SPEC\r
`(\x. if x = v1 then t1 - ta\r
else if x = v2 then t2 - tb else t3 - tc):real^3->real`) THEN\r
REWRITE_TAC[FORALL_IN_INSERT] THEN\r
SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN\r
ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; VECTOR_ADD_RID] THEN\r
REWRITE_TAC[REAL_ARITH `s - t = &0 <=> t = s`] THEN\r
DISCH_THEN MATCH_MP_TAC THEN UNDISCH_TAC\r
`t1 % v1 + t2 % v2 + t3 % v3:real^3 = ta % v1 + tb % v2 + tc % v3` THEN\r
VECTOR_ARITH_TAC);;\r
\r
\r
*)\r
\r
\r
\r
let DIV_POW2 = REAL_FIELD` (a/b) pow 2 = a pow 2 / (b pow 2 )`;;\r
\r
\r
\r
let REAL_LE_SQUARE_POW = REWRITE_RULE[GSYM REAL_POW_2] REAL_LE_SQUARE;;\r
\r
\r
let NOT_EQ0_IMP_TRIGIZABLE = prove(` ~( x = &0 /\ y = &0 ) ==>\r
( x / sqrt ( x pow 2 + y pow 2 )) pow 2\r
+ ( y / sqrt ( x pow 2 + y pow 2 )) pow 2 = &1 `,REWRITE_TAC[DIV_POW2] THEN\r
ASSUME_TAC (MESON [REAL_LE_SQUARE_POW; REAL_LE_ADD]`\r
&0 <= x pow 2 + y pow 2 `) THEN\r
ASM_SIMP_TAC[SQRT_POW_2; REAL_FIELD` a / (m:real) + b / m =\r
( a + b ) / m `;GSYM REAL_SOS_EQ_0; REAL_DIV_REFL]);;\r
\r
\r
\r
let POW2_1 = REAL_ARITH` ( &1 ) pow 2 = &1`;;\r
\r
let ABS_BOUNDS = REAL_ABS_BOUNDS;;\r
\r
let POW2_1_BOUNDED = prove(\r
` a pow 2 + b pow 2 = &1 ==> -- &1 <= a /\ a <= &1 `,\r
REWRITE_TAC[REAL_ARITH` a + b = c <=> b = c - a `] THEN\r
NHANH ( MESON[REAL_LE_POW_2]`a pow 2 = x ==> &0 <= x `) THEN\r
ONCE_REWRITE_TAC[REAL_ARITH` &1 = &1 pow 2 `] THEN\r
REWRITE_TAC[REAL_SUB_LE; GSYM REAL_LE_SQUARE_ABS; ABS_1; POW2_1;\r
ABS_BOUNDS] THEN SIMP_TAC[]);;\r
\r
let POW2_1_BOUNDED =\r
MESON[REAL_ADD_SYM; POW2_1_BOUNDED; REAL_ABS_BOUNDS]`\r
a pow 2 + b pow 2 = &1 ==> abs a <= &1 /\ abs b <= &1 `;;\r
\r
let SIN_COMPLEMENTIVE = prove(` sin x = sin ( pi - x ) `,\r
REWRITE_TAC[SIN_COS; REAL_ARITH` a / &2 - ( a - x ) =\r
-- ( a / &2 - x )`; COS_NEG]);;\r
\r
\r
let CYLINDER_CORDINATE = prove(` ! w u e1 e2 (e3:real^3) x.\r
orthonormal e1 e2 e3 /\\r
e3 = ( &1 / norm ( w - u )) % ( w - u ) /\\r
~ ( x IN aff {w,u} ) /\ ~( w = u )\r
==>\r
(? r phi h. &0 < r /\\r
x = u + (r * ( cos phi )) % e1 +\r
( r * sin phi) % e2\r
+ h % ( w - u ) ) `,\r
REPEAT GEN_TAC THEN\r
REWRITE_TAC[orthonormal; GSYM DET_VEC3_AS_CROSS_DOT] THEN\r
NHANH (REAL_LT_IMP_NZ) THEN\r
ONCE_REWRITE_TAC[MESON[VECTOR_SUB_RZERO]` fv a b c = fv ( a - vec 0 ) ( b - vec 0 )\r
( c - vec 0 ) `] THEN\r
REWRITE_TAC[GSYM COPLANAR_DET_VEC3_EQ_0] THEN\r
NHANH (SPECL [`e1 : real^3`;` e2 :real^3`; `e3 :real^3`;\r
`(vec 0 : real^3)`; `(x : real^3) - u` ] NONCOPLANAR_3_BASIS) THEN\r
REWRITE_TAC[VECTOR_SUB_RZERO] THEN\r
STRIP_TAC THEN\r
ASM_CASES_TAC` t1 = &0 /\ t2 = &0 ` THENL [\r
FIRST_X_ASSUM (CONJUNCTS_THEN ASSUME_TAC) THEN\r
(ASSUME_TAC o FOR_ASM ) (prove(` t1 = &0 /\ t2 = &0 /\\r
x - u= t1 % e1 + t2 % e2 + t3 % e3\r
==> (x:real^3) - u = t3 % e3 `,\r
SIMP_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID])) THEN\r
FIRST_X_ASSUM MP_TAC THEN\r
UNDISCH_TAC` e3 = &1 / norm (w - u) % (w - (u:real^3))` THEN\r
SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH`\r
a -(b:real^n) = n % ( c - b )<=> a = n % c +\r
( &1 - n ) % b `] THEN\r
UNDISCH_TAC ` ~( x IN aff {w,(u:real^3)} )` THEN\r
REWRITE_TAC[AFF2; IN_ELIM_THM] THEN\r
MESON_TAC[];\r
FIRST_X_ASSUM MP_TAC] THEN\r
NHANH NOT_EQ0_IMP_TRIGIZABLE THEN\r
NHANH CIRCLE_SINCOS THEN\r
SIMP_TAC[GSYM REAL_SOS_EQ_0] THEN\r
ONCE_REWRITE_TAC[MESON[]` a /\b ==> c <=> a ==> b ==> c `] THEN\r
SIMP_TAC[GSYM SQRT_EQ_0; MESON[REAL_LE_POW_2;\r
REAL_LE_ADD]` &0 <= t1 pow 2 + t2 pow 2 `; REAL_FIELD`\r
~ ( a = &0 ) ==> (t / a = d <=> t = a * d ) `] THEN\r
REPEAT STRIP_TAC THEN\r
UNDISCH_TAC`x - u = t1 % e1 + t2 % e2 + t3 % (e3: real^3)` THEN\r
REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN\r
UNDISCH_TAC` e3 = &1 / norm (w - u) % (w - (u:real^3))` THEN\r
PURE_ONCE_REWRITE_TAC[MESON[]` a = b ==> P a <=> a = b ==>\r
P b `] THEN\r
ABBREV_TAC `tt = t1 pow 2 + t2 pow 2 ` THEN\r
SIMP_TAC[] THEN\r
REPLICATE_TAC 3 DISCH_TAC THEN\r
REWRITE_TAC[VECTOR_ARITH` a - b = c <=> a = b + (c:real^N)`;\r
VECTOR_MUL_ASSOC] THEN REWRITE_TAC[REAL_ARITH` &0 < r /\ ~( r = &0 ) <=> &0 < r `] THEN\r
ASSUME_TAC2 (MESON[SQRT_POS_LE; REAL_LE_POW_2; REAL_LE_ADD]` t1 pow 2 +\r
t2 pow 2 = tt ==> &0 <= sqrt tt `) THEN\r
ASSUME_TAC2 (REAL_ARITH` ~ ( sqrt tt = &0 ) /\ &0 <= sqrt tt\r
==> &0 < sqrt tt `) THEN FIRST_ASSUM MP_TAC THEN MESON_TAC[]);;\r
\r
\r
\r
\r
(* NOT NEED AT ALL\r
let arith_lemma = prove\r
(`!a d x. &0 < d ==>\r
?y. (a <= y /\ y <= a + d) /\ ?n. y = x + &n * d \/ x = y + &n * d`,\r
REPEAT STRIP_TAC THEN DISJ_CASES_TAC (SPEC `(x - a):real` REAL_LE_NEGTOTAL)\r
THEN IMP_RES_THEN (IMP_RES_THEN STRIP_ASSUME_TAC) REAL_ARCH_LEAST THENL\r
[ EXISTS_TAC `x - &n * d` THEN STRIP_TAC THENL\r
[ (POP_ASSUM MP_TAC) THEN (POP_ASSUM MP_TAC) THEN\r
REWRITE_TAC [GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC ;\r
EXISTS_TAC `n:num` THEN REAL_ARITH_TAC ] ;\r
EXISTS_TAC `x + &(SUC n) * d` THEN STRIP_TAC THENL\r
[ (POP_ASSUM MP_TAC) THEN (POP_ASSUM MP_TAC) THEN\r
REWRITE_TAC [GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC ;\r
EXISTS_TAC `(SUC n):num` THEN REAL_ARITH_TAC ]]);;\r
*)\r
\r
\r
let COS_SUM_2PI = prove(\r
`! x. cos x = cos ( &2 * pi - x ) `, GEN_TAC THEN\r
ONCE_REWRITE_TAC[GSYM COS_NEG] THEN\r
PAT_ONCE_REWRITE_TAC `\x. _ = x ` [GSYM COS_PERIODIC] THEN\r
REWRITE_TAC[REAL_ARITH` --( a - b) + a = b `; COS_NEG]);;\r
\r
\r
\r
let POW2_EQ_0 = prove(` ! a. a pow 2 = &0 <=> a = &0 `,\r
GEN_TAC THEN MP_TAC REAL_LE_POW_2 THEN\r
ASSUME_TAC (GEN_ALL NOT_ZERO_EQ_POW2_LT) THEN\r
REWRITE_TAC[REAL_LE_LT] THEN\r
FIRST_ASSUM (fun th -> REWRITE_TAC[GSYM th] ) THEN\r
ASM_MESON_TAC[]);;\r
\r
\r
let UNIT_BOUNDED_IN_TOW_FORMS = prove(`-- &1 <= a /\ a <= &1 ==> &0 <= &1 - a pow 2 `,\r
DISCH_TAC THEN REWRITE_TAC[REAL_ARITH` &1 - a pow 2 = (&1 - a ) * ( &1 + a )`] THEN\r
MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC);;\r
\r
\r
let COS_TOTAL = prove(`-- &1 <= a /\ a <= &1 ==> (?!x. &0 <= x /\ x <= pi /\ cos x = a ) `,\r
NHANH (UNIT_BOUNDED_IN_TOW_FORMS) THEN NHANH_PAT `\a. a ==> _` SQRT_WORKS THEN\r
ONCE_REWRITE_TAC[REAL_ARITH` a = &1 - b pow 2 <=> b pow 2 + a = &1 `] THEN\r
SIMP_TAC[EXISTS_UNIQUE] THEN NHANH SINCOS_TOTAL_PI THEN\r
STRIP_TAC THEN EXISTS_TAC` t:real` THEN ASM_SIMP_TAC[] THEN\r
ASM_MESON_TAC[COS_INJ_PI]);;\r
\r
\r
\r
\r
let SUM_POW2_EQ1_UNIQUE_TRIG = prove(` ! a b. a pow 2 + b pow 2 = &1 ==> (?!x. &0 <= x /\\r
x < &2 * pi /\ cos x = a /\ sin x = b )`,\r
REPEAT GEN_TAC THEN NHANH (POW2_1_BOUNDED) THEN\r
REWRITE_TAC[REAL_ABS_BOUNDS] THEN\r
NHANH_PAT `\x. _ /\ x /\ _ ==> h ` COS_TOTAL THEN\r
PAT_REWRITE_TAC `\x. _ /\ _ /\ x ==> _ ` [REAL_ARITH`\r
-- &1 <= b /\ b <= &1 <=> -- &1 <= b /\ b < &0 \/ &0 <= b /\\r
b <= &1 `] THEN REWRITE_TAC[EXISTS_UNIQUE] THEN STRIP_TAC\r
THENL [ASSUME_TAC PI_POS THEN ASM_CASES_TAC ` x = &0 ` THENL [\r
FIRST_X_ASSUM SUBST_ALL_TAC THEN EXISTS_TAC ` &0` THEN\r
SUBST_ALL_TAC COS_0 THEN FIRST_X_ASSUM (SUBST_ALL_TAC o SYM )\r
THEN UNDISCH_TAC `&1 pow 2 + b pow 2 = &1 ` THEN\r
REWRITE_TAC[REAL_ARITH` &1 pow 2 + b = &1 <=>\r
b = &0 `; POW2_EQ_0] THEN DISCH_TAC THEN\r
ASM_MESON_TAC[REAL_ARITH` b < &0 /\ b = &0 ==> F `];\r
EXISTS_TAC ` &2 * pi - x ` THEN ASSUME_TAC2 (\r
REAL_ARITH` x <= pi /\ &0 < pi ==> &0 <= &2 * pi - x `) THEN\r
FIRST_X_ASSUM SIMP_TAC1 THEN\r
ASSUME_TAC2 (REAL_ARITH` &0 <= x /\ ~( x = &0 ) ==> &0 < x `) THEN\r
REWRITE_TAC[REAL_ARITH` a - b < a <=> &0 < b `] THEN\r
FIRST_X_ASSUM SIMP_TAC1 THEN\r
REWRITE_TAC[GSYM COS_SUM_2PI; REAL_ARITH` a - b =\r
-- b + a `; SIN_PERIODIC; SIN_NEG] THEN\r
SIMP_TACC1 (TAUT` cos x = a ==> cos x = a `) THEN\r
SIMP_IDENT[] `cos x = a ` THEN\r
ASSUME_TAC2 (REAL_ARITH` b < &0 ==> b <= &0 `) THEN\r
ASSUME_TAC (SPEC_ALL SIN_CIRCLE) THEN\r
USE_FIRST `cos x = a` SUBST_ALL_TAC THEN\r
ASSUME_TAC2 (REAL_ARITH` sin x pow 2 + a pow 2 = &1 /\\r
a pow 2 + b pow 2 = &1 ==> sin x pow 2 = b pow 2 `) THEN\r
SUBST_ALL_TAC (REAL_ARITH` b pow 2 = ( -- b ) pow 2 `) THEN\r
ASSUME_TAC2 (REAL_ARITH` b < &0 ==> &0 <= -- b `) THEN\r
ASSUME_TAC2 (SPEC_ALL SIN_POS_PI_LE) THEN\r
ASSUME_TAC2 (MESON[EQ_POW2_COND]` &0 <= -- b /\\r
&0 <= sin x /\sin x pow 2 = -- b pow 2 ==> sin x = -- b `) THEN\r
SIMP_IDENT[REAL_NEGNEG] `sin x = -- b ` THEN\r
REPEAT STRIP_TAC THEN\r
UNDISCH_TAC `y < &2 * pi ` THEN\r
ONCE_SIMP_IDENT ` &0 < pi ` (REAL_ARITH` &0 < p ==> ( x\r
< &2 * p <=> x <= p \/ p < x /\ x < &2 * p )`) THEN\r
STRIP_TAC] THENL [\r
ASSUME_TAC2 (SPEC `y:real` SIN_POS_PI_LE) THEN\r
ASSUME_TAC2 (REAL_ARITH` sin y = b /\ &0 <= sin y ==>\r
&0 <= b `) THEN UNDISCH_TAC ` b < &0 ` THEN\r
SIMP_IDENT[REAL_ARITH` &0 <= b <=> ~(b < &0 )`] `&0 <= b`;\r
REWRITE_TAC[REAL_ARITH` y = -- x + b <=> b - y = x `] THEN\r
REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN PHA THEN\r
REWRITE_TAC[REAL_ARITH` a < x /\ x < &2 * a <=>\r
&0 < &2 * a - x /\ &2 * a - x < a `] THEN\r
UNDISCH_TAC ` cos y = a ` THEN\r
ONCE_REWRITE_TAC[COS_SUM_2PI] THEN\r
NHANH (REAL_LT_IMP_LE) THEN\r
UNDISCH_TAC `!y. &0 <= y /\ y <= pi /\ cos y = a ==> y = x` THEN\r
MESON_TAC[]];EXISTS_TAC `x:real` THEN\r
SIMP_IDENT[] `&0 <= x ` THEN\r
SIMP_IDENT[]` cos x = a ` THEN\r
ASSUME_TAC PI_POS THEN\r
ASSUME_TAC2 (REAL_ARITH` x <= pi /\ &0 < pi ==>\r
x < &2 * pi `) THEN\r
SIMP_IDENT[]` x < &2 * pi` THEN\r
ASSUME_TAC (SPEC_ALL SIN_CIRCLE) THEN\r
USE_FIRST `cos x = a ` SUBST_ALL_TAC THEN\r
ASSUME_TAC2 (REAL_ARITH` a pow 2 + b pow 2 = &1 /\\r
sin x pow 2 + a pow 2 = &1 ==> b pow 2 = sin x pow 2 `) THEN\r
ASSUME_TAC2 (SPEC_ALL SIN_POS_PI_LE) THEN\r
ASSUME_TAC2 (MESON[EQ_POW2_COND]` b pow 2 = sin x pow 2\r
/\ &0 <= sin x /\ &0 <= b ==> sin x = b `) THEN\r
SIMP_IDENT[]` sin x = b ` THEN\r
ONCE_SIMP_IDENT ` &0 < pi ` (REAL_ARITH` &0 < p ==> ( x\r
< &2 * p <=> x <= p \/ p < x /\ x < &2 * p )`) THEN\r
REPEAT STRIP_TAC THENL [ASM_MESON_TAC[];\r
ASSUME_TAC2 (REAL_ARITH` pi < y /\ y < &2 * pi ==>\r
&0 < y - pi /\ y - pi < pi `)] THEN\r
ASSUME_TAC (UNDISCH (SPEC ` y - pi ` SIN_POS_PI)) THEN\r
UNDISCH_TAC ` &0 < sin ( y - pi )` THEN\r
ONCE_REWRITE_TAC[GSYM SIN_PERIODIC] THEN\r
REWRITE_TAC[REAL_ARITH` a - b + &2 * b = a + b `;\r
SIN_PERIODIC_PI] THEN ASM_REWRITE_TAC[] THEN\r
SIMP_IDENT[REAL_ARITH` &0 <= a ==> ~( &0 < -- a )`]\r
` &0 <= b `]);;\r
\r
\r
\r
\r
let PERIODIC_AT0_IMP_ANY = prove(\r
` ! f p t. &0 < p /\\r
(! x. f x = f ( x + p )) ==>\r
((?!x. &0 <= x /\ x < p /\ f x ) <=> (! t. &0 <= t /\\r
t < p ==> (?!x. t <= x /\\r
x < t + p /\ f x )))`,\r
REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE] THEN\r
EQ_TAC THENL [REPEAT STRIP_TAC\r
THEN ASM_CASES_TAC ` t <= (x:real) ` THENL [\r
EXISTS_TAC `x:real` THEN SIMP_IDENT[] `t <= x `\r
THEN SIMP_IDENT[] `(f: real -> bool) x` THEN\r
ELIM_IDENTS (REAL_ARITH` x < p /\ &0 <= t ==>\r
x < t + p `) THEN REPEAT STRIP_TAC THEN\r
ASM_CASES_TAC ` y < (p:real)` THENL [\r
ASSUME_TAC2 (REAL_ARITH` &0 <= t /\ t <= y ==>\r
&0 <= y `) THEN ASM_MESON_TAC[];\r
DOWN_TAC THEN REWRITE_TAC[REAL_ARITH` ~( a < b ) <=>\r
&0 <= a - b `; REAL_ARITH` a < b + c <=>\r
a - c < b `] THEN STRIP_TAC THEN\r
ASSUME_TAC2 (REAL_ARITH` y - p < t /\ t < p ==>\r
y - p < p `) THEN\r
ASSUME_TAC2 (prove(`(! a. f a <=> f ( a + (p:real)) )/\ f y ==>\r
f ( y - p )`, PAT_ONCE_REWRITE_TAC `\x. _ /\ x ==> _`\r
[REAL_ARITH` a = a - p + p `] THEN MESON_TAC[])) THEN\r
SUBST_ALL_TAC (\r
MESON[]`(!y. &0 <= y /\ y < p /\ f y ==> y = x)\r
<=> (!y. &0 <= y ==> y < p ==> f y ==> y = x)`) THEN\r
ASSUME_TAC2 (\r
MESON[]`(!(y:real). &0 <= y ==> y < p ==> f y ==> y = x) /\\r
&0 <= y - p /\y - p < p /\ f ((y:real) - p) ==> x = y - p `) THEN\r
REWRITE_TAC[REAL_ARITH` y = y - p <=> p = &0 `] THEN\r
ASM_MESON_TAC[REAL_ARITH` y < t /\ x = y ==>\r
~( t <= x ) `]];EXISTS_TAC `x + p ` THEN\r
SUBST_ALL_TAC (REAL_ARITH` ~( t <= x ) <=> x < t `) THEN\r
ELIM_IDENTS (REAL_ARITH` t < p /\ &0 <= x /\ x < t ==>\r
t <= x + p /\ x + p < t + p `) THEN\r
ELIM_IDENTS (MESON[]`(!x. f x <=> f ( x + (p:real)))\r
/\ f x ==> f ( x + p )`) THEN\r
REWRITE_TAC[REAL_ARITH` a < b + c <=> a - c < b `] THEN\r
REPEAT STRIP_TAC THEN\r
ASM_CASES_TAC ` &0 <= y - p ` THEN\r
ASSUME_TAC2 (REAL_ARITH` y - p < t /\ t < p ==>\r
y - p < p `) THEN\r
ASSUME_TAC2 (prove(`(! a. f a <=> f ( a + (p:real)) )/\ f y ==>\r
f ( y - p )`, PAT_ONCE_REWRITE_TAC `\x. _ /\ x ==> _`\r
[REAL_ARITH` a = a - p + p `] THEN MESON_TAC[]))]\r
THENL [SUBST_ALL_TAC (\r
MESON[]`(!y. &0 <= y /\ y < p /\ f y ==> y = x)\r
<=> (!y. &0 <= y ==> y < p ==> f y ==> y = x)`) THEN\r
ASSUME_TAC2 (\r
MESON[]`(!y. &0 <= y ==> y < p ==> f y ==> y = x) /\\r
&0 <= y - p /\ y - p < p /\ f ( y - p) ==> y - p\r
= x `) THEN\r
(SIMP_IDENT[REAL_ARITH` a - b = c <=> a = b + c `]\r
`y - p = (x:real) `) THEN SIMP_TAC[REAL_ADD_SYM];\r
SUBST_ALL_TAC (REAL_ARITH`~( &0 <= y - p ) <=> y < p `) THEN\r
ASSUME_TAC2 (REAL_ARITH` &0 <= t /\ t <= y ==>\r
&0 <= y `) THEN SUBST_ALL_TAC (\r
MESON[]`(!y. &0 <= y /\ y < p /\ f y ==> y = x)\r
<=> (!y. &0 <= y ==> y < p ==> f y ==> y = x)`) THEN\r
ASSUME_TAC2 (MESON[]`(!y. &0 <= y ==> y < p ==> f y ==> y = x)/\\r
f y /\ y < p /\ &0 <= y ==> y = x `) THEN\r
(CONTR_TAC o UNDISCH_ALL o REAL_ARITH) ` y = x ==> x < t ==> t <= y ==> F `];\r
DISCH_TAC THEN FIRST_X_ASSUM (ASSUME_TAC o (SPEC\r
` &0 ` )) THEN ASSUME_TAC (REAL_ARITH` &0 <= &0 `)\r
THEN DOWN_TAC THEN REWRITE_TAC[REAL_ADD_LID]\r
THEN MESON_TAC[]]);;\r
\r
\r
\r
\r
\r
\r
let SUM_TWO_POW2S = MESON[REAL_LE_POW_2; REAL_LE_ADD]` &0 <= a pow 2 + b pow 2 `;;\r
\r
\r
\r
let IDENT_WHEN_IDENT_SIN_COS = prove(`\r
&0 <= x' /\ x' < &2 * pi /\ &0 <= p /\ p < &2 * pi /\\r
cos x' = cos p /\ sin x' = sin p ==> p = x' `,\r
MP_TAC SIN_CIRCLE THEN\r
ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN\r
MESON_TAC[SUM_POW2_EQ1_UNIQUE_TRIG]);;\r
\r
\r
\r
\r
\r
\r
\r
let UNIQUE_EXISTSENCE_OF_RPHIH =\r
prove(`!w u (e1: real^3) e2 e3 x.\r
orthonormal e1 e2 e3 /\\r
e3 = &1 / norm (w - u) % (w - u) /\\r
~(x IN aff {w, u}) /\\r
~(w = u)\r
==> (?r phii h.\r
(&0 <= phii /\\r
phii < &2 * pi /\\r
&0 < r /\\r
x =\r
u + (r * cos phii) % e1 + (r * sin phii) % e2 + h % (w - u)) /\\r
(!rr p hh.\r
&0 <= p /\\r
p < &2 * pi /\\r
&0 < rr /\\r
x =\r
u + (rr * cos p) % e1 + (rr * sin p) % e2 + hh % (w - u)\r
==> rr = r /\ p = phii /\ hh = h))`,\r
REPEAT GEN_TAC THEN\r
REWRITE_TAC[orthonormal; GSYM DET_VEC3_AS_CROSS_DOT] THEN\r
NHANH (REAL_LT_IMP_NZ) THEN\r
ONCE_REWRITE_TAC[MESON[VECTOR_SUB_RZERO]` fv a b c = fv ( a - vec 0 ) ( b - vec 0 )\r
( c - vec 0 ) `] THEN\r
REWRITE_TAC[GSYM COPLANAR_DET_VEC3_EQ_0] THEN\r
NHANH (SPECL [`e1 : real^3`;` e2 :real^3`; `e3 :real^3`;\r
`(vec 0 : real^3)`; `(x : real^3) - u` ] NONCOPLANAR_3_BASIS) THEN\r
REWRITE_TAC[VECTOR_SUB_RZERO] THEN\r
STRIP_TAC THEN\r
ASM_CASES_TAC` t1 = &0 /\ t2 = &0 ` THENL [\r
FIRST_X_ASSUM (CONJUNCTS_THEN ASSUME_TAC) THEN\r
(ASSUME_TAC o FOR_ASM ) (prove(` t1 = &0 /\ t2 = &0 /\\r
x - u= t1 % e1 + t2 % e2 + t3 % e3\r
==> (x:real^3) - u = t3 % e3 `,\r
SIMP_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID])) THEN\r
FIRST_X_ASSUM MP_TAC THEN\r
UNDISCH_TAC` e3 = &1 / norm (w - u) % (w - (u:real^3))` THEN\r
SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH`\r
a -(b:real^n) = n % ( c - b )<=> a = n % c +\r
( &1 - n ) % b `] THEN\r
UNDISCH_TAC ` ~( x IN aff {w,(u:real^3)} )` THEN\r
REWRITE_TAC[AFF2; IN_ELIM_THM] THEN\r
MESON_TAC[];\r
FIRST_X_ASSUM MP_TAC THEN\r
NHANH NOT_EQ0_IMP_TRIGIZABLE THEN\r
NHANH SUM_POW2_EQ1_UNIQUE_TRIG THEN\r
PAT_REWRITE_TAC `\x. _ /\ _ /\ x ==> _ `\r
[REAL_ARITH` a < &2 * b <=> a < &0 + &2 * b `] THEN\r
SIMP_TAC[GSYM REAL_SOS_EQ_0] THEN\r
ONCE_REWRITE_TAC[MESON[]` a /\b ==> c <=> a ==> b ==> c `] THEN\r
SIMP_TAC[GSYM SQRT_EQ_0; MESON[REAL_LE_POW_2;\r
REAL_LE_ADD]` &0 <= t1 pow 2 + t2 pow 2 `; REAL_FIELD`\r
~ ( a = &0 ) ==> (d = t / a <=> t = a * d ) `] THEN\r
REWRITE_TAC[EXISTS_UNIQUE] THEN\r
REPEAT STRIP_TAC THEN\r
UNDISCH_TAC`x - u = t1 % e1 + t2 % e2 + t3 % (e3: real^3)` THEN\r
ABBREV_TAC ` tt = t1 pow 2 + t2 pow 2 ` THEN\r
UNDISCH_TAC ` t1 = sqrt tt * cos x' ` THEN\r
UNDISCH_TAC ` t2 = sqrt tt * sin x' ` THEN\r
SIMP_TAC[] THEN\r
REWRITE_TAC[VECTOR_ARITH` a - b = c <=> a = b + (c:real^N)`] THEN\r
REPEAT STRIP_TAC THEN\r
EXISTS_TAC ` sqrt tt ` THEN\r
EXISTS_TAC ` x' :real ` THEN\r
EXISTS_TAC ` t3 * ( &1 / norm ( (w:real^3) - u )) ` THEN\r
CONJ_TAC THENL [\r
UNDISCH_TAC`x = u + (sqrt tt * cos x') % e1 +\r
(sqrt tt * sin x') % e2 + t3 % (e3 : real^3 )` THEN\r
UNDISCH_TAC` e3 = &1 / norm (w - u) % (w - (u:real^3))` THEN\r
REWRITE_TAC[REAL_ARITH` &0 < a /\ ~( a = &0 ) <=> &0 < a `] THEN\r
ASSUME_TAC2 (REAL_ARITH` x' < &0 + &2 * pi ==> x' <\r
&2 * pi `) THEN\r
ASSUME_TAC2 (MESON[SQRT_POS_LE; REAL_LE_POW_2; REAL_LE_ADD]` t1 pow 2 +\r
t2 pow 2 = tt ==> &0 <= sqrt tt `) THEN\r
ASSUME_TAC2 (REAL_ARITH` ~ ( sqrt tt = &0 ) /\ &0 <= sqrt tt\r
==> &0 < sqrt tt `) THEN\r
UNDISCH_TAC ` &0 < sqrt tt ` THEN\r
UNDISCH_TAC ` x' < &2 * pi ` THEN\r
UNDISCH_TAC ` &0 <= x' ` THEN\r
SIMP_TAC[VECTOR_MUL_ASSOC];\r
IMP_TAC THEN IMP_TAC THEN IMP_TAC THEN IMP_TAC THEN\r
REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN\r
UNDISCH_TAC `!ta tb tc.\r
x - (u:real^3) = ta % e1 + tb % e2 + tc % e3\r
==> ta = t1 /\ tb = t2 /\ tc = t3` THEN\r
FIRST_X_ASSUM MP_TAC THEN\r
UNDISCH_TAC`x = u + (sqrt tt * cos x') % e1\r
+ (sqrt tt * sin x') % e2 + t3 % (e3:real^3)` THEN\r
REWRITE_TAC[VECTOR_ARITH` a - b = (c:real^N)\r
<=> a = b + c `] THEN\r
UNDISCH_TAC`e3 = &1 / norm (w - u) % (w - (u:real^3))` THEN\r
UNDISCH_TAC` ~(w = (u:real^3) )` THEN\r
PHA THEN\r
PAT_ONCE_REWRITE_TAC `\x. x /\ _ ==> _ `\r
[VECTOR_ARITH` ( a = (b:real^N))\r
<=> ( a - b = vec 0 )`] THEN\r
REWRITE_TAC[ GSYM NORM_POS_LT] THEN\r
NHANH (MESON[REAL_FIELD ` &0 < a ==> a * &1 / a = &1`;\r
VECTOR_MUL_ASSOC]` &0 < a /\ aa = &1 / a % bb /\ l ==>\r
a % aa = ( &1 )% bb `) THEN\r
REWRITE_TAC[VECTOR_MUL_LID] THEN\r
DAO THEN\r
IMP_TAC THEN\r
DISCH_THEN (ASSUME_TAC o SYM) THEN\r
FIRST_ASSUM ( fun th -> PAT_ONCE_REWRITE_TAC `\r
\x. _ /\ x /\ _ ==> _ ` [ th]) THEN\r
REWRITE_TAC[VECTOR_MUL_ASSOC] THEN\r
NHANH (MESON[]` (!ta tb tc.\r
x = u + ta % e1 + tb % e2 + tc % e3 ==> tc = t3 /\ ta = t1 /\ tb = t2 ) /\\r
x = u + h1 % e1 + h2 % e2 + h3 % e3 /\\r
x = u + l1 % e1 + l2 % e2 + l3 % e3 /\ ll ==>\r
l1 = h1 /\ l2 = h2 /\ l3 = h3 `) THEN\r
STRIP_TAC THEN\r
ELIM_IDENTS (REAL_FIELD` &0 < norm ((w:real^3) - u) /\ t3 = hh * norm ( w - u )\r
==> hh = t3 * &1 / norm ( w - u ) `) THEN\r
REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC) THEN\r
PHA THEN\r
NHANH (MESON[]` a = b /\ aa = bb /\ l ==> a pow 2 + aa pow 2 =\r
b pow 2 + bb pow 2 `) THEN\r
REWRITE_TAC[REAL_ARITH` (a * b ) pow 2 + (a * c ) pow 2 =\r
a pow 2 * ( c pow 2 + b pow 2 ) `; SIN_CIRCLE; REAL_MUL_RID] THEN\r
ASSUME_TAC2 (MESON[SUM_TWO_POW2S]` t1 pow 2 + t2 pow 2 = tt\r
==> &0 <= tt `) THEN\r
ASSUME_TAC2 (SPEC `tt:real` SQRT_POS_LE) THEN\r
ASSUME_TAC2 (SPECL[` &0`;` rr:real `] REAL_LT_IMP_LE) THEN\r
ASSUME_TAC2 (SPECL[` rr:real `;` sqrt tt `] EQ_POW2_COND) THEN\r
FIRST_X_ASSUM (MP_TAC o SYM) THEN\r
PAT_ONCE_REWRITE_TAC `\x. (x <=> _ ) ==> _` [EQ_SYM_EQ] THEN\r
SIMP_TAC[] THEN\r
REPEAT STRIP_TAC THEN\r
FIRST_X_ASSUM (SUBST_ALL_TAC o SYM) THEN\r
ASSUME_TAC2 (REAL_FIELD` &0 < rr /\ rr * cos x' = rr * cos p /\\r
rr * sin x' = rr * sin p ==>\r
cos x' = cos p /\ sin x' = sin p `) THEN\r
SUBST_ALL_TAC (REAL_ARITH` x' < &0 + &2 * pi <=> x' < &2 * pi `) THEN\r
FIRST_X_ASSUM (CONJUNCTS_THEN ASSUME_TAC) THEN\r
ELIM_IDENTS IDENT_WHEN_IDENT_SIN_COS]]);;\r
\r
\r
\r
let REAL_EXISTS_UNIQUE_TRANSABLE =\r
prove(` ! f (t:real). (?!x. f x ) <=> (?!x. f (x - t))`,\r
REWRITE_TAC[EXISTS_UNIQUE] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [\r
STRIP_TAC THEN EXISTS_TAC `x + (t:real)` THEN\r
ASM_REWRITE_TAC[REAL_ARITH` (a + b ) - b = a `] THEN\r
ASM_MESON_TAC[REAL_EQ_SUB_RADD; REAL_ARITH` (a + b ) - b = a `];\r
STRIP_TAC THEN EXISTS_TAC ` x - (t:real)` THEN\r
ASM_REWRITE_TAC[] THEN GEN_TAC THEN ONCE_REWRITE_TAC\r
[REAL_ARITH` x = ( x + t ) - t `] THEN DISCH_TAC THEN\r
SUBGOAL_THEN ` y + t = (x:real)` ASSUME_TAC THENL\r
[ASM_MESON_TAC[]; ASM_REAL_ARITH_TAC]]);;\r
\r
(* ==================================================================== *)\r
(* in thms_doing_works.ml *)\r
(* ==================================================================== *)\r
(* ==================================================================== *)\r
\r
\r
\r
let COND_FOR_EXISTS_ANY_PERI = prove(` &0 < p /\ (!x. f x <=> f (x + p))\r
/\ (?!x. &0 <= x /\ x < p /\ f x) ==>\r
(! t . &0 <= t /\ t < p ==> (?!x. t <= x /\ x < t + p /\ f x)) `,\r
ASSUME_TAC (SPEC_ALL PERIODIC_AT0_IMP_ANY) THEN ASM_MESON_TAC[]);;\r
\r
\r
\r
let IN_ORIGIN_PERIOD_IMP_UNIQUENESS =\r
prove(` ! x t. &0 <= t /\ t < &2 * pi ==> (?!gg. &0 <= gg /\\r
gg < &2 * pi /\ cos x = cos ( t + gg )\r
/\ sin x = sin ( t + gg )) `, REPEAT STRIP_TAC THEN\r
MP_TAC (ONCE_REWRITE_RULE[REAL_ADD_SYM] (SPEC_ALL SIN_CIRCLE)) THEN\r
NHANH SUM_POW2_EQ1_UNIQUE_TRIG THEN STRIP_TAC THEN\r
ONCE_REWRITE_TAC[REAL_EXISTS_UNIQUE_TRANSABLE] THEN\r
REWRITE_TAC[REAL_SUB_LE; REAL_LT_SUB_RADD; REAL_SUB_ADD2 ] THEN\r
ASSUME_TAC SIN_PERIODIC THEN ASSUME_TAC COS_PERIODIC THEN\r
MP_TAC PI_POS THEN\r
PAT_ONCE_REWRITE_TAC `\x. x ==> _ ` [REAL_ARITH` &0 < a <=>\r
&0 < &2 * a `] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN\r
ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN\r
DISCH_TAC THEN UNDISCH_TAC ` t < &2 * pi ` THEN\r
UNDISCH_TAC ` &0 <= t ` THEN PHA THEN\r
SPEC_TAC (`t:real`,`t:real`) THEN\r
MATCH_MP_TAC COND_FOR_EXISTS_ANY_PERI THEN ASM_MESON_TAC[]);;\r
\r
\r
\r
let GIVEN_VALUED_IMP_UNIQUE_EXISTENCE = prove(\r
`! x0. (?!x. &0 <= x /\ x < &2 * pi /\ cos x = cos x0 /\\r
sin x = sin x0 )`, REPEAT STRIP_TAC THEN\r
MP_TAC (ONCE_REWRITE_RULE[REAL_ADD_SYM] SIN_CIRCLE) THEN\r
NHANH SUM_POW2_EQ1_UNIQUE_TRIG THEN SIMP_TAC[]);;\r
\r
\r
\r
let EYFCXPP = prove(` !w u e1 e2 e3 (x1:real ^3 ) x2.\r
orthonormal e1 e2 e3 /\\r
e3 = &1 / norm (w - u) % (w - u) /\\r
~(x1 IN aff {w, u}) /\\r
~(x2 IN aff {w,u}) /\\r
~(w = u)\r
==> (? r1 r2 phii ssi h1 h2.\r
((&0 <= phii /\\r
phii < &2 * pi /\\r
&0 <= ssi /\ ssi < &2 * pi /\\r
&0 < r1 /\ &0 < r2 /\\r
x1 =\r
u +\r
(r1 * cos phii) % e1 +\r
(r1 * sin phii) % e2 +\r
h1 % (w - u) /\\r
x2 = u +\r
(r2 * cos (phii + ssi )) % e1 +\r
(r2 * sin (phii + ssi )) % e2 +\r
h2 % (w - u))) /\\r
(! rr1 rr2 pphii ssii h11 h22.\r
(&0 <= pphii /\\r
pphii < &2 * pi /\\r
&0 <= ssii /\ ssii < &2 * pi /\\r
&0 < rr1 /\ &0 < rr2 /\\r
x1 =\r
u +\r
(rr1 * cos pphii) % e1 +\r
(rr1 * sin pphii) % e2 +\r
h11 % (w - u) /\\r
x2 = u +\r
(rr2 * cos (pphii + ssii )) % e1 +\r
(rr2 * sin (pphii + ssii )) % e2 +\r
h22 % (w - u)) ==>\r
rr1 = r1 /\ rr2 = r2 /\ pphii = phii /\\r
ssii = ssi /\ h11 = h1 /\ h22 = h2 ) )`,\r
ONCE_REWRITE_TAC[MESON[]` a1 /\a2/\a3/\a4 /\a5 <=>\r
(a1/\a2/\a3/\a5) /\ a4 `] THEN\r
NHANH UNIQUE_EXISTSENCE_OF_RPHIH THEN\r
ONCE_REWRITE_TAC[MESON[]` (( a1 /\a2/\a3/\a4) /\ss)/\a5 <=>\r
(a1/\a2/\a5/\a4)/\a3/\ss`] THEN\r
NHANH UNIQUE_EXISTSENCE_OF_RPHIH THEN REPEAT STRIP_TAC THEN\r
UNDISCH_TAC ` phii' < &2 * pi ` THEN UNDISCH_TAC ` &0 <= phii' ` THEN\r
PHA THEN NHANH_PAT `\x. x ==> _ ` (SPEC `phii: real` IN_ORIGIN_PERIOD_IMP_UNIQUENESS)\r
THEN REWRITE_TAC[EXISTS_UNIQUE] THEN STRIP_TAC THEN\r
EXISTS_TAC `r': real` THEN EXISTS_TAC `r:real` THEN\r
EXISTS_TAC ` phii': real` THEN EXISTS_TAC `gg: real` THEN\r
EXISTS_TAC ` h': real` THEN EXISTS_TAC ` h: real` THEN\r
ASM_REWRITE_TAC[] THEN REPEAT GEN_TAC THEN REWRITE_TAC[TAUT`\r
a /\ b ==> c <=> a ==> b ==> c`] THEN REPEAT DISCH_TAC THEN\r
REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC) THEN\r
UNDISCH_TAC ` (x2: real^3 ) = u + (r * cos phii) % e1 +\r
(r * sin (phii)) % e2 + h % (w - u)` THEN\r
UNDISCH_TAC `(x1 : real^3) = u + (r' * cos phii') % e1 +\r
(r' * sin phii') % e2 + h' % (w - u)` THEN\r
ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[]\r
THEN REPEAT DISCH_TAC THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN\r
ASSUME_TAC2 (UNDISCH (MESON[]`(!rr p hh. &0 <= p /\ p < &2 * pi /\ &0 < rr /\\r
(x1: real^3) = u + (rr * cos p) % e1 + (rr * sin p) % e2 + hh % (w - u)\r
==> rr = r' /\ p = phii' /\ hh = h') ==>\r
u + (rr1 * cos pphii) % e1 + (rr1 * sin pphii) % e2 + h11 % (w - u) =\r
x1 /\ &0 <= pphii /\ pphii < &2 * pi /\ &0 < rr1 ==>\r
rr1 = r' /\ pphii = phii' /\ h11 = h' `)) THEN ASM_REWRITE_TAC[]\r
THEN REPEAT (FIRST_X_ASSUM (CONJUNCTS_THEN ASSUME_TAC)) THEN\r
MP_TAC (SPEC `pphii + (ssii: real)`\r
GIVEN_VALUED_IMP_UNIQUE_EXISTENCE) THEN\r
REWRITE_TAC[EXISTS_UNIQUE] THEN STRIP_TAC THEN\r
UNDISCH_TAC ` (u: real^3) + (rr2 * cos (pphii + ssii)) % e1 +\r
(rr2 * sin (pphii + ssii)) % e2 + h22 % (w - u) = x2` THEN\r
REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC) THEN\r
ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN SIMP_TAC[] THEN\r
PHA THEN STRIP_TAC THEN\r
ASSUME_TAC2 ((UNDISCH o MESON[])`(!rr p hh. &0 <= p /\ p < &2 * pi /\ &0 < rr /\\r
(x2: real^3) = u + (rr * cos p) % e1 + (rr * sin p) % e2 + hh % (w - u)\r
==> rr = r /\ p = phii /\ hh = h) ==>\r
&0 < rr2 /\ &0 <= x /\ x < &2 * pi /\\r
x2 = u + (rr2 * cos x) % e1 + (rr2 * sin x) % e2 + h22 % (w - u)\r
==> r = rr2 /\ h = h22 /\ x = phii `) THEN\r
FIRST_ASSUM (fun x -> REWRITE_TAC[ x]) THEN\r
USE_FIRST `(pphii: real) = phii' ` SUBST_ALL_TAC THEN\r
REPEAT (FIRST_X_ASSUM (CONJUNCTS_THEN ASSUME_TAC)) THEN\r
FIRST_X_ASSUM SUBST_ALL_TAC THEN\r
ELIM_IDENTS ((UNDISCH o MESON[])`(!y. &0 <= y /\\r
y < &2 * pi /\ cos phii = cos (phii' + y) /\\r
sin phii = sin (phii' + y) ==> y = gg) ==>\r
cos (phii' + ssii) = cos phii /\\r
sin (phii' + ssii) = sin phii /\ &0 <= ssii /\ ssii < &2 * pi\r
==> gg = ssii `));;\r
\r
\r
\r
(* ========================== *)\r
(* ========================== *)\r
\r
\r
let INTERGRAL_UNIONS_INTERVALS =\r
prove(`! N. UNIONS {{x | &(n - 1) <= x /\ x < &n} | 0 < n /\ n <= N} =\r
{x | &0 <= x /\ x < &N}`, INDUCT_TAC THENL\r
[REWRITE_TAC[ARITH_RULE`~( 0 < b /\ b <= 0 )`; REAL_ARITH`~( &0 <= x /\ x < &0 )`] THEN\r
SET_TAC[];\r
REWRITE_TAC[ARITH_RULE`0 < n /\ n <= SUC N <=> 0 < n /\ n <= N \/ n = N + 1`; SET_RULE` UNIONS\r
{ f x | h x \/ x = N} = ( UNIONS { f x | h x }) UNION ( f N ) `] THEN\r
REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD; REAL_ARITH` &0 <= x /\ x < &N + &1 <=>\r
&0 <= x /\ x < &N \/ &N <= x /\ x < &N + &1 `] THEN\r
ASM_SIMP_TAC[ARITH_RULE` (a + 1) - 1 = a `] THEN SET_TAC[]]);;\r
\r
\r
let REAL_LE_EQ_OR_LT = REAL_ARITH` &0 <= a <=> a = &0 \/ &0 < a `;;\r
\r
\r
let EXISTS_IN_UNIT_INTERVAL = prove(`!x. ?n. &0 <= x + real_of_int n /\ x + real_of_int n < &1`,\r
MATCH_MP_TAC (MESON[REAL_ARITH` &0 <= a \/ &0 <= -- a `]` (! a. P a ==> P ( -- a ))\r
/\ (! a. &0 <= a ==> P a ) /\ (! a. a = -- ( -- a )) ==> (! a . P a )`) THEN CONJ_TAC THENL [\r
GEN_TAC THEN REWRITE_TAC[REAL_LE_EQ_OR_LT ] THEN STRIP_TAC THENL [\r
EXISTS_TAC ` -- (n:int)` THEN\r
ASM_REWRITE_TAC[int_neg_th; GSYM REAL_NEG_ADD; REAL_NEG_EQ_0] THEN REAL_ARITH_TAC;\r
EXISTS_TAC ` -- n + (&1: int)` THEN\r
ASM_REWRITE_TAC[int_neg_th; GSYM REAL_NEG_ADD; REAL_NEG_EQ_0;int_add_th; int_of_num_th]\r
THEN ASM_REAL_ARITH_TAC];REWRITE_TAC[REAL_NEGNEG] THEN GEN_TAC THEN\r
CHOOSE_TAC (SPEC `x: real` (MATCH_MP REAL_ARCH (REAL_ARITH` &0 < &1 `))) THEN\r
ASSUME_TAC (SPEC `n: num ` INTERGRAL_UNIONS_INTERVALS) THEN\r
DOWN_TAC THEN REWRITE_TAC[REAL_MUL_RID] THEN\r
NHANH (SET_RULE` x < &n /\ aa = {x | &0 <= x /\ x < &n} /\\r
&0 <= x ==> x IN aa `) THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN\r
STRIP_TAC THEN EXISTS_TAC` -- ( &(n' - 1): int) ` THEN\r
REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN\r
PHA THEN NHANH (SET_RULE` t = {x| P x } /\ x IN t ==> P x `) THEN\r
REWRITE_TAC[int_neg_th; int_of_num_th] THEN STRIP_TAC THEN\r
REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN\r
ASSUME_TAC2 (ARITH_RULE` 0 < n' ==> 1 <= n'`) THEN\r
ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB] THEN REAL_ARITH_TAC]);;\r
\r
let TWO_PI_POS = prove(` &0 < &2 * pi `, MP_TAC PI_POS THEN REAL_ARITH_TAC);;\r
\r
\r
let MOVE_TO_UNIT_INTERVAL = prove(`!x. ?n. &0 <= x + ( real_of_int n )* &2 * pi /\ x + ( real_of_int n) * &2 * pi < &2 * pi`,\r
ONCE_REWRITE_TAC [GSYM (MATCH_MP REAL_LE_RDIV_0 TWO_PI_POS)] THEN\r
ONCE_REWRITE_TAC[GSYM (MATCH_MP REAL_LT_DIV2_EQ TWO_PI_POS)] THEN\r
REWRITE_TAC[REAL_ARITH` ( a + b ) / c = a / c + b / c `; MATCH_MP (REAL_FIELD` &0 < a ==> a / a = &1 `) TWO_PI_POS;\r
MATCH_MP (REAL_FIELD` &0 < c ==> (a * c ) / c = a `) TWO_PI_POS] THEN MESON_TAC[EXISTS_IN_UNIT_INTERVAL ]);;\r
\r
\r
\r
let SIN_TOTAL_PERIODIC = prove(`! n. sin (x + &n * &2 * pi) = sin x `,\r
INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN\r
ASM_REWRITE_TAC[ADD1;GSYM REAL_OF_NUM_ADD;\r
REAL_ARITH` x + (&n + &1) * a = (x + &n * a ) + a `; SIN_PERIODIC]);;\r
\r
\r
let SIN_PERIODIC_IN_WHOLE = prove(` !n. sin ( x + real_of_int n * &2 * pi ) = sin x `,\r
GEN_TAC THEN ASM_CASES_TAC` &0 <= (n: int) ` THENL [\r
ASSUME_TAC2 (SPEC `n: int ` INT_OF_NUM_OF_INT) THEN EXPAND_TAC "n" THEN\r
REWRITE_TAC[int_of_num_th; SIN_TOTAL_PERIODIC ]; FIRST_X_ASSUM MP_TAC] THEN\r
NHANH (ARITH_RULE` ~( &0 <= (n: int) ) ==> &0 <= -- n `) THEN STRIP_TAC THEN\r
ASSUME_TAC2 (SPEC `-- n: int ` INT_OF_NUM_OF_INT) THEN\r
ONCE_REWRITE_TAC[ARITH_RULE` (a: int) = -- -- a `] THEN\r
ONCE_REWRITE_TAC[int_neg_th] THEN FIRST_X_ASSUM (SUBST1_TAC o SYM) THEN\r
REWRITE_TAC[int_of_num_th; REAL_MUL_LNEG] THEN\r
MESON_TAC[SIN_TOTAL_PERIODIC; REAL_ARITH`(a + -- b ) + (b:real) = a `]);;\r
\r
\r
\r
let COS_PERIODIC_IN_WHOLE = prove(` cos ( x + real_of_int n * &2 * pi ) = cos x `,\r
REWRITE_TAC[COS_SIN; REAL_ARITH` a - (b + c ) = a - b - c `] THEN\r
MESON_TAC[REAL_ARITH` x = x - y + y `; SIN_PERIODIC_IN_WHOLE]);;\r
\r
\r
let SIN_COS_PERIODIC_IN_WHOLE =\r
GEN_ALL (CONJ (SPEC_ALL SIN_PERIODIC_IN_WHOLE) COS_PERIODIC_IN_WHOLE);;\r
\r
\r
let SIN_COS_IDEN_IFF_DIFFER_PERS = prove(`! x y. cos x = cos y /\ sin x = sin y <=> (? k. x = y + real_of_int k * &2 * pi ) `,\r
REPEAT GEN_TAC THEN EQ_TAC THENL [CHOOSE_TAC (SPEC` x:real` MOVE_TO_UNIT_INTERVAL ) THEN\r
CHOOSE_TAC (SPEC` y:real` MOVE_TO_UNIT_INTERVAL ) THEN\r
ASSUME_TAC (GSYM (SPECL[`n:int`;`x:real`] SIN_COS_PERIODIC_IN_WHOLE)) THEN\r
FIRST_X_ASSUM (fun x -> PAT_ONCE_REWRITE_TAC`\x. x = _ /\ x = _ ==> _ ` [x]) THEN\r
ASSUME_TAC (GSYM (SPECL[`n':int`;`y:real`] SIN_COS_PERIODIC_IN_WHOLE)) THEN\r
FIRST_X_ASSUM (fun x -> PAT_ONCE_REWRITE_TAC `\x. _ = x /\ _ = x ==> _ ` [x]) THEN\r
DOWN_TAC THEN NHANH IDENT_WHEN_IDENT_SIN_COS THEN\r
REWRITE_TAC[REAL_ARITH`y + a * t = x + b * t <=> x = y + (a -b ) * t`; GSYM int_sub_th] THEN\r
STRIP_TAC THEN EXISTS_TAC ` n' - (n:int)` THEN ASM_REWRITE_TAC[];\r
STRIP_TAC THEN ASM_SIMP_TAC[SIN_COS_PERIODIC_IN_WHOLE ]]);;\r
\r
\r
let NOT_EQ_IMP_AFF_AND_COLL3 = prove(`! v (w:real^N) u. ~( v = w ) ==>\r
( u IN aff {v,w} <=> collinear {v,w,u}) `, ONCE_REWRITE_TAC[COLLINEAR_3] THEN\r
REWRITE_TAC[COLLINEAR_LEMMA; VECTOR_SUB_EQ] THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN\r
MATCH_MP_TAC (MESON[]` (P ==> Q) /\ (Q <=> L) ==> (L <=> P \/ Q)`) THEN CONJ_TAC THENL [\r
STRIP_TAC THEN EXISTS_TAC `&0` THEN\r
ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_REFL]; REWRITE_TAC[AFF2; IN_ELIM_THM] THEN\r
EQ_TAC THENL [STRIP_TAC THEN EXISTS_TAC `c:real` THEN FIRST_X_ASSUM MP_TAC THEN\r
VECTOR_ARITH_TAC; STRIP_TAC THEN EXISTS_TAC `t:real` THEN FIRST_X_ASSUM MP_TAC THEN\r
VECTOR_ARITH_TAC]]);;\r
\r
let R_SIN_CIRCLE = prove(` ! r x. ( r * cos x ) pow 2 + ( r * sin x ) pow 2 = r pow 2 `,\r
REPEAT GEN_TAC THEN MP_TAC (SPEC_ALL SIN_CIRCLE) THEN CONV_TAC REAL_RING);;\r
\r
\r
let R_SIN_COS_IDENT = prove(`! r rr x y. &0 <= r /\ &0 <= rr /\\r
r * cos x = rr * cos y /\ r * sin x = rr * sin y ==> r = rr /\ (\r
r = &0 \/ cos x = cos y /\ sin x = sin y ) `,\r
NHANH (MESON[R_SIN_CIRCLE ]`r * cos x = rr * cos y /\ r * sin x = rr * sin y ==>\r
r pow 2 = rr pow 2 `) THEN REPEAT GEN_TAC THEN STRIP_TAC THEN\r
SUBGOAL_THEN `r = (rr: real)` ASSUME_TAC THENL [ASM_SIMP_TAC[EQ_POW2_COND];\r
ASM_SIMP_TAC[]] THEN ASM_CASES_TAC ` rr = &0 ` THENL [ASM_SIMP_TAC[]; DISJ2_TAC] THEN\r
FIRST_X_ASSUM SUBST_ALL_TAC THEN DOWN_TAC THEN\r
REWRITE_TAC[REAL_EQ_MUL_LCANCEL] THEN MESON_TAC[]);;\r
\r
\r
let R_POS_SIN_COS_IDENT = prove(`! r rr x y. &0 < r /\ &0 < rr /\\r
r * cos x = rr * cos y /\ r * sin x = rr * sin y ==> r = rr /\\r
cos x = cos y /\ sin x = sin y `,\r
MESON_TAC[REAL_LT_IMP_LE; R_SIN_COS_IDENT; REAL_ARITH` &0 < a ==> ~( a = &0 )`]);;\r
\r
\r
let BEGIN_POINT_PERIODIC = prove(` ! x k. &0 <= x /\ x < &2 * pi /\ x = real_of_int k * &2 * pi ==> x = &0 `,\r
REPEAT GEN_TAC THEN ASSUME_TAC (SPEC` &0` REAL_LE_REFL) THEN ASSUME_TAC TWO_PI_POS THEN\r
STRIP_TAC THEN FIRST_X_ASSUM MP_TAC THEN\r
PAT_ONCE_REWRITE_TAC `\x. _ = x ==> _` [REAL_ARITH` a = &0 + a `] THEN\r
ASM_MESON_TAC[SIN_COS_PERIODIC_IN_WHOLE; IDENT_WHEN_IDENT_SIN_COS]);;\r
\r
\r
let BODE_YEU_ANH_DI = prove(`! k. &0 <= ppsssi /\ ppsssi < &2 * pi /\\r
&0 <= ppsssi1 /\ ppsssi1 < &2 * pi /\ &0 <= aa /\\r
aa < &2 * pi /\\r
aa = ppsssi - ppsssi1 + real_of_int k * &2 * pi ==>\r
( aa = &0 <=> ppsssi = ppsssi1 ) `,\r
REPEAT STRIP_TAC THEN\r
EQ_TAC THENL [ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH` a - b + c = &0 <=> b = a + c `]\r
THEN ASM_MESON_TAC[IDENT_WHEN_IDENT_SIN_COS; SIN_COS_IDEN_IFF_DIFFER_PERS];\r
DISCH_THEN SUBST_ALL_TAC THEN DOWN_TAC THEN REWRITE_TAC[REAL_SUB_REFL; REAL_ADD_LID] THEN\r
MESON_TAC[BEGIN_POINT_PERIODIC ]]);;\r
\r
\r
\r
(* ====================== *)\r
(* ====================== *)\r
(* ========= LEMMA 1.31 =========== *)\r
\r
\r
\r
\r
let ORTHONORMAL_BASIS = prove(\r
` orthonormal ( basis 1 ) (basis 2 ) ( basis 3 ) `,\r
MP_TAC (MESON[DOT_BASIS_BASIS]`! i j. 1 <= i /\ i <= dimindex (:3) /\ 1 <= j /\ j <= dimindex (:3)\r
==> ((basis i): real^3) dot basis j = (if i = j then &1 else &0)`) THEN\r
REWRITE_TAC[orthonormal; DIMINDEX_3; ARITH_RULE` 1 <= i /\ i <= 3 <=> i = 1 \/ i = 2 \/ i = 3 `] THEN\r
NGOAC THEN\r
REWRITE_TAC[ARITH_RULE` 1 <= i /\ i <= 3 <=> i = 1 \/ i = 2 \/ i = 3 `] THEN\r
KHANANG THEN\r
REWRITE_TAC[TAUT`(a \/ v) \/ c <=> a \/ v \/ c `] THEN\r
SIMP_TAC[TAUT`(a \/ v) \/ c <=> a \/ v \/ c `; MESON[]`(! i j. i = a /\ j = b \/ Q i j ==> R i j)\r
<=> R a b /\ (! i j. Q i j ==> R i j)`; ARITH_RULE` ~(1 = 2 )/\ ~( 1 = 3 ) /\ ~( 2 = 3 )` ] THEN\r
STRIP_TAC THEN\r
FIRST_X_ASSUM (MP_TAC o (SPECL[` 3`;`3`])) THEN\r
SIMP_TAC[] THEN\r
SIMP_TAC[CROSS_BASIS; REAL_ARITH` &0 < &1 `]);;\r
\r
\r
\r
\r
let ORTHO_IMP_NORM_CROSS_PRODUCT =\r
prove(`! x y. x dot y = &0 ==> norm (x cross y) pow 2 = (norm x * norm y) pow 2 `,\r
REPEAT STRIP_TAC THEN MP_TAC (SPEC_ALL NORM_CROSS_DOT) THEN\r
ASM_SIMP_TAC[REAL_ARITH` a + &0 pow 2 = a `]);;\r
\r
\r
let TWO_UNIT_ORTH_VECTORS_IMP_ORTHONORMAL = prove(`! e1 (e3:real^3). norm e1 = &1 /\ norm e3 = &1 /\ e1 dot e3 = &0 ==> (? e2.\r
orthonormal e1 e2 e3 ) `,\r
REPEAT STRIP_TAC THEN\r
EXISTS_TAC ` e3 cross e1 ` THEN\r
ASM_SIMP_TAC[DOT_CROSS_SELF; orthonormal; CROSS_LAGRANGE; DOT_LSUB;\r
DOT_LMUL; DOT_SQUARE_NORM; DOT_SYM] THEN\r
ASM_SIMP_TAC[DOT_RSUB; DOT_RMUL; GSYM NORM_POW_2; DOT_SYM] THEN\r
FIRST_X_ASSUM (MP_TAC o (ONCE_REWRITE_RULE[DOT_SYM])) THEN\r
NHANH ORTHO_IMP_NORM_CROSS_PRODUCT THEN\r
ASM_SIMP_TAC[] THEN\r
REAL_ARITH_TAC);;\r
\r
let ORTHONORMAL_BASIS3 = REWRITE_RULE[orthonormal] ORTHONORMAL_BASIS;;\r
\r
let EXISTS_OTHOR_VECTOR_DIFFF_VEC0 = prove(\r
`! (u: real^3). ? v . ~(v = vec 0) /\ u dot v = &0 `,\r
GEOM_BASIS_MULTIPLE_TAC 1 `u:real^3` THEN REPEAT STRIP_TAC THEN\r
EXISTS_TAC `( basis 2): real^3` THEN MP_TAC ORTHONORMAL_BASIS THEN\r
SIMP_TAC[orthonormal; DOT_LMUL; REAL_MUL_RZERO;\r
REWRITE_RULE[DE_MORGAN_THM] NOT_BASISES_EQ_VEC0]);;\r
\r
let INVERT_NORM_POS_LE = prove(` ! (x: real^N). &0 <= &1 / norm x `,\r
GEN_TAC THEN MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[NORM_POS_LE] THEN REAL_ARITH_TAC);;\r
\r
let NOT_0_INVERTABLE = REAL_FIELD` ~( a = &0) <=> &1 / a * a = &1 `;;\r
\r
\r
let NOT_VEC0_UNITABLE = prove(`! (u: real^N). ~( u = vec 0 ) <=> norm ( &1 / norm u % u ) = &1 `,\r
SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; ABS_1; GSYM NORM_EQ_0; NOT_0_INVERTABLE]);;\r
\r
\r
let EXISTS_UNIT_OTHOR_VECTOR = prove(` !(u: real^3). ?v. norm v = &1 /\ u dot v = &0 `,\r
GEN_TAC THEN (CHOOSE_TAC (SPEC` u:real^3 ` EXISTS_OTHOR_VECTOR_DIFFF_VEC0)) THEN\r
EXISTS_TAC ` &1 / norm v % ( v:real^3) ` THEN ASM_SIMP_TAC[GSYM NOT_VEC0_UNITABLE; DOT_RMUL; REAL_MUL_RZERO]);;\r
\r
\r
\r
let AFF3_TRANSLATION_IMAGE = prove(\r
` aff (IMAGE (\x. (v:real^N) + x) {v1, v2, v3}) = IMAGE (\x. v + x) ( aff {v1,v2,v3} ) `,\r
REWRITE_TAC[IMAGE_CLAUSES; aff; AFFINE_HULL_3; FUN_EQ_THM; IN_ELIM_THM] THEN\r
GEN_TAC THEN EQ_TAC THENL [PAT_ONCE_REWRITE_TAC ` \x. _ ==> x ` [GSYM IN] THEN\r
STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE] THEN\r
EXISTS_TAC ` u % v1 + v' % v2 + w % (v3:real^N)` THEN\r
CONJ_TAC THENL [DOWN_TAC THEN SIMP_TAC[REAL_ARITH` a + b = &1 <=> a = &1 - b `]\r
THEN DISCH_TAC THEN VECTOR_ARITH_TAC; ASM_MESON_TAC[]];\r
PAT_ONCE_REWRITE_TAC ` \x. x ==> _ ` [GSYM IN]] THEN\r
REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC `u:real` THEN\r
EXISTS_TAC `v':real` THEN EXISTS_TAC `w:real` THEN\r
ASM_SIMP_TAC[VECTOR_ARITH` u % (v + v1) + v' % (v + v2) + w % (v + v3) = (u + v' + w ) % v +\r
u % v1 + v' % v2 + w % v3 `; VECTOR_MUL_LID]);;\r
\r
\r
let IMAGE_INTER_AFF3 = prove(`IMAGE (\x. (v:real^N) + x) s INTER aff (IMAGE (\x. v + x) {v1,v2,v3}) =\r
IMAGE (\x. v + x) (s INTER aff {v1,v2,v3})`,\r
SUBGOAL_THEN ` ! x y. (\x. (v:real^N) + x) y = (\x. v + x) x ==> y = x ` MP_TAC THENL [\r
REWRITE_TAC[BETA_THM; VECTOR_ARITH` a + b = a + c ==> b = (c:real^N)`];\r
SIMP_TAC[AFF3_TRANSLATION_IMAGE; GSYM IMAGE_INTER_INJ]]);;\r
\r
\r
let DIHV_TRASABLE = prove(`! (v: real^N). dihV (v + u) (v + w) (v + v1) (v + v2) = dihV u w v1 v2`,\r
REWRITE_TAC[dihV; VECTOR_ARITH` ((v:real^N) + v1) - (v + u) = v1 - u `]);;\r
\r
\r
let VECTOR_MUL_R_TO_L = REWRITE_RULE[IMP_IMP] (prove(`!a (x:real^N) y. ~(a = &0) ==> a % x = y ==> x = &1 / a % y`,\r
REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `a :real` THEN\r
ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_FIELD` ~( a = &0) ==> ( a * &1 / a ) = &1 `\r
; VECTOR_MUL_LID]));;\r
\r
\r
let AFF2_VEC0 = prove(` aff {vec 0, (w: real^N)} = { x | ? k. x = k % w }`,\r
REWRITE_TAC[AFF2; FUN_EQ_THM; IN_ELIM_THM] THEN\r
GEN_TAC THEN EQ_TAC THENL [STRIP_TAC THEN EXISTS_TAC ` &1 - t ` THEN\r
EVERY_ASSUM MP_TAC THEN SIMP_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID];\r
STRIP_TAC THEN EXISTS_TAC ` &1 - k ` THEN\r
ASM_SIMP_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; REAL_ARITH` a - ( a - b ) = b `]]);;\r
\r
\r
let PERPENCULAR_PART_IDENT0 = prove(`~(w = vec 0) /\ (w dot w) % v1 - (v1 dot w) % w = vec 0\r
==> v1 IN aff {vec 0, w}`, PAT_REWRITE_TAC `\x. x /\ _ ==> _ `[GSYM DOT_EQ_0] THEN\r
REWRITE_TAC[VECTOR_SUB_EQ] THEN NHANH (VECTOR_MUL_R_TO_L) THEN\r
REWRITE_TAC[AFF2_VEC0; IN_ELIM_THM; VECTOR_MUL_ASSOC] THEN MESON_TAC[]);;\r
\r
\r
let INSERT_INTER_EMPTY = SET_RULE` {} INTER s = {} /\ (( a INSERT s ) INTER ss = {} <=>\r
~( a IN ss ) /\ s INTER ss = {} )`;;\r
\r
(*\r
\r
Hi Truong,\r
\r
There is a related theorem AZIM_SPECIAL_SCALE already there in\r
"Multivariate/flyspeck.ml". This only covers scaling of one of the\r
arguments, but the proof can be generalized to handle all of them;\r
see the proof script below.\r
\r
Since the definition of "azim" has multiple quantifier alternations, I\r
handle things in a more automatic way using the same quantifier\r
modification conversion PARTIAL_EXPAND_QUANTS_CONV that is used inside\r
the "without loss of generality" tactics.\r
\r
John.\r
\r
\r
\r
let COLLINEAR_SCALE_ALL = prove\r
(`!a b v w. ~(a = &0) /\ ~(b = &0)\r
==> (collinear {vec 0,a % v,b % w} <=> collinear {vec 0,v,w})`,\r
REPEAT STRIP_TAC THEN ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE] THEN\r
ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN\r
ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE]);;\r
\r
let AZIM_SCALE_ALL = prove\r
(`!a v w1 w2.\r
&0 < a /\ &0 < b /\ &0 < c\r
==> azim (vec 0) (a % v) (b % w1) (c % w2) = azim (vec 0) v w1 w2`,\r
let lemma = MESON[REAL_LT_IMP_NZ; REAL_DIV_LMUL]\r
`!a. &0 < a ==> (!y. ?x. a * x = y)` in\r
let SCALE_QUANT_TAC side asm avoid =\r
MP_TAC(MATCH_MP lemma (ASSUME asm)) THEN\r
DISCH_THEN(MP_TAC o MATCH_MP QUANTIFY_SURJECTION_THM) THEN\r
DISCH_THEN(CONV_TAC o side o PARTIAL_EXPAND_QUANTS_CONV avoid) in\r
REPEAT STRIP_TAC THEN\r
ASM_SIMP_TAC[azim_def; COLLINEAR_SCALE_ALL; REAL_LT_IMP_NZ] THEN\r
COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_SUB_RZERO] THEN\r
ASM_SIMP_TAC[DIST_0; NORM_MUL; GSYM VECTOR_MUL_ASSOC] THEN\r
ASM_SIMP_TAC[REAL_ARITH `&0 < a ==> abs a = a`; VECTOR_MUL_LCANCEL] THEN\r
ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN\r
SCALE_QUANT_TAC RAND_CONV `&0 < a` ["psi"; "r1"; "r2"] THEN\r
SCALE_QUANT_TAC LAND_CONV `&0 < b` ["psi"; "h2"; "r2"] THEN\r
SCALE_QUANT_TAC LAND_CONV `&0 < c` ["psi"; "h1"; "r1"] THEN\r
ASM_SIMP_TAC[GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_LDISTRIB;\r
VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; REAL_LT_MUL_EQ] THEN\r
REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_AC]);;\r
\r
let AZIM_SCALE_INV_NORM = prove\r
(`!w v1 v2.\r
~(w = vec 0) /\ ~(v1 = vec 0) /\ ~(v2 = vec 0)\r
==> azim (vec 0) w v1 v2 =\r
azim (vec 0) (&1 / norm w % w) (&1 / norm v1 % v1)\r
(&1 / norm v2 % v2)`,\r
REWRITE_TAC[real_div; REAL_MUL_LID] THEN\r
SIMP_TAC[REAL_LT_INV_EQ; NORM_POS_LT; AZIM_SCALE_ALL]);;\r
\r
*)\r
\r
\r
\r
let ARCV_VEC0_ABS = prove(` ~(ku = &0) /\ ~( kv = &0 ) ==> arcV (vec 0) (u: real^N) v =\r
arcV (vec 0) ( abs ku % u ) (abs kv % v)`, STRIP_TAC THEN\r
ABBREV_TAC ` ahah = arcV (vec 0) (abs ku % (u: real^N)) (abs kv % v) ` THEN\r
FIRST_X_ASSUM (fun x -> ONCE_REWRITE_TAC[MATCH_MP WHEN_K_DIFF0_ARCV x]) THEN\r
ONCE_REWRITE_TAC[ARC_SYM] THEN FIRST_X_ASSUM (fun x -> ONCE_REWRITE_TAC[MATCH_MP WHEN_K_DIFF0_ARCV x])\r
THEN EXPAND_TAC "ahah" THEN SIMP_TAC[ARC_SYM]);;\r
\r
let WHEN_A_B_POS_ARCV_STABLE = MESON[ARC_SYM; WHEN_K_POS_ARCV_STABLE]\r
` ! a b (x: real^N) y. &0 < a /\ &0 < b ==> arcV ( vec 0 ) x y = arcV ( vec 0 ) ( a % x ) ( b % y ) `;;\r
\r
let THREE_POS_IMP_DIHV_STABLE = prove(`!x y z.\r
&0 < a /\ &0 < b /\ &0 < c\r
==> dihV (vec 0) x y z = dihV (vec 0) (a % x) (b % y) (c % z)`,\r
REWRITE_TAC[DIHV_FORMULAR; VECTOR_SUB_RZERO] THEN\r
REWRITE_TAC[DOT_LMUL; DOT_RMUL; VECTOR_MUL_ASSOC] THEN\r
REWRITE_TAC[REAL_ARITH` ((a * a * xx) * b) = ( a pow 2 * b ) * xx `;\r
REAL_ARITH` (b * a * c) * a = ( a pow 2 * b ) * c `] THEN\r
ONCE_REWRITE_TAC[GSYM VECTOR_MUL_ASSOC] THEN\r
REWRITE_TAC[REAL_ARITH` ((a * a * xx) * b) = ( a pow 2 * b ) * xx `;\r
REAL_ARITH` (b * a * c) * a = ( a pow 2 * b ) * c `; GSYM VECTOR_SUB_LDISTRIB] THEN\r
REPEAT STRIP_TAC THEN MATCH_MP_TAC WHEN_A_B_POS_ARCV_STABLE THEN\r
CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_MUL THEN\r
ASM_SIMP_TAC[POW_2; REAL_LT_MUL];MATCH_MP_TAC REAL_LT_MUL THEN\r
ASM_SIMP_TAC[POW_2; REAL_LT_MUL]]);;\r
\r
\r
let VECTOR_OF_DIHV_ORTHONORMAL = prove(` ((w dot w) % (v1: real^N) - (v1 dot w) % w ) dot w = &0 `,\r
REWRITE_TAC[DOT_LSUB; DOT_LMUL] THEN REAL_ARITH_TAC);;\r
\r
let ORTHOGORNAL_UNITIZE = prove(` ! x (y:real^N). x dot y = &0 ==> ( &1 / norm x % x ) dot ( &1 / norm y % y ) = &0 `,\r
REWRITE_TAC[DOT_LMUL; DOT_RMUL] THEN SIMP_TAC[REAL_MUL_RZERO]);;\r
\r
let NOT_MUL_EQ0_EQ = MESON[REAL_ENTIRE]`!x y. ~( x * y = &0 ) <=> ~( x = &0 ) /\ ~( y = &0) `;;\r
\r
let UNITS_NOT_EQ_0 = MESON[NOT_MUL_EQ0_EQ; REAL_ARITH` ~( &1 = &0 )`]`! x y. x * y = &1 ==> ~( x = &0 ) /\ ~( y = &0) `;;\r
\r
let REAL_MUL_LRINV =\r
let t1 = UNDISCH (SPEC_ALL REAL_MUL_LINV) in\r
let t2 = UNDISCH (SPEC_ALL REAL_MUL_RINV) in\r
let t3 = CONJ t1 t2 in DISCH ` ~( x = &0 ) ` t3;;\r
\r
let NOT_EQ0_IMP_NEITHER_INVERT = prove(` ~( a = &0 ) ==> ~( &1 / a = &0 ) `,\r
REWRITE_TAC[NOT_0_INVERTABLE; REAL_FIELD` &1 / ( &1 / a ) = a `] THEN SIMP_TAC[REAL_MUL_SYM]);;\r
\r
\r
let PROJECTOR_NOT_EQ_VEC0 = prove(`! w v1. ~( (w:real^N) = vec 0 ) /\ ~(v1 IN aff {vec 0, w}) <=>\r
~( (w dot w) % v1 - (v1 dot w) % w = vec 0 ) `, REPEAT GEN_TAC THEN\r
EQ_TAC THENL [REWRITE_TAC[GSYM DE_MORGAN_THM; CONTRAPOS_THM] THEN\r
ASM_CASES_TAC ` (w:real^N) = vec 0 ` THENL [ASM_SIMP_TAC[];\r
ASM_SIMP_TAC[PERPENCULAR_PART_IDENT0]];\r
ASM_CASES_TAC ` (w:real^N) = vec 0 ` THENL [\r
ASM_SIMP_TAC[DOT_RZERO; VECTOR_MUL_LZERO; VECTOR_SUB_RZERO];\r
ASM_SIMP_TAC[CONTRAPOS_THM; AFF2_VEC0; IN_ELIM_THM]] THEN STRIP_TAC THEN\r
ASM_SIMP_TAC[VECTOR_MUL_ASSOC; DOT_LMUL; REAL_MUL_SYM; VECTOR_SUB_REFL]]);;\r
\r
let NOT_EQ_VEC0_IMP_EQU_AFF_COLL = prove(` ! (w:real^N) u. ~( w = vec 0 ) ==> ( u IN aff {vec 0, w } <=> collinear {vec 0, w, u}) `,\r
REPEAT STRIP_TAC THEN EQ_TAC THENL [REWRITE_TAC[AFF2_VEC0; IN_ELIM_THM; COLLINEAR_LEMMA] THEN\r
MESON_TAC[]; REWRITE_TAC[AFF2_VEC0; IN_ELIM_THM; COLLINEAR_LEMMA] THEN\r
STRIP_TAC THENL [ASM_MESON_TAC[]; EXISTS_TAC `&0 ` THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO];\r
ASM_MESON_TAC[]]]);;\r
\r
\r
let NOT_EQ_IMP_EXISTS_BASIC = prove(`! v (w:real^3). ~( v = w ) ==> \r
  (? e1 e2 e3. orthonormal e1 e2 e3 /\ dist (w,v) % e3 = w - v)`,\r
REPEAT STRIP_TAC THEN \r
CHOOSE_TAC (SPEC `w - (v:real^3)` EXISTS_UNIT_OTHOR_VECTOR) THEN\r
DOWN_TAC THEN ONCE_REWRITE_TAC[MESON[]` ~( a = b ) <=> ~ (b = a )`]\r
THEN PAT_ONCE_REWRITE_TAC`\ x. x ==> y ` [GSYM VECTOR_SUB_EQ] THEN\r
REWRITE_TAC[NOT_VEC0_UNITABLE] THEN \r
ABBREV_TAC` e1 = &1 / norm ( w - v ) % ( w - (v:real^3))`\r
THEN REWRITE_TAC[DOT_LNEG; REAL_NEG_EQ_0] THEN \r
NHANH (MESON[REAL_MUL_RZERO] ` a = &0 ==>\r
 (&1 / norm ( w  - (v:real^3))) * a = &0 `) THEN \r
ASM_REWRITE_TAC[GSYM DOT_LMUL] THEN \r
MATCH_MP_TAC (MESON[]` ( a /\ b /\ d ==> e ) ==> a /\ b \r
/\ c /\ d ==> e `) THEN \r
NHANH TWO_UNIT_ORTH_VECTORS_IMP_ORTHONORMAL THEN \r
STRIP_TAC THEN EXISTS_TAC` e2:real^3` THEN \r
EXISTS_TAC` v' : real^3` THEN EXISTS_TAC` e1: real^3` THEN \r
FIRST_X_ASSUM MP_TAC THEN SIMP_TAC[ORTHONORMAL_PERMUTE] THEN \r
STRIP_TAC THEN UNDISCH_TAC ` norm (e1:real^3) = &1 ` THEN \r
EXPAND_TAC "e1" THEN \r
REWRITE_TAC[GSYM NOT_VEC0_UNITABLE; GSYM NORM_EQ_0;\r
VECTOR_MUL_ASSOC; dist] THEN \r
SIMP_TAC[REAL_FIELD`~ ( a = &0 ) ==> ( a * &1 / a ) = &1 `;\r
 VECTOR_MUL_LID]);;\r
\r
(* 19 aug 2009 *)\r
(* =========================================== *)\r
(* =========================================== *)\r
let YVREJIS = prove(`! (v: real^3) w w1 w2.\r
cyclic_set {w1, w2} v w\r
==> (azim v w w1 w2 = &0 ==> azim v w w1 w2 + azim v w w2 w1 = &0) /\\r
(~(azim v w w1 w2 = &0)\r
==> azim v w w1 w2 + azim v w w2 w1 = &2 * pi)`,\r
REWRITE_TAC[cyclic_set] THEN\r
NHANH NOT_EQ_IMP_EXISTS_BASIC THEN\r
REPEAT GEN_TAC THEN STRIP_TAC THEN\r
ASSUME_TAC (SPECL[`v:real^3`;` w:real^3`] azim ) THEN\r
ASM_REWRITE_TAC[] THEN FIRST_ASSUM (ASSUME_TAC o SPEC_ALL) THEN\r
FIRST_X_ASSUM MP_TAC THEN STRIP_TAC THEN\r
UNDISCH_TAC `~(v = w:real^3)` THEN\r
UNDISCH_TAC `dist (w,v) % e3 = w - (v:real^3)` THEN\r
UNDISCH_TAC `orthonormal e1 e2 e3` THEN PHA THEN\r
ONCE_REWRITE_TAC[MESON[]`~(a = b ) <=> ~( b = a )`] THEN\r
FIRST_ASSUM NHANH THEN FIRST_X_ASSUM MP_TAC THEN\r
FIRST_X_ASSUM (ASSUME_TAC o (SPECL[`w2:real^3`;` w1:real^3`])) THEN\r
REPEAT (FIRST_X_ASSUM (CONJUNCTS_THEN ASSUME_TAC)) THEN\r
REPEAT (FIRST_X_ASSUM CHOOSE_TAC) THEN\r
FIRST_ASSUM (NHANH_PAT `\x. _ ==> x `) THEN\r
STRIP_TAC THEN STRIP_TAC THEN UNDISCH_TAC `w1 - v =\r
(r2 * cos (psi + azim v w w2 w1)) % e1 +\r
(r2 * sin (psi + azim v w w2 w1)) % e2 +\r
h2' % (w - v)` THEN\r
UNDISCH_TAC `w1 - (v: real^3) = (r1' * cos psi') % e1 +\r
(r1' * sin psi') % e2 + h1 % (w - v)` THEN\r
USE_FIRST ` dist (w,v) % e3 = w - (v:real^3)` (SUBST1_TAC o SYM) THEN\r
UNDISCH_TAC `orthonormal e1 e2 (e3: real^3)` THEN PHA THEN\r
REWRITE_TAC[VECTOR_MUL_ASSOC] THEN\r
NHANH (MESON[th]` orthonormal e1 e2 e3 /\ x = a1 % e1 + a2 % e2 + a3 % e3 /\\r
x = aa1 %e1 + aa2 % e2 + aa3 % e3 ==> a1 = aa1 /\ a2 = aa2 /\ a3 = aa3 `) THEN\r
STRIP_TAC THEN\r
UNDISCH_TAC` w2 - (v: real^3) = (r1 * cos psi) % e1 + (r1 * sin psi) % e2 + h1' % (w - v)` THEN\r
UNDISCH_TAC` w2 - v =\r
(r2' * cos (psi' + azim v w w1 w2)) % e1 +\r
(r2' * sin (psi' + azim v w w1 w2)) % e2 + h2 % (w - v)` THEN\r
UNDISCH_TAC `orthonormal e1 e2 (e3: real^3)` THEN\r
USE_FIRST ` dist (w,v) % e3 = w - (v:real^3)` (SUBST1_TAC o SYM) THEN\r
REWRITE_TAC[VECTOR_MUL_ASSOC] THEN PHA THEN\r
NHANH (MESON[th]` orthonormal e1 e2 e3 /\ x = a1 % e1 + a2 % e2 + a3 % e3 /\\r
x = aa1 %e1 + aa2 % e2 + aa3 % e3 ==> a1 = aa1 /\ a2 = aa2 /\ a3 = aa3 `) THEN STRIP_TAC THEN\r
UNDISCH_TAC`{w1, w2} INTER affine hull {(v: real^3), w} = {}` THEN\r
REWRITE_TAC[ GSYM aff; SET_RULE` {a,b} INTER s = {} <=> ~( a IN s ) /\ ~( b IN s ) `] THEN\r
UNDISCH_TAC `~(w = (v:real^3))` THEN\r
SIMP_TAC[EQ_SYM_EQ; NOT_EQ_IMP_AFF_AND_COLL3] THEN\r
STRIP_TAC THEN STRIP_TAC THEN\r
ASSUME_TAC2 (MESON[]`~collinear {v, w, w2} /\ (~collinear {(v:real^3), w, w2} ==> &0 < r1) ==>\r
&0 < r1 `) THEN\r
ASSUME_TAC2 (MESON[]`~collinear {v, w, w2} /\ (~collinear {(v:real^3), w, w2} ==> &0 < r2') ==>\r
&0 < r2' `) THEN\r
ASSUME_TAC2 (MESON[]`~collinear {v, w, w1} /\ (~collinear {(v:real^3), w, w1} ==> &0 < r1') ==>\r
&0 < r1' `) THEN\r
ASSUME_TAC2 (MESON[]`~collinear {v, w, w1} /\ (~collinear {(v:real^3), w, w1} ==> &0 < r2) ==>\r
&0 < r2 `) THEN\r
UNDISCH_TAC` r2' * sin (psi' + azim (v: real^3) w w1 w2) = r1 * sin psi` THEN\r
UNDISCH_TAC`r2' * cos (psi' + azim v w w1 w2) = r1 * cos psi` THEN\r
UNDISCH_TAC`&0 < r1` THEN UNDISCH_TAC`&0 < r2'` THEN PHA THEN\r
NHANH R_POS_SIN_COS_IDENT THEN\r
REWRITE_TAC[SIN_COS_IDEN_IFF_DIFFER_PERS ] THEN STRIP_TAC THEN\r
UNDISCH_TAC` r1' * sin psi' = r2 * sin (psi + azim v w w2 w1)` THEN\r
UNDISCH_TAC` r1' * cos psi' = r2 * cos (psi + azim v w w2 w1)` THEN\r
UNDISCH_TAC` &0 < r2 ` THEN UNDISCH_TAC` &0 < r1' ` THEN\r
PHA THEN NHANH R_POS_SIN_COS_IDENT THEN\r
REWRITE_TAC[SIN_COS_IDEN_IFF_DIFFER_PERS ] THEN STRIP_TAC THEN\r
CHOOSE_TAC (SPEC` psi: real` MOVE_TO_UNIT_INTERVAL ) THEN\r
CHOOSE_TAC (SPEC` psi': real` MOVE_TO_UNIT_INTERVAL ) THEN\r
SUBST_ALL_TAC (REWRITE_RULE[GSYM int_add_th;GSYM int_sub_th] (REAL_ARITH` psi' + azim v w w1 w2 = psi + real_of_int k * &2 * pi <=>\r
azim v w w1 w2 = ( psi + real_of_int n * &2 * pi) - ( psi' + real_of_int n' * &2 * pi)\r
+ (real_of_int k + real_of_int n' - real_of_int n )* &2 * pi `)) THEN\r
SUBST_ALL_TAC (REWRITE_RULE[GSYM int_add_th;GSYM int_sub_th] (REAL_ARITH` psi' = (psi + azim v w w2 w1) + real_of_int k' * &2 * pi <=>\r
azim v w w2 w1 = (psi' + real_of_int n' * &2 * pi) - (psi + real_of_int n * &2 * pi)\r
+ (real_of_int n - real_of_int k' - real_of_int n') * &2 * pi `)) THEN\r
ABBREV_TAC ` ppsssi = psi + real_of_int n * &2 * pi ` THEN\r
ABBREV_TAC ` ppsssi1 = psi' + real_of_int n' * &2 * pi ` THEN\r
REPEAT (FIRST_X_ASSUM (CONJUNCTS_THEN ASSUME_TAC)) THEN\r
ASSUME_TAC2 (SPECL [` azim v w w1 w2 `;` k + n' - (n: int) `] (GEN `aa: real` BODE_YEU_ANH_DI)) THEN\r
REWRITE_TAC[MESON[]` a = b ==> b + c = &0 <=> a = b ==> a + c = &0`] THEN\r
FIRST_X_ASSUM SUBST1_TAC THEN\r
UNDISCH_TAC `azim v w w2 w1 = ppsssi1 - ppsssi + real_of_int (n - k' - n') * &2 * pi` THEN\r
UNDISCH_TAC `azim v w w1 w2 = ppsssi - ppsssi1 + real_of_int (k + n' - n) * &2 * pi` THEN\r
UNDISCH_TAC` azim v w w2 w1 < &2 * pi ` THEN\r
UNDISCH_TAC` &0 <= azim v w w2 w1 ` THEN UNDISCH_TAC` azim v w w1 w2 < &2 * pi ` THEN\r
UNDISCH_TAC` &0 <= azim v w w1 w2 ` THEN UNDISCH_TAC` ppsssi1 < &2 * pi ` THEN\r
UNDISCH_TAC`&0 <= ppsssi1 ` THEN UNDISCH_TAC` ppsssi < &2 * pi ` THEN\r
UNDISCH_TAC`&0 <= ppsssi ` THEN PHA THEN\r
REWRITE_TAC[REWRITE_RULE[REAL_ARITH` &2 * a * b = b * &2 * a `] PDPFQUK]);;\r
\r
\r
let QQZKTXU = prove(`! v w v1 (v2:real^3). let gammma = dihV v w v1 v2 in {v1,v2} INTER aff {v,w} = {} /\\r
~( v = w ) ==> cos ( azim v w v1 v2 ) = cos gammma `,\r
GEOM_ORIGIN_TAC `v:real^3` THEN\r
ONCE_REWRITE_TAC[SET_RULE`{a} = {a,a}`] THEN\r
REWRITE_TAC[IMAGE_INTER_AFF3] THEN\r
REWRITE_TAC[IMAGE_CLAUSES] THEN\r
REWRITE_TAC[IMAGE_CLAUSES; IMAGE_EQ_EMPTY; INSERT_INSERT] THEN\r
ONCE_REWRITE_TAC[SPEC ` -- v:real^N` (GSYM DIHV_TRASABLE)] THEN\r
REWRITE_TAC[VECTOR_ARITH` -- a + a + b = (b:real^N)`] THEN\r
REPEAT STRIP_TAC THEN\r
LET_TAC THEN\r
MP_TAC (SPECL [`(vec 0): real^3`;`w:real^3`; `v1:real^3`;`v2:real^3`] azim) THEN\r
REPEAT STRIP_TAC THEN\r
EXPAND_TAC "gammma" THEN\r
REWRITE_TAC[DIHV_FORMULAR; VECTOR_SUB_RZERO] THEN\r
REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN PHA THEN\r
REWRITE_TAC[INSERT_INTER_EMPTY] THEN\r
DAO THEN NGOAC THEN\r
ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN\r
NHANH (MATCH_MP (MESON[]`(a /\ b ==> c) ==> ( a /\ ~ c ==> ~ b ) `)\r
PERPENCULAR_PART_IDENT0) THEN\r
NHANH (MATCH_MP (MESON[]` a dot b = &0 ==> ~( a = vec 0) ==> a dot b = &0`)\r
VECTOR_OF_DIHV_ORTHONORMAL) THEN\r
NHANH ORTHOGORNAL_UNITIZE THEN\r
REWRITE_TAC[NOT_VEC0_UNITABLE] THEN\r
ABBREV_TAC `e11 = &1 / norm ((w dot w) % v1 - (v1 dot w) % w) %\r
((w dot w) % v1 - (v1 dot w) % (w: real^3))` THEN\r
ABBREV_TAC ` e33 = &1 / norm w % (w:real^3)` THEN\r
STRIP_TAC THEN\r
UNDISCH_TAC `e11 dot (e33: real^3) = &0` THEN\r
UNDISCH_TAC` norm ( e33: real^3) = &1 ` THEN\r
UNDISCH_TAC` norm ( e11: real^3) = &1 ` THEN\r
PHA THEN\r
NHANH TWO_UNIT_ORTH_VECTORS_IMP_ORTHONORMAL THEN\r
EXPAND_TAC "e33" THEN\r
REWRITE_TAC[GSYM NOT_VEC0_UNITABLE] THEN\r
REWRITE_TAC[GSYM NOT_VEC0_UNITABLE; GSYM NORM_POS_LT] THEN\r
NHANH REAL_LT_IMP_NZ THEN\r
NHANH NOT_EQ0_IMP_NEITHER_INVERT THEN\r
ASM_REWRITE_TAC[] THEN\r
STRIP_TAC THEN\r
UNDISCH_TAC ` &1 / norm w % w = (e33:real^3)` THEN\r
UNDISCH_TAC ` ~(&1 / norm (w:real^3) = &0)` THEN\r
PHA THEN NHANH VECTOR_MUL_R_TO_L THEN\r
REWRITE_TAC[REAL_FIELD` &1 / ( &1 / a ) = a `; GSYM DIST_0] THEN\r
SUBST_ALL_TAC (MESON[NORM_POS_LT]` &0 < norm (w:real^3) <=> ~(w = vec 0)`) THEN\r
SIMP_TAC[DIST_SYM] THEN\r
REWRITE_TAC[VECTOR_ARITH` a = b % x <=> b % x = a - vec 0 `] THEN\r
STRIP_TAC THEN\r
UNDISCH_TAC `~((w:real^3) = vec 0)` THEN\r
FIRST_X_ASSUM MP_TAC THEN\r
UNDISCH_TAC ` orthonormal e11 e2 e33 ` THEN\r
PHA THEN FIRST_X_ASSUM NHANH THEN\r
STRIP_TAC THEN\r
UNDISCH_TAC ` ~(v1 IN aff {vec 0, (w:real^3)})` THEN\r
UNDISCH_TAC ` ~((w:real^3) = vec 0)` THEN\r
UNDISCH_TAC `~(v2 IN aff {vec 0, (w:real^3)})` THEN\r
ONCE_REWRITE_TAC[MESON[]` ~( a = b ) <=> ~( a = b ) /\ ~( a = b )`] THEN\r
PHA THEN\r
ONCE_REWRITE_TAC[TAUT` a /\ b/\ c/\ d <=> b /\ ( b /\ a ) /\c /\ d `] THEN\r
REWRITE_TAC[PROJECTOR_NOT_EQ_VEC0 ] THEN\r
REWRITE_TAC[VECTOR_ADD_RID; VECTOR_ARITH` ( a + b ) - a = (b:real^N)`] THEN\r
SIMP_TAC[NOT_EQ_IMPCOS_ARC; VECTOR_SUB_RZERO] THEN DOWN_TAC THEN\r
REWRITE_TAC[NOT_EQ_IMPCOS_ARC; VECTOR_SUB_RZERO] THEN\r
ABBREV_TAC ` azz = azim (vec 0) w v1 v2 ` THEN STRIP_TAC THEN\r
USE_FIRST `v2 =\r
(r2 * cos (psi + azz)) % e11 + (r2 * sin (psi + azz)) % e2 + h2 % (w:real^3)` SUBST1_TAC THEN\r
USE_FIRST `v1 = (r1 * cos psi) % e11 + (r1 * sin psi) % e2 + h1 % (w:real^3)` SUBST1_TAC THEN\r
UNDISCH_TAC ` orthonormal e11 e2 e33 ` THEN\r
SIMP_TAC[DOT_LADD; DOT_LMUL; orthonormal] THEN\r
ABBREV_TAC ` ww = w dot (w:real^3)` THEN\r
EXPAND_TAC "w" THEN\r
SIMP_TAC[DOT_SYM; DOT_RMUL; REAL_MUL_RZERO; REAL_ADD_LID; VECTOR_ADD_LDISTRIB] THEN\r
SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_SYM; VECTOR_ARITH`(a + c + b ) - b = (a:real^N) + c`] THEN\r
SIMP_TAC[vector_norm; DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL; REAL_MUL_RZERO; DOT_SYM;\r
REAL_ADD_RID; REAL_MUL_RID; REAL_ADD_LID; GSYM POW_2; REAL_ARITH`( a * b * c ) pow 2 + ( a * b\r
* d ) pow 2 = ( a * b ) pow 2 * ( d pow 2 + c pow 2 ) `; SIN_CIRCLE] THEN\r
STRIP_TAC THEN UNDISCH_TAC `~(ww % (v2: real^3) - (v2 dot w) % w = vec 0)` THEN\r
UNDISCH_TAC `~(ww % (v1: real^3) - (v1 dot w) % w = vec 0)` THEN\r
EXPAND_TAC "ww" THEN REWRITE_TAC[GSYM PROJECTOR_NOT_EQ_VEC0] THEN\r
NHANH (MATCH_MP (MESON[]` (a ==> ( b <=> c )) ==> (a /\ ~ b ==> ~ c) `) (SPEC_ALL NOT_EQ_VEC0_IMP_EQU_AFF_COLL)) THEN\r
FIRST_X_ASSUM NHANH THEN FIRST_X_ASSUM NHANH THEN\r
REWRITE_TAC[GSYM DOT_POS_LT] THEN STRIP_TAC THEN STRIP_TAC THEN\r
ASSUME_TAC2 (SPECL [`(w:real^3) dot w `;` r1: real `] REAL_LT_MUL) THEN\r
ASSUME_TAC2 (SPECL [`(w:real^3) dot w `;` r2: real `] REAL_LT_MUL) THEN\r
REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN\r
NHANH REAL_LT_IMP_LE THEN PHA THEN SIMP_TAC[POW_2_SQRT] THEN\r
REWRITE_TAC[REAL_ARITH` ((w dot w) * r1 * a) * (w dot w) * r2 * b +\r
((w dot w) * r1 * c) * (w dot w) * r2 * d =\r
(((w dot w) * r1) * (w dot w) * r2) * (b * a + d * c) `] THEN\r
SIMP_TAC[REAL_FIELD` &0 < a /\ &0 < b ==> (( a * b ) * c ) / ( a * b ) = c `] THEN\r
REWRITE_TAC[GSYM COS_SUB; REAL_ARITH` (a + b ) - a = b`]);;\r
\r
\r
(*\r
("SIMPLIZE_COS_IF_OTHOR ",\r
|- !v0 v1 w p.\r
~(v0 = w) /\\r
~(v0 = v1) /\\r
p - v0 = k % (v1 - v0) /\\r
(w - p) dot (v1 - v0) = &0\r
==> cos (arcV v0 v1 w) = k * norm (v1 - v0) / norm (w - v0))]\r
*)\r
(* Lemma $100 promised with John *)\r
(* ============================= *)\r
(* ============================= *)\r
\r
let real_itv = new_definition ` real_itv a b  = { x | a <= x /\ x < b } `;;\r
let tri_itv = new_definition ` tri_itv x <=> ( x IN real_itv ( &0 ) ( &2 * pi )) `;;\r
\r
(*\r
parse_as_infix("regular_lt",(12,"right"));;\r
\r
let regular_lt = new_definition\r
` (a:real) regular_lt (b:real) <=> a < b /\ a = &0 `;;\r
\r
*)\r
\r
parse_as_infix("polar_lt",(12,"right"));;\r
\r
\r
let polar_lt = new_definition \r
`(a: real^2) polar_lt (b: real^2) <=>  \r
          (!ra aa rb ab.\r
              &0 < ra /\\r
              &0 < rb /\\r
              a = vector [ra * cos aa; ra * sin aa] /\\r
              b = vector [rb * cos ab; rb * sin ab] /\\r
              tri_itv aa /\\r
              tri_itv ab\r
              ==> aa < ab \/ aa = ab /\ ra < rb) `;;\r
\r
\r
parse_as_infix("polar_le",(12,"right"));;\r
\r
let polar_le = new_definition \r
` a polar_le b <=> a polar_lt b \/ a = b `;;\r
\r
\r
parse_as_infix("polar_cycle_on",(12,"right"));;\r
\r
let polar_cycle_on = new_definition\r
` f polar_cycle_on (W: real^2 -> bool ) <=>\r
         (!x. x IN W ==> f x IN W) /\\r
         (!x. x IN W\r
             ==> x polar_lt f x /\\r
            (!y. y IN W ==> ~(x polar_lt y /\ y polar_lt f x)) \/\r
            (!y. y IN W ==> f x polar_le y /\ y polar_le x)) `;;\r
\r
let pl_angle = new_definition` pl_angle (x: real^2) = \r
 (@ u. tri_itv u /\ ( ?t. &0 < t /\ x = \r
       vector [ t * cos u; t * sin u ])) `;;\r
\r
let arg_diff = new_definition ` arg_diff a b = \r
 let dd =  pl_angle b - pl_angle a in\r
 if a polar_le b then dd else dd + &2 * pi `;;\r
\r
let VEC2_PRE_TRIG_FORM = prove(` ! (x:real^2). ~( x = vec 0) ==> ( x$1 / ( sqrt (x$1 * x$1 + x$2 * x$2))) pow 2 + \r
  ( x$2 / ( sqrt (x$1 * x$1 + x$2 * x$2))) pow 2 = &1 `,\r
REWRITE_TAC[DIV_POW2; GSYM POW_2] THEN \r
SIMP_TAC[GSYM NORM_EQ_0; vector_norm; DOT_2;GSYM POW_2; SUM_TWO_POW2S; SQRT_EQ_0; SQRT_POW_2]\r
THEN GEN_TAC THEN CONV_TAC REAL_FIELD);;\r
\r
\r
let PRE_TRIG_FORM_VEC2 = prove(`!(x: real^2). ~(x = vec 0)\r
     ==> (?u. tri_itv u /\  x = vector [( norm x ) * cos u ; ( norm x ) * sin u])`,\r
NHANH VEC2_PRE_TRIG_FORM  THEN \r
REWRITE_TAC[GSYM NORM_POS_LT; vector_norm; DOT_2] THEN \r
NHANH SUM_POW2_EQ1_UNIQUE_TRIG THEN \r
REWRITE_TAC[EXISTS_UNIQUE] THEN \r
GEN_TAC THEN STRIP_TAC THEN \r
EXISTS_TAC `x': real` THEN \r
SIMP_TAC[vector_norm; DOT_2;GSYM POW_2] THEN \r
ASM_REWRITE_TAC[] THEN \r
UNDISCH_TAC ` &0 < sqrt ((x:real^2)$1 * x$1 + x$2 * x$2)` THEN \r
NHANH REAL_LT_IMP_NZ THEN \r
SIMP_TAC[REAL_DIV_LMUL; POW_2] THEN \r
REWRITE_TAC[CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_2; tri_itv; real_itv; IN_ELIM_THM] THEN \r
ASM_REWRITE_TAC[]);;\r
\r
\r
let PL_ANGLE_PROPERTY = prove(`!(x: real^2). ~(x = vec 0)\r
     ==> tri_itv (pl_angle x) /\\r
  (? t. &0 < t /\ x = vector [ t * cos (pl_angle x); t * sin ( pl_angle x )])`,\r
NHANH PRE_TRIG_FORM_VEC2 THEN \r
PAT_REWRITE_TAC `\x. !y. x ==> _ ` [GSYM NORM_POS_LT; RIGHT_AND_EXISTS_THM] THEN\r
NHANH (MESON[]`(?u. &0 < norm x /\ L u /\ P u ( norm x )) ==> (?u. \r
  L u /\ (?t. &0 < t /\ P u t ))`) THEN \r
REWRITE_TAC[pl_angle] THEN MESON_TAC[EXISTS_THM]);;\r
\r
let POLAR_LT_IMP_NOT_EQ = \r
prove(` ~( x = vec 0 ) /\ ~((y:real^2) = vec 0 ) ==>\r
 x polar_lt y ==> ~( x = y ) `,\r
STRIP_TAC THEN REWRITE_TAC[polar_lt] THEN\r
ONCE_REWRITE_TAC[TAUT` a ==> ~ b <=> b ==> ~ a `] THEN \r
SIMP_TAC[ NOT_FORALL_THM] THEN \r
ASSUME_TAC2 (SPEC `y: real^2 ` PRE_TRIG_FORM_VEC2) THEN \r
FIRST_X_ASSUM CHOOSE_TAC THEN STRIP_TAC THEN \r
REWRITE_TAC[TAUT` ~ ( a ==> b ) <=> a /\ ~ b `] THEN \r
EXISTS_TAC `norm (y:real^2)` THEN EXISTS_TAC `u: real` THEN \r
EXISTS_TAC `norm (y:real^2)` THEN EXISTS_TAC `u:real` THEN \r
ASM_SIMP_TAC[NORM_POS_LT] THEN DOWN_TAC THEN STRIP_TAC THEN \r
ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM ACCEPT_TAC; \r
REWRITE_TAC[REAL_LT_REFL]]);;\r
\r
let CART2_EQ = prove(` vector [a1; a2] = (vector [b1; b2]): real^2 \r
<=> a1 = b1 /\ a2 = b2 `,\r
REWRITE_TAC[CART_EQ; DIMINDEX_2; ARITH_RULE` 1 <= x /\ x <= 2 <=>\r
x = 1 \/ x = 2 `; MESON[]`(! x. x = a \/ x = b ==> P x ) <=>\r
 P a /\ P b `; VECTOR_2]);;\r
\r
\r
let SE_ASM_TAC = FIRST_X_ASSUM (CONJUNCTS_THEN ASSUME_TAC);;\r
let SE_ALL_TAC = REPEAT SE_ASM_TAC;;\r
\r
\r
let POLAR_LT_TRANS = prove(`~( x = vec 0 ) /\ \r
 ~ ((y:real^2) = vec 0 ) /\ ~ ( z = vec 0 ) /\\r
 x polar_lt y /\ y polar_lt z ==> x polar_lt z `,\r
REWRITE_TAC[polar_lt] THEN NHANH PL_ANGLE_PROPERTY THEN \r
STRIP_TAC THEN DOWN_TAC THEN REWRITE_TAC[polar_lt] THEN \r
REPEAT STRIP_TAC THEN UNDISCH_TAC` tri_itv ab ` THEN \r
UNDISCH_TAC` tri_itv ( pl_angle y ) ` THEN \r
UNDISCH_TAC`(z:real^2) = vector [rb * cos ab; rb * sin ab]` THEN \r
UNDISCH_TAC`(y:real^2) = vector [t' * cos (pl_angle y); t' * sin (pl_angle y)]` THEN \r
UNDISCH_TAC` &0 < rb ` THEN UNDISCH_TAC` &0 < t' ` THEN \r
PHA THEN FIRST_X_ASSUM NHANH THEN DISCH_TAC THEN \r
REPEAT (FIRST_X_ASSUM (CONJUNCTS_THEN ASSUME_TAC)) THEN\r
UNDISCH_TAC` tri_itv ( pl_angle y ) ` THEN \r
UNDISCH_TAC `tri_itv aa ` THEN \r
UNDISCH_TAC`(y:real^2) = vector [t' * cos (pl_angle y); t' * sin (pl_angle y)]` THEN \r
UNDISCH_TAC`(x:real^2) = vector [ra * cos aa; ra * sin aa]` THEN \r
UNDISCH_TAC` &0 < t' ` THEN UNDISCH_TAC` &0 < ra ` THEN \r
PHA THEN FIRST_X_ASSUM NHANH THEN DISCH_TAC THEN SE_ALL_TAC\r
THEN ASSUME_TAC2 (\r
REAL_ARITH `(pl_angle y < ab \/ pl_angle y = ab /\ t' < rb ) /\\r
( aa < pl_angle y \/ aa = pl_angle y /\ ra < t' ) ==>\r
 aa < ab \/ aa = ab /\ ra < rb `) THEN FIRST_ASSUM ACCEPT_TAC);;\r
\r
\r
\r
let EXISTS_MAX_ELEMENT = prove\r
 (`!S (lt:A->A->bool).\r
       FINITE S /\ ~(S = {}) /\\r
       (!x y z. lt x y /\ lt y z ==> lt x z) /\\r
       (!x. ~(lt x x)) /\\r
       (!x y. S x /\ S y /\ ~( x = y ) ==> lt x y \/ lt y x )\r
       ==> ?m:A. S m /\ ( ! x. S x ==> lt x m \/ x = m )`,\r
 REPEAT STRIP_TAC THEN\r
 MP_TAC(ISPEC `\x:A y:A. x IN S /\ y IN S /\ lt y x` WF_FINITE) THEN\r
 ASM_SIMP_TAC[FINITE_RESTRICT] THEN\r
 ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN\r
 REWRITE_TAC[WF] THEN DISCH_THEN(MP_TAC o SPEC `S:A->bool`) THEN\r
 ASM SET_TAC[]);;\r
\r
\r
let NO_V0_IMP_NOT_SELF_POLLAR = MESON[POLAR_LT_IMP_NOT_EQ]\r
` ~ ( x = vec 0 ) ==> ~ ( x polar_lt  x ) `;;\r
\r
let SET_TAC = let basicthms =\r
[NOT_IN_EMPTY; IN_UNIV; IN_UNION; IN_INTER; IN_DIFF; IN_INSERT;\r
IN_DELETE; IN_REST; IN_INTERS; IN_UNIONS; IN_IMAGE] in\r
let allthms = basicthms @ map (REWRITE_RULE[IN]) basicthms @\r
[IN_ELIM_THM; IN] in\r
let PRESET_TAC =\r
TRY(POP_ASSUM_LIST(MP_TAC o end_itlist CONJ)) THEN\r
REPEAT COND_CASES_TAC THEN\r
REWRITE_TAC[EXTENSION; SUBSET; PSUBSET; DISJOINT; SING] THEN\r
REWRITE_TAC allthms in\r
fun ths ->\r
PRESET_TAC THEN\r
(if ths = [] then ALL_TAC else MP_TAC(end_itlist CONJ ths)) THEN\r
MESON_TAC ths ;;\r
\r
(* =========== improved SET_RULE ============= *)\r
let SET_RULE a = fun x -> prove(x, SET_TAC a );;\r
\r
let POLAR_CYCLIC_FUN_IMP_ALL_BELONG = \r
prove(` W p /\ f polar_cycle_on W ==> ! n. ITER n f p IN W `,\r
REWRITE_TAC[polar_cycle_on] THEN STRIP_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[ITER] THEN \r
ASM SET_TAC[]; REWRITE_TAC[ITER] THEN ASM SET_TAC[]]);;\r
\r
let EXISTS_MIN_IN_ORDERED_FINITE_SET = \r
prove(`!(S: A -> bool) lt.\r
         FINITE S /\\r
         ~(S = {}) /\ (! x. lt x x ) /\\r
         (!x y z. lt x y /\ lt y z ==> lt x z) /\\r
         (! x y. lt x y /\ lt y x ==> x = y ) /\\r
         (!x y. lt x y \/ lt y x)\r
         ==> (?m. S m /\ (!x. S x ==> lt m x ))`,\r
REPEAT STRIP_TAC THEN MP_TAC (ISPEC`\(x : A ) ( y: A).\r
 S x /\ S y /\ lt x y /\ ~ ( x = y )` WF_FINITE) THEN \r
ASM_SIMP_TAC[REWRITE_RULE[IN] FINITE_RESTRICT] THEN \r
ANTS_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[WF]] THEN \r
DISCH_THEN (MP_TAC o SPEC `S: A -> bool `) THEN \r
ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN \r
EXISTS_TAC `x: A` THEN ASM REWRITE_TAC[] THEN ASM_MESON_TAC[]);;\r
\r
\r
let EXISTS_MA_OR_FI_SET = BETA_RULE (SPECL[` S : A -> bool `;\r
`(\x y. (lt: A -> A ->  bool) y x ) `] EXISTS_MIN_IN_ORDERED_FINITE_SET);;\r
(* EXISTS_MA_OR_FI_SET\r
  |- FINITE S /\\r
     ~(S = {}) /\\r
     (!x. lt x x) /\\r
     (!x y z. lt y x /\ lt z y ==> lt z x) /\\r
     (!x y. lt y x /\ lt x y ==> x = y) /\\r
     (!x y. lt y x \/ lt x y)\r
     ==> (?m. S m /\ (!x. S x ==> lt x m)) *)\r
\r
\r
let tri_itv = let t1 = CONJ tri_itv real_itv in CONJ t1 IN_ELIM_THM;;\r
\r
let DOWN = FIRST_X_ASSUM MP_TAC;;\r
\r
let WHILE_POLAR_LT_IMP_ST = prove(` p0 polar_lt p  ==>\r
~ ( {y | ?N. y = ITER N f p0 /\\r
          (!n. 0 <= n /\ n < N ==> ITER n f p0 polar_lt y) /\\r
          y polar_lt p } = {} )`,\r
REWRITE_TAC[SET_RULE[]`~( x = {} ) <=> ? y. y IN x `; IN_ELIM_THM] THEN \r
STRIP_TAC THEN EXISTS_TAC` p0: real^2` THEN EXISTS_TAC `0 ` THEN \r
ASM_SIMP_TAC[ITER; ARITH_RULE`~( 0 <= a /\ a < 0 )`]);;\r
\r
\r
let DOT_ITSELF_2 = prove( ` (x:real^2) = vector[ a; b ]\r
 ==> x dot x = a pow 2 + b pow 2 `,\r
SIMP_TAC[dot; DIMINDEX_2; SUM_2; VECTOR_2] THEN \r
DISCH_TAC THEN REAL_ARITH_TAC);;\r
\r
\r
let NORM_VECTOR2_TRIG = \r
prove(` (x:real^2) = vector [a * cos t ; a * sin t ]\r
/\ &0 <= a ==> norm x = a `, STRIP_TAC THEN UNDISCH_TAC ` &0 <= a `\r
THEN SIMP_TAC[NORM_POS_LE; EQ_POW2_COND; NORM_POW_2] THEN \r
DOWN_TAC THEN NHANH DOT_ITSELF_2 THEN STRIP_TAC THEN \r
DOWN THEN DOWN THEN PHA THEN SIMP_TAC[] THEN \r
DISCH_TAC THEN REWRITE_TAC[R_SIN_CIRCLE]);;\r
\r
\r
let NOT_EQ_IMP_TOTAL_ORDER = prove(\r
` ! x y. ~( x = y ) ==> x polar_lt y \/ y polar_lt\r
x `, REWRITE_TAC[polar_lt] THEN REPEAT STRIP_TAC THEN \r
ASM_CASES_TAC `(x:real^2) = vec 0 \/ (y:real^2)\r
= vec 0 ` THENL [ DISJ1_TAC THEN REPEAT GEN_TAC THEN \r
NHANH REAL_LT_IMP_LE THEN NHANH (\r
MESON[NORM_VECTOR2_TRIG]`(aaa /\ &0 <= ra) /\\r
 (ac/\ &0 <= rb) /\\r
 (x:real^2) = vector [ra * cos aa; ra * sin aa] /\\r
 (y:real^2) = vector [rb * cos ab; rb * sin ab]/\ gg\r
==> norm x = ra /\ norm y = rb `) THEN DOWN THEN \r
REWRITE_TAC[GSYM NORM_EQ_0] THEN SIMP_TAC[] THEN \r
MESON_TAC[REAL_ARITH`~( a = &0 /\ &0 < a ) `]; ALL_TAC]\r
THEN DOWN THEN REWRITE_TAC[DE_MORGAN_THM] THEN \r
NHANH PRE_TRIG_FORM_VEC2 THEN STRIP_TAC THEN \r
DOWN_TAC THEN REWRITE_TAC[GSYM polar_lt] THEN \r
MP_TAC (REAL_ARITH` u < u' \/ u = u' \/ u' < u `) THEN \r
SPEC_TAC (`u:real`,`u:real`) THEN\r
SPEC_TAC (`u':real`,`u':real`) THEN \r
SPEC_TAC (`x:real^2`,`x:real^2`) THEN \r
SPEC_TAC (`y:real^2`,`y:real^2`) THEN \r
MATCH_MP_TAC (\r
MESON[]`(! y x u' u. P1 u u' /\ M x y u u' ==>\r
Q x y ) /\ ((! y x u' u. P1 u u' /\ M x y u u' ==>\r
Q x y ) ==> (! y x u' u. P1 u' u /\ M x y u u' ==>\r
Q y x )) /\ (! y x u' u. u = u' /\ M x y u u' ==>\r
Q x y \/ Q y x) ==> (! y x u' u.\r
P1 u u' \/ u = u' \/ P1 u' u ==>\r
M x y u u' ==> Q x y \/ Q y x ) `) THEN CONJ_TAC\r
THENL [REPEAT STRIP_TAC THEN UNDISCH_TAC ` u < (u':real)`\r
THEN DISCH_TAC THEN REWRITE_TAC[polar_lt] THEN REPEAT STRIP_TAC THEN DISJ1_TAC THEN \r
UNDISCH_TAC`(x:real^2) = vector [norm x * cos u; norm x * sin u]` THEN \r
UNDISCH_TAC` (y:real^2) = vector [norm y * cos u'\r
; norm y * sin u' ]` THEN \r
EVERY_ASSUM (fun x -> PAT_REWRITE_TAC `\v. v = h ==> v = h ==> gg `\r
[x ]) THEN REWRITE_TAC[CART2_EQ] THEN \r
REPEAT DISCH_TAC THEN \r
ASSUME_TAC2 (REAL_ARITH` &0 < ra /\ &0 < rb ==>\r
&0 <= ra /\ &0 <= rb `) THEN SE_ALL_TAC THEN \r
UNDISCH_TAC ` &0 <= ra ` THEN UNDISCH_TAC `(x:real^2) = vector \r
[ra * cos aa; ra * sin aa]` THEN \r
PHA THEN NHANH NORM_VECTOR2_TRIG THEN STRIP_TAC THEN \r
FIRST_X_ASSUM SUBST_ALL_TAC THEN UNDISCH_TAC ` &0 <= rb `\r
THEN UNDISCH_TAC `(y:real^2) = vector \r
[rb * cos ab; rb * sin ab]` THEN PHA THEN \r
NHANH NORM_VECTOR2_TRIG THEN STRIP_TAC THEN \r
FIRST_X_ASSUM SUBST_ALL_TAC THEN \r
REPLICATE_TAC 8 DOWN THEN PHA THEN \r
ASM_SIMP_TAC[MESON[REAL_ARITH` &0 < a ==> ~( a = &0 )`; REAL_EQ_MUL_LCANCEL]`\r
&0 < a ==> ( a * x = a * y <=> x = y ) `] THEN \r
UNDISCH_TAC` tri_itv aa ` THEN UNDISCH_TAC ` tri_itv u ` THEN \r
UNDISCH_TAC`tri_itv u'` THEN UNDISCH_TAC` tri_itv ab` THEN \r
REWRITE_TAC[tri_itv; real_itv; IN_ELIM_THM] THEN \r
REPEAT STRIP_TAC THEN SUBGOAL_THEN` aa = (u: real) /\ ab = (u': real)` ASSUME_TAC\r
THENL [ASM_MESON_TAC[IDENT_WHEN_IDENT_SIN_COS];\r
ASM_REWRITE_TAC[]]; \r
CONJ_TAC THENL [MESON_TAC[]; REPEAT GEN_TAC]] THEN \r
IMP_TAC THEN DISCH_THEN ( fun x -> REWRITE_TAC[ SYM x ]) THEN \r
ASM_CASES_TAC ` norm (x:real^2) = norm (y:real^2)` \r
THENL [ASM_REWRITE_TAC[] THEN MESON_TAC[]; DOWN] THEN \r
REWRITE_TAC[REAL_ARITH` ~( a = b ) <=> a < b \/ \r
b < a `] THEN SPEC_TAC (`x:real^2`,`x:real^2`) THEN \r
SPEC_TAC (`y:real^2`,`y:real^2`) THEN \r
MATCH_MP_TAC (MESON[]`(! x y. P x y /\ R x y ==> Q x y ) /\\r
((! x y. P x y /\ R x y ==> Q x y ) ==>\r
(! x y. P y x /\ R x y ==> Q y x ) ) ==>\r
(! x y. P x y \/ P y x ==> R x y ==> Q x y \/ Q y x)`) THEN \r
CONJ_TAC THENL [\r
REPEAT STRIP_TAC THEN REWRITE_TAC[polar_lt] THEN \r
REPEAT GEN_TAC THEN NHANH_PAT `\x. x ==> h ` REAL_LT_IMP_LE THEN \r
DISCH_TAC THEN SUBGOAL_THEN `norm (y':real^2) = ra /\ \r
norm (y:real^2) = rb ` ASSUME_TAC THENL [\r
FIRST_X_ASSUM ( fun x -> MESON_TAC[x; NORM_VECTOR2_TRIG])\r
; REPEAT STRIP_TAC] THEN DISJ2_TAC THEN \r
UNDISCH_TAC `(y': real^2) = \r
vector [norm y' * cos u; norm y' * sin u]` THEN \r
UNDISCH_TAC `(y: real^2) = \r
vector [norm y * cos u; norm y * sin u]` THEN \r
EVERY_ASSUM (fun x -> PAT_REWRITE_TAC `\x.\r
x = y ==> x = z ==> l ` [x]) THEN \r
REWRITE_TAC[CART2_EQ] THEN DOWN_TAC THEN \r
SIMP_TAC[GSYM NORM_POS_LT] THEN STRIP_TAC THEN \r
SUBGOAL_THEN ` ab = (u:real) /\ aa = u ` ASSUME_TAC\r
THENL [REPLICATE_TAC  4 DOWN THEN PHA THEN ASM_REWRITE_TAC[] THEN \r
ASM_SIMP_TAC[MESON[REAL_EQ_MUL_LCANCEL; REAL_ARITH` &0 < a ==>\r
~ ( a = &0 )`]` &0 < a ==> ( a * x = a * y <=> x = y ) `] THEN \r
UNDISCH_TAC` tri_itv aa ` THEN UNDISCH_TAC ` tri_itv ab ` THEN \r
UNDISCH_TAC `tri_itv u ` THEN PHA THEN REWRITE_TAC[tri_itv] THEN \r
MESON_TAC[IDENT_WHEN_IDENT_SIN_COS];\r
ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]];\r
MESON_TAC[]]);;\r
\r
\r
\r
\r
let PROVE_XISTS_MAX_ELEMENT_LT_P = prove(\r
` ! W:real^2 -> bool. (! x. W x ==> ~ ( x = vec 0 )) /\\r
   FINITE W /\\r
   W p0 /\ \r
   f polar_cycle_on W /\ \r
   p0 polar_lt p /\\r
   SS = { y | ? N. y = ITER N f p0 /\\r
                ( ! n . 0 <= n /\ n <  N ==> ITER n f p0 polar_lt y ) /\\r
                y polar_lt p }\r
==> (? mx. mx IN SS /\ ( ! x. SS x ==> x polar_lt mx \/ x = mx)) `,\r
ONCE_REWRITE_TAC[TAUT`aa /\ a /\ b /\ c /\ d <=> aa /\ \r
a /\ (b /\ c ) /\ d `] THEN \r
NHANH POLAR_CYCLIC_FUN_IMP_ALL_BELONG THEN REPEAT STRIP_TAC THEN \r
FIRST_X_ASSUM MP_TAC THEN \r
SUBGOAL_THEN `(! y n. y = ITER n f p0 ==> W (y:real^2))` ASSUME_TAC\r
THENL [ASM SET_TAC[]; FIRST_ASSUM NHANH] THEN \r
REWRITE_TAC[TAUT`( a /\ b) /\ c <=> b /\ a /\ c`; RIGHT_EXISTS_AND_THM] THEN \r
DOWN_TAC THEN NHANH (REWRITE_RULE[IN; RIGHT_FORALL_IMP_THM] FINITE_RESTRICT) THEN \r
STRIP_TAC THEN SUBGOAL_THEN ` FINITE (SS: real^2 -> bool) ` ASSUME_TAC THENL \r
[ASM_MESON_TAC[]; ALL_TAC] THEN \r
DOWN_TAC THEN REWRITE_TAC[GSYM RIGHT_EXISTS_AND_THM] THEN\r
PAT_REWRITE_TAC `\x. y /\ x ==> h ` [TAUT` a ==> b <=> a <=> \r
b /\ a `] THEN \r
NHANH (SET_RULE[]` S = {y | ? N. P y /\ Q N y } ==> S SUBSET P `) THEN \r
ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN \r
REPLICATE_TAC 8 (IMP_TAC THEN STRIP_TAC) THEN NGOAC THEN \r
ASM_REWRITE_TAC[] THEN PHA THEN \r
DOWN THEN REWRITE_TAC[TAUT`(b /\ a <=> a) <=> a ==> b `] THEN \r
ASSUME_TAC2 WHILE_POLAR_LT_IMP_ST THEN \r
ABBREV_TAC ` lt x y = ( ( W x /\ W y ) /\ x polar_lt (y:real^2)) `\r
THEN SUBGOAL_THEN `(! x. ~ lt x (x:real^2) )` ASSUME_TAC THENL \r
[FIRST_X_ASSUM ( fun x -> REWRITE_TAC [ GSYM x; \r
NO_V0_IMP_NOT_SELF_POLLAR]) THEN REWRITE_TAC[DE_MORGAN_THM]\r
THEN GEN_TAC THEN ASM_CASES_TAC` (W: real^2 -> bool ) x ` THENL\r
[DISJ2_TAC THEN ASM MESON_TAC[NO_V0_IMP_NOT_SELF_POLLAR];\r
ASM_REWRITE_TAC[]];\r
SUBGOAL_THEN `(!x y z. lt (x:real^2) (y: real^2) /\ lt y z ==> lt x z)` ASSUME_TAC\r
THEN DOWN] THENL [\r
FIRST_X_ASSUM (fun x -> REWRITE_TAC[GSYM x ]) THEN \r
REPLICATE_TAC 5 STRIP_TAC THEN ASM_REWRITE_TAC[POLAR_LT_TRANS]\r
THEN DOWN_TAC THEN MESON_TAC[POLAR_LT_TRANS];\r
REWRITE_TAC[TAUT`(a <=> b /\ a ) <=> a ==> b`] THEN \r
REPEAT STRIP_TAC THEN \r
UNDISCH_TAC ` ~({y | ?N. y = ITER N f p0 /\\r
                 (!n. 0 <= n ==> n < N ==> ITER n f p0 polar_lt y) /\\r
                 y polar_lt p} =\r
        {})`] THEN REWRITE_TAC[IMP_IMP] THEN DOWN THEN DOWN THEN\r
FIRST_ASSUM SUBST1_TAC THEN REPEAT STRIP_TAC THEN \r
SUBGOAL_THEN `(!x y. (SS:real ^2 -> bool) x /\ SS y /\ ~(x = y) ==> \r
lt x y \/ lt y x)` ASSUME_TAC THENL [\r
USE_FIRST `!x y. ((W:real^2 -> bool) x /\ W y) \r
/\ x polar_lt y <=> lt x y` (fun x -> REWRITE_TAC[\r
GSYM x ]) THEN UNDISCH_TAC` SS SUBSET (W: real^2 -> bool)` THEN \r
SET_TAC[NOT_EQ_IMP_TOTAL_ORDER];\r
SUBGOAL_THEN `(?m. (SS:real^2 -> bool) m /\ \r
(!x. SS x ==> lt x m \/ x = m)) ` ASSUME_TAC THENL\r
[FIRST_X_ASSUM MP_TAC THEN \r
UNDISCH_TAC` ! (x:real^2). ~ lt x x ` THEN \r
UNDISCH_TAC ` (!(x:real^2) y z. lt x y /\ \r
lt y z ==> lt x z) ` THEN \r
UNDISCH_TAC `~ ( (SS: real^2 -> bool ) = {})` THEN \r
UNDISCH_TAC `FINITE (SS: real^2 -> bool)` THEN \r
PHA THEN REWRITE_TAC[EXISTS_MAX_ELEMENT];\r
REWRITE_TAC[IN] THEN FIRST_X_ASSUM CHOOSE_TAC THEN \r
EXISTS_TAC `m: real^2` THEN ASM SET_TAC[]]]);;\r
\r
\r
\r
let VEC0_BOTH_LT_GT = prove(`\r
 y = vec 0 ==>  x polar_lt y /\ y polar_lt z `,\r
REWRITE_TAC[polar_lt] THEN DISCH_TAC THEN \r
SUBGOAL_THEN `(! ry ay. ~ (&0 < ry /\ (y:real^2) =\r
 vector[ ry * cos ay ; ry * sin ay ]))` ( fun x ->\r
ASM_MESON_TAC[x]) THEN NHANH REAL_LT_IMP_LE THEN \r
REPEAT STRIP_TAC THEN ASSUME_TAC2 (SPECL [` ay: real `\r
;` y: real^2`;` ry: real`] (GEN_ALL NORM_VECTOR2_TRIG))\r
  THEN DOWN_TAC THEN REWRITE_TAC[GSYM NORM_EQ_0] THEN \r
MESON_TAC[REAL_ARITH` ~( &0 < y /\ y = &0 )`]);;\r
\r
\r
\r
let POLAR_LT_TRANS = prove(` ~( y = vec 0 ) ==>\r
 x polar_lt y /\ y polar_lt z ==> x polar_lt z `,\r
MESON_TAC[POLAR_LT_TRANS; VEC0_BOTH_LT_GT]);;\r
\r
\r
\r
let PROVE_EXISTING_MAX_IN_CYCLIC_FINITE_SET =\r
prove(` ! (W: real^2 -> bool). FINITE W /\ ~( W = {} ) /\ \r
(! x. W x ==> ~( x = vec 0 )) ==>\r
? m. W m /\ (! x. W x ==> x polar_lt m \/ x = m ) `,\r
REPEAT STRIP_TAC THEN \r
ABBREV_TAC ` lt x y = ( W x /\ W y /\ x polar_lt y ) ` THEN \r
SUBGOAL_THEN `! x. ~ lt x (x:real^2) ` ASSUME_TAC THENL [\r
FIRST_X_ASSUM (fun s -> REWRITE_TAC[GSYM s]) THEN \r
GEN_TAC THEN REWRITE_TAC[DE_MORGAN_THM] THEN \r
ASM_CASES_TAC ` (W: real^2 -> bool) (x:real^2)` THENL [\r
DISJ2_TAC THEN DISJ2_TAC THEN \r
ASM_MESON_TAC[NO_V0_IMP_NOT_SELF_POLLAR]; ASM_SIMP_TAC[]];\r
SUBGOAL_THEN `(! x y z. ( lt: real^2 -> real^2 -> bool) x y\r
/\ lt y z ==> lt x z) /\ (! x y. W x /\ W y /\ ~ ( x = y )\r
==> lt x y \/ lt y x ) ` ASSUME_TAC] THENL [\r
DOWN THEN FIRST_X_ASSUM ( fun x -> REWRITE_TAC[GSYM x])\r
THEN SIMP_TAC[] THEN \r
DISCH_TAC THEN CONJ_TAC THENL [FIRST_X_ASSUM NHANH THEN \r
REPEAT STRIP_TAC THEN ASM_MESON_TAC[POLAR_LT_TRANS];\r
SIMP_TAC[NOT_EQ_IMP_TOTAL_ORDER]];\r
MP_TAC (ISPECL[`W:real^2 -> bool `;` lt: real^2 -> \r
real^2 -> bool `] EXISTS_MAX_ELEMENT) THEN ANTS_TAC THENL\r
[ASM_REWRITE_TAC[]; USE_FIRST `!x y. (W:real^2 -> bool) x /\ W y /\ \r
x polar_lt y <=> lt x y` (fun x -> REWRITE_TAC[ GSYM x]) THEN\r
MESON_TAC[]]]);;\r
\r
\r
\r
let PROVE_MIN_ELEMENT_IN_FINITE_CYCLIC_SET =\r
prove(` ! (W: real^2 -> bool). FINITE W /\ ~( W = {}) /\ \r
(! x. W x ==> ~ ( x = vec 0)) ==>\r
 ? n. W n /\ (! x. W x ==> n polar_lt x \/ n = x ) `,\r
REPEAT STRIP_TAC THEN \r
MP_TAC (BETA_RULE (ISPECL [`W:real^2 -> bool `;` (\x y. W x /\ \r
W y /\ y polar_lt x ) `]  EXISTS_MAX_ELEMENT)) THEN ANTS_TAC\r
THENL [ASM_MESON_TAC[POLAR_LT_TRANS; NO_V0_IMP_NOT_SELF_POLLAR\r
; NOT_EQ_IMP_TOTAL_ORDER]; MESON_TAC[]]);;\r
\r
\r
\r
\r
\r
\r
\r
let TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT = \r
prove(` ~((x:real^2) = vec 0 ) /\ ~( y = vec 0 ) ==> \r
~( x polar_lt y /\ y polar_lt x ) `,\r
MESON_TAC[NO_V0_IMP_NOT_SELF_POLLAR; POLAR_LT_TRANS]);;\r
\r
\r
\r
\r
let EXISTS_STEPS_FOR_FOLLOWING_POINTS = prove(\r
 ` ! W:real^2 -> bool. (! x. W x ==> ~ ( x = vec 0 )) /\\r
   FINITE W /\\r
   W p0 /\ \r
   f polar_cycle_on W /\ \r
   p0 polar_lt p /\ W p \r
==> ? n. ITER n f p0 = p /\ (! nn. nn < n ==> ITER nn f p0\r
polar_lt p ) `, REPEAT STRIP_TAC THEN \r
ABBREV_TAC ` SS = { y| ?N. (y:real^2) = ITER N f p0 /\\r
       (! n. 0 <= n /\ n < N ==> ITER n f p0 polar_lt y ) /\\r
      y polar_lt p} ` THEN MP_TAC (SPEC_ALL PROVE_XISTS_MAX_ELEMENT_LT_P)\r
THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; STRIP_TAC] THEN \r
UNDISCH_TAC `mx IN (SS: real^2 -> bool)` THEN \r
EXPAND_TAC "SS" THEN REWRITE_TAC[IN_ELIM_THM] THEN \r
STRIP_TAC THEN EXISTS_TAC ` N + 1` THEN \r
REWRITE_TAC[ARITH_RULE` n < b + 1 <=> n < b \/ n = b `;\r
MESON[]`(! x. P x \/ x = a ==> Q x ) <=> Q a /\ (! x. \r
P x ==> Q x )`] THEN REPLICATE_TAC 3 DOWN THEN PHA THEN \r
SIMP_TAC[ARITH_RULE` 0 <= n`] THEN \r
ASSUME_TAC2 ( SPEC `p0: real^2 ` ( GEN `p: real ^2 ` \r
POLAR_CYCLIC_FUN_IMP_ALL_BELONG)) THEN \r
ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN SIMP_TAC[] THEN DISCH_TAC\r
 THEN SUBGOAL_THEN `~ (mx:real^2 = vec 0) ` ASSUME_TAC\r
THENL [ASM SET_TAC[]; CONJ_TAC] THENL [ALL_TAC ;\r
ASM_MESON_TAC[POLAR_LT_TRANS]] THEN \r
ASM_CASES_TAC ` p polar_lt ( ITER ( N + 1) f p0 ) \/\r
p = ITER (N + 1) (f:real^2 -> real^2) p0` THEN \r
UNDISCH_TAC `f polar_cycle_on W ` THEN REWRITE_TAC[polar_cycle_on]\r
THEN STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC ` mx:real^2`)\r
THEN SUBGOAL_THEN ` mx IN (W: real^2 -> bool)` ASSUME_TAC\r
THENL [ASM_MESON_TAC[];\r
ANTS_TAC THENL [FIRST_X_ASSUM ACCEPT_TAC; STRIP_TAC] THENL\r
[FIRST_X_ASSUM DISJ_CASES_TAC THEN DOWN_TAC THEN \r
REWRITE_TAC[GSYM ADD1; ITER] THEN SET_TAC[];\r
DOWN_TAC THEN REWRITE_TAC[GSYM ADD1; ITER] THEN \r
STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN \r
SUBGOAL_THEN ` ~((p:real^2) = vec 0 ) ` ASSUME_TAC THENL\r
[ASM_MESON_TAC[]; SUBGOAL_THEN ` mx polar_lt f mx ` ASSUME_TAC]\r
THENL [ASM_MESON_TAC[POLAR_LT_TRANS]; \r
DOWN_TAC THEN REWRITE_TAC[polar_le] THEN \r
SET_TAC[TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT; \r
POLAR_LT_TRANS]]]; ASM_MESON_TAC[];\r
ANTS_TAC] THENL [FIRST_X_ASSUM ACCEPT_TAC;\r
DISCH_TAC THEN SE_ALL_TAC THEN \r
SUBGOAL_THEN ` ITER (N + 1) (f:real^2 -> real^2) p0 \r
polar_lt p ` ASSUME_TAC THENL [\r
SET_TAC[TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT; \r
NOT_EQ_IMP_TOTAL_ORDER; IN]; \r
SUBGOAL_THEN ` ITER (N + 1) (f:real^2 -> real^2) p0\r
IN SS` ASSUME_TAC]] THENL [\r
SUBGOAL_THEN ` mx polar_lt (f:real^2 -> real^2) mx `\r
ASSUME_TAC THENL [\r
FIRST_X_ASSUM DISJ_CASES_TAC THENL [ASM_SIMP_TAC[];\r
DOWN_TAC] THEN REWRITE_TAC[GSYM ADD1; ITER; polar_le] THEN \r
SET_TAC[TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT];\r
EXPAND_TAC "SS" THEN REWRITE_TAC[IN_ELIM_THM] THEN \r
EXISTS_TAC `N + 1 ` THEN DOWN_TAC THEN REWRITE_TAC[GSYM ADD1; ITER]\r
THEN STRIP_TAC THEN ASM_REWRITE_TAC[LE_0; LT]] THENL [\r
REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN\r
ASM SET_TAC[POLAR_LT_TRANS]; ASM SET_TAC[POLAR_LT_TRANS]];\r
SUBGOAL_THEN ` mx polar_lt (f:real^2 -> real^2) mx `\r
ASSUME_TAC THENL [FIRST_X_ASSUM DISJ_CASES_TAC THENL [ASM_SIMP_TAC[];\r
DOWN_TAC] THEN REWRITE_TAC[GSYM ADD1; ITER; polar_le] THEN \r
SET_TAC[TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT];\r
DOWN_TAC THEN REWRITE_TAC[GSYM ADD1; ITER] THEN \r
SET_TAC[TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT]]]);;\r
\r
\r
\r
let CARD_SING = prove(`! (x:A). CARD {x} = 1 `,\r
MP_TAC CARD_CLAUSES THEN STRIP_TAC THEN \r
GEN_TAC THEN FIRST_X_ASSUM (ASSUME_TAC o SPECL [` x: A `; ` {} : A -> bool `])\r
THEN SUBGOAL_THEN `FINITE ({} : A -> bool ) ` MP_TAC THENL\r
[ REWRITE_TAC[FINITE_EMPTY]; FIRST_X_ASSUM NHANH] THEN \r
ASM_SIMP_TAC[NOT_IN_EMPTY; ADD1; ADD_CLAUSES]);;\r
\r
\r
\r
\r
\r
let POLAR_LE_REFL_EQ = prove(` a polar_le b /\ b polar_le a \r
<=> a = b \/ a = vec 0 \/ b = vec 0 `, \r
REWRITE_TAC[polar_le] THEN \r
MESON_TAC[VEC0_BOTH_LT_GT; POLAR_LT_TRANS;\r
TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT]);;\r
\r
\r
let CHANGE ne ol = fun x ->  SPEC ne ( GEN ol x);;\r
\r
\r
let POLAR_MONOPOLY_IN_FIRST_ITERVAL =\r
prove(` (!x. W x ==> ~(x = vec 0)) /\\r
         FINITE W /\\r
         W p0 /\\r
         f polar_cycle_on W /\\r
    (!x. W x ==> p0 polar_le x ) /\\r
 i < CARD W - 1 ==>\r
ITER i f p0 polar_lt f (ITER i f p0) `,\r
ABBREV_TAC ` xx = ITER i f (p0: real^2) ` THEN STRIP_TAC\r
THEN SUBGOAL_THEN ` (xx: real^2) IN W ` ASSUME_TAC THENL [\r
ASM_MESON_TAC[POLAR_CYCLIC_FUN_IMP_ALL_BELONG]; \r
DOWN THEN USE_FIRST ` f polar_cycle_on W ` MP_TAC] THEN \r
REWRITE_TAC[polar_cycle_on] THEN STRIP_TAC THEN \r
FIRST_X_ASSUM NHANH THEN STRIP_TAC THEN \r
SUBGOAL_THEN ` FINITE {y | ? ii. ii <= i /\ y = ITER ii\r
f (p0: real^2)} ` ASSUME_TAC THENL [\r
SPEC_TAC (`i: num`,`i: num `) THEN INDUCT_TAC THENL [\r
REWRITE_TAC[LE; MESON[]`(?a. a = b /\ P a) <=> P b`; ITER\r
; SET_RULE[]` {x| x = a} = {a} `] THEN SIMP_TAC[FINITE_RULES];\r
REWRITE_TAC[ADD1; ARITH_RULE` a <= c + 1 <=> a <= c \/\r
a = c + 1 `; SET_RULE[]` {y| ? x. ( P x \/ x = a ) /\ y =  Q x } =\r
Q a INSERT {y | ? x. P x /\ y = Q x } `] THEN \r
ASM_SIMP_TAC[FINITE_RULES]];\r
ABBREV_TAC ` SS = {y | ?ii. ii <= i /\ y = ITER ii f (p0:real^2)}\r
`] THEN SUBGOAL_THEN ` W SUBSET (SS:real^2 -> bool)` ASSUME_TAC\r
THENL [REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN \r
ASM_CASES_TAC ` p0 = (x:real^2)` THENL [\r
EXPAND_TAC "x" THEN EXPAND_TAC "SS" THEN REWRITE_TAC[IN_ELIM_THM]\r
THEN EXISTS_TAC `0` THEN REWRITE_TAC[LE_0; ITER];\r
ALL_TAC] THEN \r
SUBGOAL_THEN`p0 polar_lt x ` ASSUME_TAC THENL [DOWN_TAC\r
THEN REWRITE_TAC[polar_le] THEN SET_TAC[]; ALL_TAC] THEN \r
MP_TAC (SPEC_ALL (CHANGE `x: real^2 ` `p:real^2 ` \r
EXISTS_STEPS_FOR_FOLLOWING_POINTS)) THEN ANTS_TAC THENL [\r
ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM IN] THEN \r
ASM_SIMP_TAC[]; STRIP_TAC] THEN\r
ASM_CASES_TAC ` n <= (i:num) ` THENL [EXPAND_TAC "SS"\r
THEN EXPAND_TAC "x" THEN REWRITE_TAC[IN_ELIM_THM] THEN \r
EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[]; DOWN] THEN \r
REWRITE_TAC[ARITH_RULE` ~( s <= h ) <=> (h:num) < s `] THEN \r
FIRST_ASSUM NHANH THEN \r
SUBGOAL_THEN ` x polar_le xx ` ASSUME_TAC THENL [\r
ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN DOWN THEN\r
REWRITE_TAC[polar_le] THEN  \r
ASM SET_TAC[NO_V0_IMP_NOT_SELF_POLLAR;\r
TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT]; SUBGOAL_THEN ` CARD (W:real^2 -> bool) <= CARD (SS: real^2\r
-> bool)` ASSUME_TAC THENL [ASM_MESON_TAC[CARD_SUBSET];\r
SUBGOAL_THEN ` CARD (SS: real^2 -> bool) <= i + 1 `\r
ASSUME_TAC]] THENL [UNDISCH_TAC `FINITE (SS:real^2 -> bool)` THEN \r
EXPAND_TAC "SS" THEN SPEC_TAC (`i:num`,`i:num`) THEN \r
INDUCT_TAC THENL [REWRITE_TAC[LE; SET_RULE[]` {y| ?x. x = 0 /\ y = P x }\r
= {P 0}`; ITER; CARD_SING; ADD; LE_REFL];\r
PAT_REWRITE_TAC `\a. b ==> a <= c ` [ADD1; ARITH_RULE ` a <= b + 1\r
 <=> a <= b \/ a = b + 1 `] THEN PAT_REWRITE_TAC `\x. x ==> h ` [ADD1;\r
ARITH_RULE ` a <= b + 1 <=> a <= b \/ a = b + 1 `] THEN \r
REWRITE_TAC[ADD1; SET_RULE[]` {y| ? x. (P x \/ x = a ) /\ y = Q x } =\r
Q a INSERT {y| ?x. P x /\ y = Q x } `; FINITE_INSERT] THEN \r
FIRST_X_ASSUM NHANH THEN \r
NHANH (let [a;b] = CONJUNCTS CARD_CLAUSES in \r
ISPEC ` ITER (i' + 1) f (p0: real^2) ` b) THEN \r
COND_CASES_TAC THENL [STRIP_TAC THEN ASM_REWRITE_TAC[]\r
THEN DOWN THEN CONV_TAC ARITH_RULE; STRIP_TAC THEN \r
ASM_REWRITE_TAC[] THEN DOWN THEN ARITH_TAC THEN ASM_MESON_TAC[\r
ARITH_RULE` i < CW - 1 /\ CW <= CS ==> ~( CS <= i + 1) `\r
]]]; ASM_MESON_TAC[\r
ARITH_RULE` i < CW - 1 /\ CW <= CS ==> ~( CS <= i + 1) `]]);;\r
\r
\r
\r
\r
let TRANS_SUC_IMP_INCREASE = prove(`! f. (! x y z. f x y /\ f y z ==> f x z ) /\\r
(! i. f i ( i + 1 )) ==>\r
(! i j. i < j ==> f i j ) `,\r
GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN INDUCT_TAC\r
THENL [REWRITE_TAC[LT; ARITH_RULE` i < SUC j <=> i < j \/ j = i `];\r
REWRITE_TAC[ARITH_RULE` i < SUC j <=> i < j \/ i = j `] THEN\r
ASM_MESON_TAC[ADD1]]);;\r
\r
\r
\r
\r
let MONOPOLY_IN_FIRST_PERIOD = prove(\r
` (!x. W x ==> ~(x = vec 0)) /\\r
         FINITE W /\\r
         W p0 /\\r
         f polar_cycle_on W /\\r
    (!x. W x ==> p0 polar_le x ) \r
==> (! i j. i < j /\ j < CARD W ==> \r
ITER i f p0 polar_lt ITER j f p0 ) `,\r
STRIP_TAC THEN GEN_TAC THEN INDUCT_TAC THENL [\r
REWRITE_TAC[LT]; REWRITE_TAC[LT]] THEN STRIP_TAC THENL\r
[ASM_REWRITE_TAC[ITER] THEN \r
MATCH_MP_TAC POLAR_MONOPOLY_IN_FIRST_ITERVAL THEN \r
ASM_REWRITE_TAC[ARITH_RULE` a < b - 1 <=> a + 1 < b `;\r
GSYM ADD1]; \r
UNDISCH_TAC `i < j /\ j < CARD (W:real^2 -> bool) ==> \r
ITER i f p0 polar_lt ITER j f p0` THEN ANTS_TAC THENL [\r
ASM_ARITH_TAC; DISCH_TAC]] THEN MP_TAC (\r
CHANGE `j:num ` `i:num` POLAR_MONOPOLY_IN_FIRST_ITERVAL)\r
THEN ANTS_TAC THENL [\r
ASM_REWRITE_TAC[ARITH_RULE` a < b - 1 <=> SUC a < b`]; \r
REWRITE_TAC[GSYM ITER]] THEN \r
SUBGOAL_THEN ` ~(ITER j f (p0: real^2) = vec 0 )` ASSUME_TAC\r
THENL [ASM SET_TAC[IN; POLAR_CYCLIC_FUN_IMP_ALL_BELONG];\r
ASM_MESON_TAC[POLAR_LT_TRANS]]);;\r
\r
\r
\r
let FINITE_SEUBSET_OF_NATURAL = prove(`! n. FINITE { f i | i < (n:num) } `,\r
INDUCT_TAC THENL [REWRITE_TAC[LT; SET_RULE[]` { f i | i | F } = {} `;\r
FINITE_RULES];\r
ASM_REWRITE_TAC[ARITH_RULE` i < SUC j <=> i < j \/ i = j `;\r
SET_RULE[]` {f i| P i \/ i = a } = f a INSERT {f i| P i }`;\r
FINITE_INSERT]]);;\r
\r
\r
let STRICTLY_INCREASE_PRESERVING_CARD = \r
prove(` ! lt f. (! (x:A) y. lt x y ==> ~( x = y )) /\\r
(! i (j: num). i < j ==> lt (f i ) ( f j )) ==>\r
(! n. CARD ({ f i | i < n }) = n ) `,\r
REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THENL [\r
REWRITE_TAC[LT; SET_RULE[]` { f i | i | F } = {} `;\r
CARD_CLAUSES];\r
ASM_SIMP_TAC[ARITH_RULE` i < SUC j <=> i < j \/ i = j `;\r
SET_RULE[]` {f i| P i \/ i = a } = f a INSERT {f i| P i }`;\r
CARD_CLAUSES; FINITE_SEUBSET_OF_NATURAL] THEN \r
SUBGOAL_THEN `~ ((f: num -> A) n IN {f i| i < n }) `\r
( fun x -> SIMP_TAC[x]) THEN REWRITE_TAC[IN_ELIM_THM] THEN \r
ASM_MESON_TAC[]]);;\r
\r
\r
\r
\r
\r
\r
\r
\r
\r
let XXXXX = prove(`!lt (f: num -> A).\r
         (!x y. lt x y ==> ~(x = y)) /\\r
         (!i j. i < j /\ j < N  ==> lt (f i) (f  j))\r
         ==> (!n. n < N ==> CARD {f i | i < n} = n)`,\r
REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THENL [\r
REWRITE_TAC[LT; EMPTY_GSPEC; SET_RULE[]` { f i| i | F } \r
= {} `; CARD_CLAUSES]; REWRITE_TAC[ARITH_RULE` i < SUC v <=> i < v \/ i = v `]]\r
THEN DISCH_TAC THEN REWRITE_TAC[\r
SET_RULE[]`{(f:num -> A) i| i < n \/ i = n } = \r
f n INSERT {f i | i < n } `] THEN \r
SIMP_TAC[FINITE_SEUBSET_OF_NATURAL; CARD_CLAUSES] THEN \r
SUBGOAL_THEN ` ~((f:num -> A) n IN { f i | i < n }) `\r
ASSUME_TAC THENL [REWRITE_TAC[IN_ELIM_THM] THEN\r
ASM_MESON_TAC[ARITH_RULE` SUC v < g ==> v < g `];\r
ASM_REWRITE_TAC[] THEN \r
ASM_MESON_TAC[ARITH_RULE` SUC x < y ==> x < y `]]);;\r
\r
\r
\r
\r
let TDHUFHCYVHYBCC = prove(`  (!x. W x ==> ~(x = vec 0)) /\\r
     FINITE W /\\r
     W p0 /\\r
     f polar_cycle_on W /\\r
     (!x. W x ==> p0 polar_le x)\r
==> (! n. n < CARD W ==>\r
CARD { y | ? i. i < n /\ y = ITER i f p0 } = n ) `,\r
STRIP_TAC THEN \r
REWRITE_TAC[SET_RULE[]` {y | ? i. i < n /\ y = ITER i f p0 \r
} = {ITER i f p0 | i < n } `] THEN \r
MATCH_MP_TAC (BETA_RULE (ISPECL [`CARD (W: real^2 -> bool) `\r
;`\x y. W x /\ W y /\ x polar_lt y `; `\i. ITER i f (p0:real^2) `] \r
(GEN_ALL XXXXX))) THEN \r
CONJ_TAC THENL [\r
ASM_MESON_TAC[POLAR_LT_IMP_NOT_EQ]; REPEAT STRIP_TAC]\r
THENL [\r
\r
ASM_REWRITE_TAC[SET_RULE[]` A ( p x ) <=> p x IN A `] THEN \r
ASM_MESON_TAC [POLAR_CYCLIC_FUN_IMP_ALL_BELONG];\r
\r
ASM_REWRITE_TAC[SET_RULE[]` A ( p x ) <=> p x IN A `] THEN \r
ASM_MESON_TAC [POLAR_CYCLIC_FUN_IMP_ALL_BELONG];\r
\r
MP_TAC MONOPOLY_IN_FIRST_PERIOD THEN \r
ANTS_TAC THENL [ASM_REWRITE_TAC[]; ASM_MESON_TAC[]]]);;\r
\r
\r
\r
let POLAR_CYCLIC_FUN_IMP_ALL_BELONG = \r
REWRITE_RULE[IN] POLAR_CYCLIC_FUN_IMP_ALL_BELONG;;\r
    \r
let CARD_W_AS_ALL_LESS_THAN_PERIODIC = prove(\r
` (!x. W x ==> ~(x = vec 0)) /\\r
     FINITE W /\\r
     W p0 /\\r
     f polar_cycle_on W /\\r
     (!x. W x ==> p0 polar_le x)\r
==> (! n. n = CARD W ==> CARD { y | ? i. i < n /\ y = ITER i f p0 } = n ) `,\r
SIMP_TAC[] THEN ASM_CASES_TAC ` CARD (W:real^2 -> bool) = 0 `\r
THENL [ASM_REWRITE_TAC[LT; EMPTY_GSPEC; CARD_CLAUSES];\r
ASM_SIMP_TAC[ARITH_RULE` ~( a = 0 ) ==> ( b < a <=> b <\r
a - 1 \/ b = a - 1 )`] THEN REPEAT STRIP_TAC THEN \r
REWRITE_TAC[SET_RULE[]` {y | ?i. (P i \/ i = a ) /\ y = Q i}\r
= Q a INSERT {y | ? i. P i /\ y = Q i }`]] THEN \r
SUBGOAL_THEN `FINITE {y | ?i. i < CARD (W:real^2 -> bool)\r
 - 1 /\ y = ITER i f (p0:real^2)} ` ASSUME_TAC THENL [\r
REWRITE_TAC[SET_RULE[]` {y | ?i . P i /\ y = Q i } = \r
{ Q i | P i } `] THEN \r
REWRITE_TAC[FINITE_SEUBSET_OF_NATURAL];\r
ASM_SIMP_TAC[CARD_CLAUSES] THEN COND_CASES_TAC THENL [\r
DOWN THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN \r
DOWN_TAC THEN \r
NHANH (ARITH_RULE `~( CARD W = 0 ) ==>  CARD (W:real^2 -> bool) - 1\r
< CARD W `) THEN STRIP_TAC THEN \r
SUBGOAL_THEN` ITER i f (p0:real^2) polar_lt ITER (CARD (W:\r
real^2 -> bool) - 1 ) f p0 ` ASSUME_TAC THENL [\r
ASM_MESON_TAC [MONOPOLY_IN_FIRST_PERIOD]; \r
ASM_MESON_TAC[POLAR_LT_IMP_NOT_EQ;\r
 MONOPOLY_IN_FIRST_PERIOD;\r
POLAR_CYCLIC_FUN_IMP_ALL_BELONG]]; DOWN_TAC] THEN \r
NHANH (ARITH_RULE` ~(x = 0 ) ==> x - 1 < x `) THEN \r
STRIP_TAC THEN MP_TAC TDHUFHCYVHYBCC THEN \r
ANTS_TAC THENL [ASM_REWRITE_TAC[]; \r
DISCH_THEN (MP_TAC o (SPEC ` CARD (W:real^2 -> bool)\r
- 1 `)) THEN \r
ANTS_TAC THENL [ASM_REWRITE_TAC[]; SIMP_TAC[] THEN \r
DISCH_TAC THEN UNDISCH_TAC `~( CARD (W:real^2 -> bool ) = 0)`\r
THEN ARITH_TAC]]]);;\r
\r
\r
\r
let AUTOMAP_IMP_ALL_ITER_IN = \r
prove(`W (p: A) /\ (! x. W x ==> f x IN W ) \r
==> (! N. ITER N f p IN W ) `,\r
STRIP_TAC THEN INDUCT_TAC THENL [\r
ASM_REWRITE_TAC[ITER; IN];\r
REWRITE_TAC[ITER] THEN ASM SET_TAC[]]);;\r
\r
\r
\r
let AUTOMAP_IMP_ITER_SET_IS_A_SUBSET = \r
prove(`W p /\ (! x. W x ==> f x IN W ) ==>\r
{y | ?n. y = ITER n f p } SUBSET W `,\r
STRIP_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN \r
ASM_MESON_TAC[AUTOMAP_IMP_ALL_ITER_IN]);;\r
\r
\r
\r
\r
\r
let TOW_NON_VEC0_POLAR_LE_IMP_NOT_LT = \r
prove(`~( x = vec 0 ) /\ ~( y = vec 0 ) /\ x polar_le y ==>\r
~( y polar_lt x ) `, REWRITE_TAC[polar_le] THEN \r
MESON_TAC[TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT;\r
NOT_EQ_IMP_TOTAL_ORDER;\r
NO_V0_IMP_NOT_SELF_POLLAR]);;\r
\r
\r
let CARD_W_IS_THE_PERIODIC = prove(` (!x. W x ==> ~(x = vec 0)) /\\r
     FINITE W /\\r
     W p0 /\\r
     f polar_cycle_on W /\\r
     (!x. W x ==> p0 polar_le x)\r
==> ITER (CARD W) f p0 = p0 `,\r
STRIP_TAC THEN MP_TAC CARD_W_AS_ALL_LESS_THAN_PERIODIC\r
THEN ANTS_TAC THENL [ASM_SIMP_TAC[]; \r
DISCH_THEN (MP_TAC o SPEC `CARD (W:real^2 -> bool)`)] THEN \r
REWRITE_TAC[] THEN \r
\r
\r
REWRITE_TAC[SET_RULE[]`{y | ?i. i < CARD W /\ y = ITER i f p0} =\r
{ITER i f p0 | i < CARD W }`] THEN SUBGOAL_THEN ` FINITE {ITER i f (p0:real^2) | \r
i < CARD (W:real^2 -> bool)}` ASSUME_TAC THENL [\r
REWRITE_TAC[FINITE_SEUBSET_OF_NATURAL]; \r
ABBREV_TAC ` WW =  {ITER i f (p0:real^2) | i < \r
CARD (W:real^2 -> bool ) }`] THEN \r
SUBGOAL_THEN ` WW SUBSET (W:real^2 -> bool) ` ASSUME_TAC\r
THENL [EXPAND_TAC "WW" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN]\r
THEN ASM_MESON_TAC[POLAR_CYCLIC_FUN_IMP_ALL_BELONG];\r
DISCH_TAC] THEN SUBGOAL_THEN `WW = (W:real^2 -> bool) ` ASSUME_TAC THENL\r
[ASM_MESON_TAC[CARD_SUBSET_EQ]; ALL_TAC] THEN \r
SUBGOAL_THEN `! (x:real^2). W x ==> x polar_le ITER (CARD\r
W - 1 ) f p0 ` ASSUME_TAC THENL [\r
\r
\r
EXPAND_TAC "W" THEN EXPAND_TAC "WW" THEN \r
REWRITE_TAC[IN_ELIM_THM] THEN \r
ASSUME_TAC2 (ISPEC` W: real^2 -> bool` CARD_EQ_0) THEN \r
ASM_CASES_TAC ` ~((W:real^2 -> bool) = {})` THENL [\r
\r
\r
\r
FIRST_X_ASSUM (SUBST_ALL_TAC o SYM) THEN GEN_TAC THEN \r
ASM_REWRITE_TAC[] THEN DOWN THEN \r
SIMP_TAC[ARITH_RULE` ~( x = 0 ) ==> ( c < x <=> c < x - 1 \r
\/ c = x - 1) `] THEN PHA THEN STRIP_TAC THENL [\r
\r
\r
ASM_REWRITE_TAC[] THEN \r
ASSUME_TAC2 (ARITH_RULE` ~(CARD W = 0) ==> \r
CARD (W:real^2 -> bool) - 1 < CARD W `) THEN \r
ASSUME_TAC2 MONOPOLY_IN_FIRST_PERIOD THEN \r
ASM_MESON_TAC[polar_le]; \r
\r
\r
\r
ASM_REWRITE_TAC[polar_le]]; \r
\r
\r
\r
DOWN THEN DOWN THEN MESON_TAC[LT]];\r
\r
\r
\r
\r
\r
\r
ASSUME_TAC2 (ISPEC` W: real^2 -> bool` CARD_EQ_0) THEN \r
ASSUME_TAC2 (SET_RULE[]`W p0 ==>\r
 ~((W:real^2 -> bool) = {})`) THEN \r
FIRST_X_ASSUM (SUBST_ALL_TAC o SYM) THEN DOWN THEN \r
SUBGOAL_THEN `W (ITER (CARD W - 1) f (p0:real^2))` ASSUME_TAC\r
THENL [ASM_MESON_TAC[POLAR_CYCLIC_FUN_IMP_ALL_BELONG];\r
NHANH (ARITH_RULE` ~( a = 0 ) ==> a = a - 1 + 1 `)] THEN \r
STRIP_TAC THEN SUBGOAL_THEN `ITER (CARD (W:real^2 -> bool)) f (p0:real^2)\r
= f (ITER ( CARD W - 1 ) f p0 )` ASSUME_TAC THENL [\r
REWRITE_TAC[GSYM ITER; ADD1] THEN DOWN THEN MESON_TAC[];\r
ALL_TAC]] THEN DOWN_TAC THEN REWRITE_TAC[polar_cycle_on]\r
THEN STRIP_TAC THEN \r
ABBREV_TAC ` AD = ITER (CARD (W:real^2 -> bool ) - 1)\r
 f (p0:real^2)` THEN \r
\r
\r
SUBGOAL_THEN ` f (AD: real^2) polar_le AD ` ASSUME_TAC\r
THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[];\r
\r
SUBGOAL_THEN `~( AD polar_lt f AD ) ` ASSUME_TAC THENL [\r
ASM SET_TAC[TOW_NON_VEC0_POLAR_LE_IMP_NOT_LT];\r
DOWN_TAC THEN REWRITE_TAC[IN] THEN STRIP_TAC]] THEN \r
UNDISCH_TAC `(W:real^2 -> bool) (AD:real^2 )` THEN \r
USE_FIRST ` !x. W (x:real^2 )\r
          ==> x polar_lt f x /\\r
              (!y. W y ==> ~(x polar_lt y /\ y polar_lt f x)) \/\r
              (!y. W y ==> f x polar_le y /\ y polar_le x)`\r
NHANH THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN \r
UNDISCH_TAC `(W:real^2 -> bool) p0 ` THEN \r
FIRST_X_ASSUM NHANH THEN ASM_MESON_TAC[POLAR_LE_REFL_EQ]);;\r
\r
\r
\r
\r
\r
\r
let ITER_CARD_W_IDENTIFICATION = prove(`\r
(!x. W x ==> ~(x = vec 0)) /\\r
     FINITE W /\\r
     W p0 /\\r
     f polar_cycle_on W /\\r
     (!x. W x ==> p0 polar_le x) \r
==> (! x. W x ==> ITER (CARD W) f x = x) `,\r
STRIP_TAC THEN STRIP_TAC THEN FIRST_ASSUM NHANH THEN \r
REWRITE_TAC[polar_le] THEN STRIP_TAC THENL [\r
MP_TAC (CHANGE `x:real^2 ` `p:real^2 ` (SPEC_ALL \r
EXISTS_STEPS_FOR_FOLLOWING_POINTS)) THEN \r
ANTS_TAC THENL [ASM_REWRITE_TAC[]; STRIP_TAC] THEN\r
EXPAND_TAC "x" THEN REWRITE_TAC[ITER_ADD] THEN \r
ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM ITER_ADD]\r
THEN MATCH_MP_TAC (MESON[]` a = b ==> P a = P b `) THEN\r
MATCH_MP_TAC CARD_W_IS_THE_PERIODIC THEN ASM_REWRITE_TAC[];\r
EXPAND_TAC "x" THEN MATCH_MP_TAC \r
CARD_W_IS_THE_PERIODIC THEN ASM_REWRITE_TAC[]]);;\r
\r
\r
\r
\r
let EXISTS_STEPS_FOR_FOLLOWING_POINTS = \r
prove(` (!x. W x ==> ~(x = vec 0)) /\\r
         FINITE W /\\r
         W p0 /\\r
         f polar_cycle_on W /\\r
         p0 polar_le p /\\r
         W p\r
         ==> (?n. ITER n f p0 = p /\\r
                  (!nn. nn < n ==> ITER nn f p0 polar_lt p))`,\r
REWRITE_TAC[polar_le] THEN STRIP_TAC THENL [\r
MP_TAC (SPEC_ALL EXISTS_STEPS_FOR_FOLLOWING_POINTS) THEN \r
ANTS_TAC THENL [ASM_REWRITE_TAC[]; REWRITE_TAC[]]; \r
EXISTS_TAC `0` THEN EXPAND_TAC "p" THEN REWRITE_TAC[ITER; LT]]);;\r
\r
\r
\r
\r
\r
\r
let EXISTS_STEPS_FOR_FOLLOWING_POINTS =\r
prove(` (!x. W x ==> ~(x = vec 0)) /\\r
     FINITE W /\\r
     W p0 /\\r
     f polar_cycle_on W /\\r
     p0 polar_le p /\\r
     W p\r
     ==> (?n. n < CARD W /\ \r
              ITER n f p0 = p /\ \r
              (!nn. nn < n ==> ITER nn f p0 polar_lt p))`,\r
NHANH EXISTS_STEPS_FOR_FOLLOWING_POINTS THEN \r
STRIP_TAC THEN ASM_CASES_TAC ` n < CARD (W:real^2 -> bool) ` THENL\r
[EXISTS_TAC `n: num ` THEN ASM_REWRITE_TAC[];\r
UNDISCH_TAC `(W:real^2 -> bool) p ` THEN \r
NHANH_PAT `\x. x ==> s ` (SET_RULE[]` S c ==> ~( S = {})`) THEN \r
ASSUME_TAC2 (ISPEC `W:real^2 -> bool ` CARD_EQ_0) THEN \r
FIRST_X_ASSUM (SUBST1_TAC o SYM) THEN DOWN THEN \r
NHANH (ARITH_RULE` ~( a < (b:num)) ==> a = a - b + b `) THEN \r
STRIP_TAC THEN STRIP_TAC THEN \r
ASSUME_TAC2 (ARITH_RULE` ~( n < CARD (W:real^2 -> bool))\r
 ==> ~( CARD W = 0 ) ==> n - CARD W < n `) THEN  \r
DOWN THEN FIRST_X_ASSUM NHANH THEN \r
SUBGOAL_THEN `ITER (n - CARD (W: real^2 -> bool)) f p0\r
= ITER ( n - CARD W + CARD W ) f (p0:real^2) ` ASSUME_TAC]\r
THENL [ REWRITE_TAC[GSYM ITER_ADD] THEN MP_TAC \r
(SPEC_ALL PROVE_MIN_ELEMENT_IN_FINITE_CYCLIC_SET) THEN \r
ANTS_TAC THENL [\r
ASSUME_TAC2 (SET_RULE[]` (W:real^2 -> bool) p ==>\r
~( W = {} ) `) THEN ASM_REWRITE_TAC[];\r
STRIP_TAC] THEN MP_TAC (CHANGE `n': real^2 ` `p0:real^2 ` \r
ITER_CARD_W_IDENTIFICATION) THEN \r
ANTS_TAC THENL [ASM_REWRITE_TAC[polar_le]; DISCH_TAC] THEN \r
UNDISCH_TAC ` (W:real^2 -> bool) p0 ` THEN \r
FIRST_X_ASSUM NHANH THEN SIMP_TAC[]; \r
DOWN THEN FIRST_X_ASSUM (SUBST1_TAC o SYM) THEN \r
ASM_MESON_TAC[POLAR_CYCLIC_FUN_IMP_ALL_BELONG;\r
NO_V0_IMP_NOT_SELF_POLLAR]]);;\r
\r
\r
\r
\r
let MONO_LE_IN_FIRST_PERIOD = prove(\r
`(!x. W x ==> ~(x = vec 0)) /\\r
       FINITE W /\\r
       W p0 /\\r
       f polar_cycle_on W /\\r
       (!x. W x ==> p0 polar_le x)\r
       ==> (!i j. i <= j /\ j < CARD W \r
==> ITER i f p0 polar_le ITER j f p0) `,\r
REWRITE_TAC[LE_LT; polar_le] THEN REPEAT STRIP_TAC THENL\r
[DISJ1_TAC THEN DOWN_TAC THEN REWRITE_TAC[GSYM polar_le]\r
THEN MESON_TAC[MONOPOLY_IN_FIRST_PERIOD; polar_le]; \r
DISJ2_TAC THEN ASM_REWRITE_TAC[]]);;\r
\r
\r
\r
\r
\r
\r
let POLAR_LE_NOT_VEC0_IMP_PL_ANG_LE = \r
prove(` x polar_le y /\ ~( x = vec 0 ) /\\r
~( y = vec 0 ) ==> pl_angle x <= pl_angle y `,\r
NHANH PL_ANGLE_PROPERTY THEN REWRITE_TAC[polar_le] THEN \r
STRIP_TAC THENL [UNDISCH_TAC ` x polar_lt y ` THEN \r
REWRITE_TAC[polar_lt; REAL_LE_LT] THEN \r
ASM_MESON_TAC[]; ASM_REWRITE_TAC[REAL_LE_REFL]]);;\r
\r
\r
\r
\r
let TWO_NOT_EQ_VECS_SUM_ARG_DIFF_TWO_PI = prove(\r
 ` ~( x = vec 0 ) /\ ~ (y = vec 0 ) /\ ~( x = y )==>\r
arg_diff x y + arg_diff y x = &2 * pi `, \r
NHANH_PAT `\x. a /\ b /\ x ==> kk ` NOT_EQ_IMP_TOTAL_ORDER THEN\r
NGOAC THEN REWRITE_TAC[arg_diff; polar_le] \r
THEN (let ttc = ASM_REWRITE_TAC[] THEN \r
ASSUME_TAC2 TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT THEN DOWN\r
THEN ASM_SIMP_TAC[DE_MORGAN_THM] THEN DISCH_TAC THEN \r
CONV_TAC (DEPTH_CONV let_CONV) THEN REAL_ARITH_TAC in \r
STRIP_TAC THENL [ttc ;ttc]));;\r
\r
\r
\r
let ARG_DIFF_SUCCESSIBLE_IN_FIRST_PERIOD = \r
prove(`!(W: real^2 -> bool ) xicm. FINITE W /\\r
     CARD W = n /\\r
     (!x. W x ==> ~(x = vec 0)) /\\r
     xicm polar_cycle_on W\r
     ==> (!p i j.\r
              W p /\ 0 <= i /\ i <= j /\ j < n\r
              ==> arg_diff p (ITER i xicm p) +\r
                  arg_diff (ITER i xicm p) (ITER j xicm p) =\r
                  arg_diff p (ITER j xicm p))`,\r
REPEAT STRIP_TAC THEN  \r
MP_TAC (SPEC_ALL PROVE_MIN_ELEMENT_IN_FINITE_CYCLIC_SET) THEN \r
ANTS_TAC THENL [\r
ASM_MESON_TAC[SET_RULE[]` A x ==> ~( A = {} ) `];\r
STRIP_TAC] THEN UNDISCH_TAC ` (W:real^2 -> bool) p ` THEN \r
FIRST_ASSUM NHANH THEN REWRITE_TAC[GSYM polar_le] THEN STRIP_TAC\r
THEN MP_TAC (CHANGE `n': real^2 ` `p0: real^2 ` \r
(CHANGE `xicm: real^2 -> real^2 ` `f:real^2 -> real^2 `\r
(SPEC_ALL EXISTS_STEPS_FOR_FOLLOWING_POINTS))) THEN ANTS_TAC\r
THENL [ASM_REWRITE_TAC[]; STRIP_TAC] THEN \r
ASM_CASES_TAC ` j + n'' < CARD (W:real^2 -> bool) `\r
THENL [\r
\r
UNDISCH_TAC ` i <= (j:num) ` THEN \r
NHANH (ARITH_RULE` (i:num) <= j ==> i + n'' <= j + n'' `) THEN \r
MP_TAC (CHANGE `xicm: real^2 -> real^2 ` `f:real^2 -> real^2 `\r
(CHANGE `n': real^2 ` `p0: real^2 ` MONO_LE_IN_FIRST_PERIOD)) THEN \r
ANTS_TAC THENL [ASM_REWRITE_TAC[polar_le]; \r
STRIP_TAC THEN STRIP_TAC] THEN \r
UNDISCH_TAC` j + n'' < CARD (W:real^2 -> bool) ` THEN \r
DOWN THEN \r
PHA THEN \r
FIRST_ASSUM NHANH THEN \r
NHANH (ARITH_RULE` a <= b /\ b < c ==> a < (c:num) `)  THEN \r
STRIP_TAC THEN \r
UNDISCH_TAC ` j + n'' < CARD (W:real^2 -> bool) ` THEN \r
MP_TAC (ARITH_RULE` n'' <= j + (n'':num) `) THEN \r
PHA THEN FIRST_ASSUM NHANH THEN \r
STRIP_TAC THEN \r
UNDISCH_TAC ` i + n'' < CARD (W:real^2 -> bool) ` THEN \r
MP_TAC (ARITH_RULE` n'' <= i + (n'':num) `) THEN \r
PHA THEN FIRST_ASSUM NHANH THEN \r
DOWN_TAC THEN \r
REWRITE_TAC[GSYM ITER_ADD] THEN \r
STRIP_TAC THEN \r
FIRST_X_ASSUM SUBST_ALL_TAC THEN \r
SUBGOAL_THEN ` pl_angle p <= pl_angle (ITER i xicm p) /\\r
pl_angle p <= pl_angle (ITER j xicm p ) /\\r
pl_angle (ITER i xicm p) <= pl_angle (ITER j xicm p) ` \r
ASSUME_TAC THENL [ASM_MESON_TAC[POLAR_CYCLIC_FUN_IMP_ALL_BELONG;\r
POLAR_LE_NOT_VEC0_IMP_PL_ANG_LE]; REWRITE_TAC[arg_diff] THEN\r
ASM_SIMP_TAC[] THEN CONV_TAC (DEPTH_CONV let_CONV) THEN \r
ARITH_TAC];\r
\r
\r
\r
\r
\r
ASM_CASES_TAC` i + n'' < CARD (W:real^2 ->  bool) `] THENL [\r
ASSUME_TAC2 (ARITH_RULE` ~( j + n'' < CARD (W: real^2 -> bool))\r
/\ j < n ==> CARD W = n ==> (j + n'') - CARD W < n''`) THEN \r
EXPAND_TAC "p" THEN \r
REWRITE_TAC[ITER_ADD] THEN \r
DOWN_TAC THEN \r
NHANH (ARITH_RULE` ~ (a < b )  ==> a - b + b = (a:num)`) THEN \r
ABBREV_TAC ` aa = j + (n'': num) ` THEN \r
STRIP_TAC THEN \r
EXPAND_TAC "aa" THEN \r
REWRITE_TAC[GSYM ITER_ADD] THEN \r
SUBGOAL_THEN `! x. W x ==> ITER (CARD (W:real^2 -> bool)) xicm x = x ` ASSUME_TAC\r
THENL [\r
MATCH_MP_TAC (CHANGE `n':real^2` `p0:real^2 ` ITER_CARD_W_IDENTIFICATION) THEN \r
ASM_REWRITE_TAC[polar_le]; \r
\r
\r
UNDISCH_TAC ` (W:real^2 -> bool) n' `] THEN \r
FIRST_ASSUM NHANH THEN \r
SIMP_TAC[] THEN \r
REWRITE_TAC[ITER_ADD] THEN \r
STRIP_TAC THEN \r
ASSUME_TAC2 (ARITH_RULE` i <= j /\ j < n /\ CARD (W:real^2 \r
-> bool) = n ==> i < CARD W `) THEN \r
ASSUME_TAC (ARITH_RULE` n'' <= i + (n'':num) `) THEN \r
ASSUME_TAC2 (ARITH_RULE` aa - CARD (W:real^2 -> bool) <\r
n'' ==> aa - CARD W < i + n'' `) THEN \r
\r
(*\r
POLAR_LE_NOT_VEC0_IMP_PL_ANG_LE;;\r
 \r
  |- x polar_le y /\ ~(x = vec 0) /\ ~(y = vec 0)\r
     ==> pl_angle x <= pl_angle y\r
\r
\r
POLAR_CYCLIC_FUN_IMP_ALL_BELONG;;\r
\r
 it : thm = |- W p /\ f polar_cycle_on W ==> (!n. W (ITER n f p))\r
\r
\r
MONO_LE_IN_FIRST_PERIOD;;\r
\r
*)\r
SUBGOAL_THEN` (ITER ( aa - CARD (W:real^2 -> bool)) xicm\r
(n':real^2) ) polar_lt (ITER n'' xicm n')/\\r
ITER ( aa - CARD W ) xicm n' polar_lt ITER (i + n'') xicm n'\r
 ` ASSUME_TAC THENL [\r
DOWN_TAC THEN REWRITE_TAC[IN; GSYM polar_le] THEN \r
ASM_MESON_TAC[MONOPOLY_IN_FIRST_PERIOD]; ALL_TAC] THEN \r
\r
\r
\r
\r
\r
SUBGOAL_THEN ` ITER n'' xicm n' polar_le ITER (i + n'')\r
xicm n'` ASSUME_TAC THENL \r
[DOWN_TAC THEN REWRITE_TAC[GSYM polar_le] THEN \r
ASM_MESON_TAC[MONO_LE_IN_FIRST_PERIOD]; ALL_TAC] THEN \r
\r
\r
\r
\r
\r
SUBGOAL_THEN ` ~(ITER (aa - CARD (W:real^2 -> bool)) xicm\r
(n':real^2) = vec 0 ) /\\r
~( ITER n'' xicm n' = vec 0 ) /\\r
~( ITER (i + n'') xicm n' = vec 0 )` ASSUME_TAC THENL [\r
ASM_MESON_TAC[POLAR_CYCLIC_FUN_IMP_ALL_BELONG]; ALL_TAC] THEN \r
\r
SUBGOAL_THEN ` ~(ITER n'' xicm n' polar_le ITER (aa - CARD (W:real^2 -> bool)) xicm n') /\\r
~( ITER (i + n'') xicm n' polar_le ITER ( aa - CARD W) xicm n')`\r
ASSUME_TAC THENL [ASM_MESON_TAC[\r
TOW_NON_VEC0_POLAR_LE_IMP_NOT_LT]; ALL_TAC] THEN \r
\r
ASM_REWRITE_TAC[arg_diff] THEN CONV_TAC (DEPTH_CONV let_CONV)\r
THEN REAL_ARITH_TAC; ALL_TAC] THEN DOWN THEN DOWN THEN\r
NHANH (ARITH_RULE` ~( a < (b:num)) ==> a = a - b + b `) THEN \r
\r
\r
SUBGOAL_THEN `(! (x:real^2). W x ==> ITER (CARD W) xicm x\r
= x) ` ASSUME_TAC THENL [\r
\r
MATCH_MP_TAC (CHANGE `n':real^2 ` `p0: real^2 ` (REWRITE_RULE[polar_le] \r
ITER_CARD_W_IDENTIFICATION)) THEN ASM_REWRITE_TAC[];\r
\r
ABBREV_TAC ` wi = (i + n'') - CARD (W:real^2 -> bool) `] THEN \r
ABBREV_TAC ` wj = (j + n'') - CARD (W:real^2 -> bool) ` THEN \r
EXPAND_TAC "p" THEN SIMP_TAC[ITER_ADD] THEN \r
REWRITE_TAC[GSYM ITER_ADD] THEN ASM_SIMP_TAC[] THEN \r
STRIP_TAC THEN STRIP_TAC THEN \r
SUBGOAL_THEN ` wi < (n'': num) /\ wj < n'' /\ wi <= wj\r
/\ wj < CARD (W:real^2 -> bool)` ASSUME_TAC THENL [\r
ASM_ARITH_TAC; ALL_TAC] THEN \r
\r
\r
SUBGOAL_THEN ` (ITER wi xicm n') polar_le (ITER wj xicm n')\r
/\ ITER wi xicm n' polar_lt ITER n'' xicm n' /\\r
ITER wj xicm n' polar_lt ITER n'' xicm n' ` ASSUME_TAC THENL [\r
DOWN_TAC THEN REWRITE_TAC[GSYM polar_le] THEN \r
MESON_TAC [MONOPOLY_IN_FIRST_PERIOD;\r
MONO_LE_IN_FIRST_PERIOD]; ALL_TAC] THEN \r
\r
SUBGOAL_THEN ` ~( ITER wi xicm (n':real^2) = vec 0 ) /\\r
~( ITER wj xicm n' = vec 0 ) /\ ~( ITER n'' xicm n' = vec 0) `\r
ASSUME_TAC THENL [\r
ASM_MESON_TAC[POLAR_CYCLIC_FUN_IMP_ALL_BELONG]; ALL_TAC] THEN \r
\r
SUBGOAL_THEN ` ~(ITER n'' xicm n' polar_le ITER wi xicm n') /\\r
     ~( ITER n'' xicm n' polar_le ITER wj xicm n')` ASSUME_TAC\r
THENL [DOWN THEN DOWN THEN MESON_TAC [\r
TOW_NON_VEC0_POLAR_LE_IMP_NOT_LT]; ALL_TAC] THEN \r
\r
\r
EXPAND_TAC "p" THEN REWRITE_TAC[arg_diff] THEN \r
ASM_REWRITE_TAC[] THEN CONV_TAC (DEPTH_CONV let_CONV) THEN \r
REAL_ARITH_TAC);;\r
\r
\r
\r
let TWO_NON_ZERO_VECS_NOT_EQ_EQ_PLT = \r
prove(` ~(x = vec 0) /\ ~(y = vec 0) ==> \r
(  ~(x = y) <=> x polar_lt y \/ y polar_lt x ) `,\r
MESON_TAC[POLAR_LT_IMP_NOT_EQ;NOT_EQ_IMP_TOTAL_ORDER]);;\r
\r
\r
\r
let SUM_OVER_W_EQUAL_AT_ANY_POINT = \r
prove(` FINITE W /\\r
     CARD W = n /\\r
     (!x. W x ==> ~(x = vec 0)) /\\r
     xicm polar_cycle_on W /\ W p0 /\\r
(! x. W x ==> p0 polar_le x )\r
==> (! p. W p ==>\r
sum (0.. n - 1 ) (\i. arg_diff ( ITER i xicm p ) (ITER ( i + 1 )\r
xicm p)) = \r
sum (0.. n - 1 ) (\i. arg_diff ( ITER i xicm p0 ) (ITER ( i + 1 )\r
xicm p0))) `,\r
REPEAT STRIP_TAC THEN DOWN THEN FIRST_ASSUM NHANH THEN \r
STRIP_TAC THEN ASSUME_TAC2 (\r
CHANGE `xicm: real^2 -> real^2 ` `f:real^2 -> real^2 `\r
EXISTS_STEPS_FOR_FOLLOWING_POINTS) THEN DOWN THEN STRIP_TAC\r
THEN ASM_CASES_TAC ` n' = 0 ` THENL [\r
FIRST_X_ASSUM SUBST_ALL_TAC THEN EXPAND_TAC "p" THEN \r
REWRITE_TAC[ITER_ADD; ADD_CLAUSES]; EXPAND_TAC "p"] THEN \r
REWRITE_TAC[ITER_ADD; ARITH_RULE` (i + 1) + n' =\r
(i + n' ) + 1 `] THEN ABBREV_TAC ` ff i = \r
arg_diff (ITER i xicm (p0:real^2)) (ITER (i + 1) xicm p0) `\r
  THEN REWRITE_TAC[GSYM SUM_OFFSET] THEN \r
ASSUME_TAC2 (ARITH_RULE` CARD (W:real^2 -> bool) = n /\\r
n' < CARD W ==> n' <= n - 1 + 1 `) THEN \r
ASM_SIMP_TAC[ADD; SUM_ADD_SPLIT] THEN \r
ASSUME_TAC2 (ISPEC `W:real^2 -> bool ` CARD_EQ_0) THEN (* 000 *)\r
ASSUME_TAC2 (SET_RULE[]` (W:real^2 -> bool) p ==>\r
~( W = {} ) `) THEN FIRST_X_ASSUM (SUBST_ALL_TAC o SYM) THEN \r
EXPAND_TAC "n" THEN DOWN THEN UNDISCH_TAC ` ~( n' = 0)` THEN \r
PHA THEN NHANH (ARITH_RULE` ~(a = 0) /\ ~( b = 0 ) ==>\r
b - 1 + 1 = 0 + b /\ b - 1 + a = a - 1 + b `) THEN \r
SIMP_TAC[] THEN STRIP_TAC THEN \r
REWRITE_TAC[SUM_OFFSET] THEN \r
SUBGOAL_THEN `! i. (ff: num -> real) (i + CARD (W:real^2 \r
-> bool)) = ff i ` ASSUME_TAC THENL [\r
DOWN_TAC THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN \r
SIMP_TAC[] THEN STRIP_TAC THEN \r
REWRITE_TAC[ARITH_RULE` (a + b ) + 1 = (a + 1 ) + b `] THEN \r
REWRITE_TAC[GSYM ITER_ADD] THEN \r
MP_TAC (CHANGE ` xicm: real^2 -> real^2 ` `f: real^2 -> real^2 `\r
ITER_CARD_W_IDENTIFICATION) THEN \r
ANTS_TAC THENL [ASM_SIMP_TAC[]; DISCH_TAC] THEN \r
UNDISCH_TAC `(W:real^2 -> bool) p0 ` THEN \r
FIRST_X_ASSUM NHANH THEN SIMP_TAC[];\r
ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN \r
MP_TAC (ISPECL[`ff: num -> real `;`0`;`n': num`;` n - 1 `]\r
SUM_COMBINE_L) THEN \r
ANTS_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[ETA_AX]]]);;\r
\r
\r
let SUM_INCREASE_ARG_DIFF = prove(\r
 ` !(W: real^2 -> bool ) xicm. FINITE W /\\r
     CARD W = n /\\r
     (!x. W x ==> ~(x = vec 0)) /\\r
     xicm polar_cycle_on W\r
     ==> (!p i j.\r
              W p /\ 0 <= i /\ i < j /\ j < n\r
              ==> sum (i .. (j - 1 )) (\i. arg_diff (ITER i xicm p) (ITER (i + 1) xicm p) )\r
            = arg_diff (ITER i xicm p) (ITER j xicm p)) `,\r
REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN GEN_TAC THEN \r
INDUCT_TAC THENL [REWRITE_TAC[LT]; REWRITE_TAC[LT]] THEN STRIP_TAC\r
THENL [ASM_REWRITE_TAC[SUC_SUB1; SUM_SING_NUMSEG; ADD1]; \r
DOWN THEN NHANH (ARITH_RULE` SUC c < k ==> c < k `)] THEN \r
STRIP_TAC THEN UNDISCH_TAC` j < (n:num) ` THEN \r
UNDISCH_TAC` i < (j:num)` THEN \r
UNDISCH_TAC` 0 <= i ` THEN \r
UNDISCH_TAC`(W:real^2 -> bool) p ` THEN \r
PHA THEN \r
FIRST_ASSUM NHANH THEN \r
NHANH (ARITH_RULE`0 <= i /\ i < j /\ j < n ==>\r
SUC j - 1 = (j - 1) + 1 `) THEN \r
SIMP_TAC[] THEN \r
NHANH (ARITH_RULE` i < j ==> i <= j - 1 + 1`) THEN\r
SIMP_TAC[SUM_ADD_SPLIT] THEN \r
NHANH (ARITH_RULE` i < j ==> j - 1 + 1 = j `) THEN \r
STRIP_TAC THEN \r
ASM_REWRITE_TAC[SUM_SING_NUMSEG; ADD1] THEN \r
MP_TAC (SPEC_ALL ARG_DIFF_SUCCESSIBLE_IN_FIRST_PERIOD) THEN \r
ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN \r
DISCH_THEN (MP_TAC o (SPECL [`ITER i xicm (p:real^2)`; ` j - (i: num) `;\r
` j - i + 1 `])) THEN ANTS_TAC THENL [\r
CONJ_TAC THENL [ASM_MESON_TAC[POLAR_CYCLIC_FUN_IMP_ALL_BELONG];\r
ASM_ARITH_TAC]; REWRITE_TAC[ITER_ADD]] THEN \r
ASSUME_TAC2 (ARITH_RULE` (i:num) < j ==> j - i + i = j `) THEN \r
ASSUME_TAC2 (ARITH_RULE` i < j ==> (j - i + 1) + i = j + 1 `) THEN \r
DOWN THEN DOWN THEN SIMP_TAC[]);;\r
\r
\r
\r
\r
let LEMMA_SUM_ALL_OVER_CYCLIC_SET = prove(`!(W: real^2 -> bool ) xicm. FINITE W /\\r
     CARD W = n /\\r
     (!x. W x ==> ~(x = vec 0)) /\\r
     xicm polar_cycle_on W /\ W p\r
     ==> ((?p q. W p /\ W q /\ ~(p = q))\r
     ==> sum (0..n - 1)\r
         (\i. arg_diff (ITER i xicm p) (ITER (i + 1) xicm p)) =\r
         &2 * pi)`,\r
REPEAT GEN_TAC THEN STRIP_TAC THEN \r
FIRST_ASSUM NHANH THEN \r
STRIP_TAC THEN \r
DOWN THEN \r
ASM_SIMP_TAC[TWO_NON_ZERO_VECS_NOT_EQ_EQ_PLT] THEN \r
REPLICATE_TAC 4 DOWN THEN \r
PHA THEN \r
\r
\r
\r
\r
SPEC_TAC (`q:real^2`, `q:real^2 `) THEN \r
SPEC_TAC (`p':real^2`, `p':real^2 `) THEN \r
REWRITE_TAC[MESON[]`(!x. P x ==> Q ) <=> (?x. P x ) ==> Q `;\r
MESON[]` (? x y. W x /\ ~( x = i ) /\ W y /\\r
~( y = i ) /\ (x polar_lt y \/ y polar_lt x) ) <=>\r
(? x y. W x /\ ~( x = i )/\ W y /\ ~( y = i ) /\ x polar_lt y ) `] THEN \r
STRIP_TAC THEN \r
MP_TAC (SPEC_ALL PROVE_MIN_ELEMENT_IN_FINITE_CYCLIC_SET) THEN \r
ANTS_TAC THENL [\r
ASM_MESON_TAC[SET_RULE[]` A s ==> ~(A = {})`];\r
\r
STRIP_TAC] THEN \r
\r
\r
\r
MP_TAC (CHANGE `n':real^2 ` `p0:real^2 ` \r
SUM_OVER_W_EQUAL_AT_ANY_POINT) THEN ANTS_TAC THENL [\r
ASM_REWRITE_TAC[polar_le]; DISCH_TAC] THEN \r
\r
\r
UNDISCH_TAC ` (W:real^2 -> bool) p ` THEN \r
FIRST_ASSUM NHANH THEN \r
SIMP_TAC[] THEN \r
STRIP_TAC THEN \r
ASM_CASES_TAC ` n' = (q:real^2) ` THENL [\r
\r
\r
ASM_MESON_TAC[TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT;\r
POLAR_LT_IMP_NOT_EQ]; \r
\r
MP_TAC (\r
CHANGE `q: real^2 ` `p:real^2 ` (\r
CHANGE `xicm: real^2 -> real^2 ` `f: real^2 -> real^ 2 ` (\r
CHANGE `n': real^2 ` `p0:real^2 ` EXISTS_STEPS_FOR_FOLLOWING_POINTS)))\r
   ] THEN \r
\r
ANTS_TAC THENL [\r
REWRITE_TAC[polar_le] THEN \r
ASM_MESON_TAC[]; STRIP_TAC] THEN \r
\r
\r
ASM_CASES_TAC `n'' = 0 ` THENL [\r
REPLICATE_TAC 5 DOWN THEN PHA THEN \r
MESON_TAC[ITER];\r
\r
ASSUME_TAC2 (ARITH_RULE`~( n'' = 0) ==> 0 <= n'' - 1 + 1 `)]\r
    THEN \r
\r
\r
\r
\r
ASSUME_TAC2 (ARITH_RULE` CARD (W:real^2 -> bool) = n /\\r
n'' < CARD W /\ ~(n'' = 0 ) ==> n'' - 1 <= n - 1 `) THEN \r
DOWN THEN DOWN THEN PHA THEN \r
NHANH (\r
\r
SPEC `(\i. arg_diff (ITER i xicm n') \r
(ITER (i + 1) xicm n'))` (GSYM SUM_COMBINE_R)) THEN \r
SIMP_TAC[] THEN \r
STRIP_TAC THEN \r
MP_TAC (SPEC_ALL SUM_INCREASE_ARG_DIFF) THEN \r
ANTS_TAC THENL [\r
ASM_REWRITE_TAC[];\r
STRIP_TAC] THEN \r
\r
\r
UNDISCH_TAC `n'' < CARD (W:real^2 -> bool) ` THEN \r
UNDISCH_TAC `~( n'' = 0 ) ` THEN \r
REWRITE_TAC[ ARITH_RULE`~(a = 0) <=> 0 < a `] THEN \r
MP_TAC (ARITH_RULE` 0 <= 0 `) THEN \r
UNDISCH_TAC `(W:real^2 -> bool) n'` THEN \r
PHA THEN \r
ASM_REWRITE_TAC[] THEN \r
FIRST_ASSUM NHANH THEN \r
SIMP_TAC[] THEN \r
STRIP_TAC THEN \r
ASSUME_TAC2 (\r
ARITH_RULE`0 < n'' /\ n'' < n ==> n - 1 = n - 1 - 1 + 1 `) THEN \r
FIRST_X_ASSUM (fun x -> ONCE_REWRITE_TAC[x]) THEN \r
ONCE_REWRITE_TAC[SUM_OFFSET] THEN \r
\r
REWRITE_TAC[BETA_THM; GSYM ITER_ADD] THEN \r
SUBGOAL_THEN ` (W:real^2 -> bool) (ITER 1 xicm (n':real^2)) ` MP_TAC\r
THENL [\r
ASM_SIMP_TAC[POLAR_CYCLIC_FUN_IMP_ALL_BELONG];\r
DISCH_TAC] THEN \r
ASSUME_TAC2 (ARITH_RULE` n'' < n ==> n - 1 < n `) THEN  \r
DOWN THEN \r
ASSUME_TAC2 (ARITH_RULE`0 < n'' /\ n'' < n ==>\r
n'' - 1 < n - 1 `) THEN \r
\r
\r
\r
\r
UNDISCH_TAC `n'' - 1 < n - 1 ` THEN \r
ASSUME_TAC2 (ARITH_RULE` 0 < n'' ==> 0 <= n'' - 1 `) THEN \r
DOWN THEN \r
DOWN THEN \r
PHA THEN \r
FIRST_ASSUM NHANH THEN \r
SIMP_TAC[ITER_ADD] THEN \r
STRIP_TAC THEN \r
ASSUME_TAC2 (ARITH_RULE` 0 < n'' ==> n'' - 1 + 1 = n''`) THEN \r
ASSUME_TAC2 (ARITH_RULE` n'' < n ==> n - 1 + 1 = n `) THEN \r
ASM_REWRITE_TAC[ITER] THEN \r
UNDISCH_TAC` CARD (W:real^2 -> bool) = n `  THEN \r
DISCH_TAC THEN EXPAND_TAC "n" THEN \r
MP_TAC (\r
CHANGE `xicm: real^2 -> real^2 ` `f:real^2 -> real^2 ` (\r
CHANGE `n': real^2 ` `p0:real^2 `ITER_CARD_W_IDENTIFICATION)\r
   ) THEN \r
\r
\r
\r
ANTS_TAC THENL [\r
ASM_REWRITE_TAC[polar_le];\r
DISCH_TAC] THEN \r
\r
UNDISCH_TAC` (W:real^2 -> bool) n' ` THEN \r
FIRST_ASSUM NHANH THEN \r
EXPAND_TAC "n" THEN \r
SIMP_TAC[] THEN \r
ASM_MESON_TAC[TWO_NOT_EQ_VECS_SUM_ARG_DIFF_TWO_PI]);;\r
\r
\r
parse_as_infix("re_eqvl",(12,"right"));;\r
\r
let re_eqvl = new_definition ` a re_eqvl (b:real)\r
 <=> (? t. &0 < t /\ a = t * b )`;;\r
\r
\r
let VEC_DIV_MOV = prove(\r
` ~( a = &0 ) ==> (( b / a ) % x = y <=>\r
b % x = a % y ) `,\r
SIMP_TAC[MESON[VECTOR_MUL_LCANCEL]` ~( a = &0 ) ==>\r
(( b / a ) % x = y <=> a % ( b / a) % x = a % y ) `;\r
VECTOR_MUL_ASSOC; REAL_DIV_LMUL]);;\r
\r
\r
\r
(* ======================================================== *)\r
(*          -----------------------------                   *)\r
let JBDNJJB = prove(\r
`! u v w. sin ( azim ( vec 0 ) u v w ) re_eqvl (u cross v ) dot w `,\r
\r
REPEAT GEN_TAC THEN ASM_CASES_TAC `(u:real^3) = vec 0 ` THENL [\r
ASM_SIMP_TAC[AZIM_DEGENERATE; CROSS_0; DOT_LZERO; \r
SIN_0; re_eqvl] THEN EXISTS_TAC `&1` THEN REAL_ARITH_TAC;\r
\r
\r
ASM_CASES_TAC` collinear {vec 0, u, (v:real^3)}`]\r
\r
THENL [\r
\r
\r
FIRST_X_ASSUM MP_TAC THEN ASM_SIMP_TAC[GSYM CROSS_EQ_0] THEN \r
REWRITE_TAC[CROSS_EQ_0] THEN \r
ASM_SIMP_TAC[AZIM_DEGENERATE; CROSS_0; DOT_LZERO;\r
SIN_0; re_eqvl] THEN \r
DISCH_TAC THEN \r
EXISTS_TAC `&1 ` THEN \r
REAL_ARITH_TAC;\r
\r
ASM_CASES_TAC` collinear {vec 0, u, (w:real^3)}`] THENL [\r
\r
FIRST_X_ASSUM MP_TAC THEN ASM_SIMP_TAC[GSYM CROSS_EQ_0] THEN \r
REWRITE_TAC[CROSS_EQ_0] THEN \r
ONCE_REWRITE_TAC[GSYM CROSS_TRIPLE] THEN \r
ONCE_REWRITE_TAC[SET_RULE[]` {a,b} = {b,a}`] THEN \r
ASM_SIMP_TAC[AZIM_DEGENERATE;GSYM CROSS_EQ_0] THEN \r
ASM_SIMP_TAC[CROSS_EQ_0] THEN \r
ASM_SIMP_TAC[AZIM_DEGENERATE; CROSS_0; DOT_LZERO; \r
SIN_0; re_eqvl; SET_RULE[]` {a,b} = {b,a}`] THEN \r
DISCH_TAC THEN \r
EXISTS_TAC `&1 ` THEN \r
REAL_ARITH_TAC;\r
ABBREV_TAC ` e3 = &1 / norm (u:real^3) % u ` THEN \r
ABBREV_TAC `v' = v - (e3 dot v) % (e3:real^3) ` THEN \r
ABBREV_TAC `(e1:real^3) = &1 / norm (v') % v' ` THEN \r
ABBREV_TAC ` e2 = e3 cross e1 ` THEN \r
SUBGOAL_THEN `orthonormal e1 e2 e3 ` ASSUME_TAC]\r
\r
THENL [\r
REWRITE_TAC[orthonormal] THEN \r
EXPAND_TAC "e2" THEN \r
REWRITE_TAC[DOT_CROSS_SELF; DOT_CROSS] THEN \r
SUBGOAL_THEN `~((v':real^3) = vec 0)` ASSUME_TAC THENL [\r
\r
\r
EXPAND_TAC "v'" THEN \r
EXPAND_TAC "e3" THEN \r
REWRITE_TAC[VECTOR_MUL_ASSOC] THEN \r
ASSUME_TAC2 (ISPECL [`u:real^3 `;` v:real^3 `] \r
 NOT_EQ_VEC0_IMP_EQU_AFF_COLL) THEN \r
UNDISCH_TAC `~ collinear {vec 0, u, (v:real^3)}` THEN \r
FIRST_X_ASSUM MP_TAC THEN \r
ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN \r
SIMP_TAC[] THEN \r
DISCH_TAC THEN \r
REWRITE_TAC[AFF2_VEC0; IN_ELIM_THM; VECTOR_ARITH` vec 0 =\r
x - y <=> x = y `] THEN \r
MESON_TAC[];\r
\r
\r
SUBGOAL_THEN `e3 dot (e3:real^3) = &1 /\ e1 dot (e1:real^3)\r
= &1 ` ASSUME_TAC] THENL [\r
\r
EXPAND_TAC "e3" THEN \r
EXPAND_TAC "e1" THEN \r
REWRITE_TAC[DOT_LMUL; DOT_RMUL; GSYM NORM_POW_2] THEN \r
UNDISCH_TAC `~((u:real^3) = vec 0 ) ` THEN \r
UNDISCH_TAC `~((v':real^3) = vec 0) ` THEN \r
REWRITE_TAC[GSYM NORM_EQ_0] THEN \r
PHA THEN CONV_TAC REAL_FIELD;\r
\r
\r
\r
SUBGOAL_THEN `e1 dot (e3: real^3) = &0 ` ASSUME_TAC] THENL [\r
\r
\r
EXPAND_TAC "e1" THEN \r
EXPAND_TAC "v'" THEN \r
REWRITE_TAC[DOT_LSUB; DOT_LMUL; REAL_MUL_RID] THEN \r
ASM_SIMP_TAC[REAL_MUL_RID; DOT_SYM; REAL_SUB_REFL;\r
REAL_MUL_RZERO];\r
\r
\r
\r
ASM_SIMP_TAC[DOT_SYM] THEN\r
ONCE_REWRITE_TAC[DOT_SYM] THEN \r
ONCE_REWRITE_TAC[GSYM CROSS_TRIPLE] THEN \r
EXPAND_TAC "e2" THEN \r
REWRITE_TAC[DOT_CROSS] THEN \r
ASM_SIMP_TAC[DOT_SYM] THEN \r
REAL_ARITH_TAC];\r
\r
MP_TAC (let ddd = (let dd = SPEC_ALL (SPECL [`v: real^3 `;` vec 0 : real^3 `;`u:real^3 `;\r
`w:real^3 `] SPHERICAL_COORDINATES) in SPEC `dist(vec 0, w:real^3 )`\r
(GEN `r:real` dd)) in\r
SPEC ` azim ( vec 0 ) u v w ` (GEN `theta: real` \r
(SPEC `arcV ( vec 0) w (u:real^3) ` (GEN `phi: real` ddd)))) THEN \r
ANTS_TAC] THENL [\r
\r
(* one new goal *)\r
(* ============ *)\r
\r
\r
ASM_REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN \r
EXPAND_TAC "e3" THEN \r
REWRITE_TAC[VECTOR_MUL_ASSOC] THEN \r
UNDISCH_TAC `~((u:real^3) = vec 0 ) ` THEN \r
SIMP_TAC[GSYM NORM_EQ_0; REAL_FIELD` ~( x = &0) ==>\r
x * &1 / x = &1 `; VECTOR_MUL_LID] THEN \r
SUBGOAL_THEN `DISJOINT {vec 0, u} {v:real^3 }` ASSUME_TAC\r
\r
\r
THENL [\r
\r
\r
\r
REWRITE_TAC[DISJOINT; SET_RULE[]` {a,b} INTER {c} = {}\r
<=> ~( c = a ) /\ ~( c = b ) `] THEN \r
(let drt = STRIP_TAC THEN \r
UNDISCH_TAC `~ collinear { vec 0, u, (v:real^3)} ` THEN \r
ASM_SIMP_TAC[INSERT_AC; COLLINEAR_2] in CONJ_TAC THENL [drt;\r
drt]);\r
\r
\r
FIRST_X_ASSUM MP_TAC THEN \r
NHANH AFF_GT_2_1 THEN \r
PHA THEN SIMP_TAC[] THEN \r
STRIP_TAC THEN \r
REWRITE_TAC[IN_ELIM_THM] THEN \r
EXPAND_TAC "e1" THEN \r
EXPAND_TAC "v'" THEN \r
SIMP_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID;\r
VECTOR_SUB_LDISTRIB] THEN \r
SUBGOAL_THEN `~( v - (e3 dot v) % (e3:real^3)\r
= vec 0) ` ASSUME_TAC] THENL [\r
\r
\r
\r
EXPAND_TAC "e3" THEN \r
REWRITE_TAC[VECTOR_MUL_ASSOC] THEN \r
UNDISCH_TAC `~ collinear {vec 0, u, (v:real^3)}` THEN \r
FIRST_X_ASSUM MP_TAC THEN \r
REWRITE_TAC[NORM_EQ_0] THEN \r
PAT_ONCE_REWRITE_TAC `\x. x ==> _ ` [EQ_SYM_EQ] THEN \r
NHANH (GSYM (ISPECL [`u:real^3 `;` v:real^3 `] NOT_EQ_VEC0_IMP_EQU_AFF_COLL)) THEN \r
SIMP_TAC[] THEN DISCH_TAC THEN \r
REWRITE_TAC[AFF2_VEC0; IN_ELIM_THM; VECTOR_SUB_EQ] THEN \r
MESON_TAC[];\r
\r
\r
ABBREV_TAC `r3 = e3 dot (v:real^3 ) ` THEN \r
REWRITE_TAC[VECTOR_MUL_ASSOC] THEN \r
ABBREV_TAC `e33 = r3 % (e3: real^3) ` THEN \r
EXPAND_TAC "e3" THEN \r
REWRITE_TAC[VECTOR_MUL_ASSOC] THEN \r
EXISTS_TAC ` &1 - &1 / norm ((v:real^3 ) -\r
e33) + (&1 / norm ((v:real^3) - e33) * r3) * &1 / norm (u:real^3) ` THEN \r
EXISTS_TAC `-- (&1 / norm ((v:real^3) - e33) * r3) * &1 / norm (u:real^3)` THEN \r
EXISTS_TAC `&1 / norm ((v:real^3) - e33)` THEN \r
CONJ_TAC THENL [\r
\r
\r
MATCH_MP_TAC REAL_LT_DIV THEN \r
UNDISCH_TAC `~((v:real^3) - e33 = vec 0) ` THEN \r
REWRITE_TAC[GSYM NORM_POS_LT] THEN \r
SIMP_TAC[] THEN REAL_ARITH_TAC;\r
CONJ_TAC THENL [REAL_ARITH_TAC;\r
CONV_TAC VECTOR_ARITH]]];\r
\r
\r
SUBGOAL_THEN `~( v - (e3 dot v) % (e3:real^3)\r
= vec 0) ` ASSUME_TAC THENL [\r
\r
\r
EXPAND_TAC "e3" THEN \r
REWRITE_TAC[VECTOR_MUL_ASSOC] THEN \r
UNDISCH_TAC `~ collinear {vec 0, u, (v:real^3)}` THEN \r
UNDISCH_TAC ` ~( (u:real^3) = vec 0) ` THEN \r
REWRITE_TAC[NORM_EQ_0] THEN \r
PAT_ONCE_REWRITE_TAC `\x. x ==> _ ` [EQ_SYM_EQ] THEN \r
NHANH (GSYM (ISPECL [`u:real^3 `;` v:real^3 `] NOT_EQ_VEC0_IMP_EQU_AFF_COLL)) THEN \r
SIMP_TAC[] THEN DISCH_TAC THEN \r
REWRITE_TAC[AFF2_VEC0; IN_ELIM_THM; VECTOR_SUB_EQ] THEN \r
MESON_TAC[];\r
\r
\r
\r
SUBST_ALL_TAC (SYM (ISPEC `u:real^3 ` NORM_EQ_0))]] THEN \r
\r
\r
\r
ASSUME_TAC2 (ISPECL [`&1 `;` u: real^3 `; ` norm (u:real^3)`\r
; `e3: real^3`] (GEN_ALL VEC_DIV_MOV)) THEN \r
SUBST_ALL_TAC (ISPEC `u:real^3 ` VECTOR_MUL_LID) THEN \r
FIRST_X_ASSUM SUBST_ALL_TAC THEN \r
ABBREV_TAC ` azzz = azim (vec 0) u v w ` THEN \r
ABBREV_TAC `arrr = arcV (vec 0) w (u:real^3)` THEN \r
ABBREV_TAC ` diii = dist( vec 0, (w:real^3))` THEN \r
\r
SIMP_TAC[VECTOR_ADD_LID] THEN \r
DISCH_TAC THEN \r
ABBREV_TAC `no_u = norm (u:real^3)` THEN \r
ASM_REWRITE_TAC[] THEN \r
UNDISCH_TAC ` (v:real^3) - (e3 dot v ) %e3 \r
= v' ` THEN \r
ABBREV_TAC ` era = e3 dot (v:real^3) ` THEN \r
REWRITE_TAC[VECTOR_ARITH` a - b = (x:real^N) <=>\r
a = x + b `] THEN \r
SIMP_TAC[CROSS_RADD; CROSS_RMUL; CROSS_LMUL;\r
CROSS_REFL; VECTOR_MUL_RZERO; VECTOR_ADD_RID] THEN \r
REWRITE_TAC[VECTOR_ARITH` a = b + (c:real^N) <=>\r
a - c = b `] THEN \r
DISCH_THEN SUBST_ALL_TAC THEN \r
UNDISCH_TAC ` &1 / norm v' % (v':real^3) = e1 ` THEN \r
UNDISCH_TAC `~((v':real^3) = vec 0 ) ` THEN \r
SIMP_TAC[GSYM NORM_EQ_0; VEC_DIV_MOV; VECTOR_MUL_LID] THEN \r
ABBREV_TAC `nov' = norm (v':real^3) ` THEN \r
SIMP_TAC[CROSS_RMUL] THEN \r
STRIP_TAC THEN \r
STRIP_TAC THEN \r
ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; DOT_RADD; DOT_RMUL;\r
DOT_LMUL] THEN \r
UNDISCH_TAC `orthonormal e1 e2 e3 ` THEN \r
REWRITE_TAC[orthonormal] THEN \r
SIMP_TAC[DOT_SYM; REAL_MUL_RZERO; REAL_ADD_LID; REAL_ADD_RID] THEN \r
DISCH_TAC THEN \r
REWRITE_TAC[REAL_ARITH`(a * b * c ) * (d * e ) * &1\r
= (a * c * d * e ) * b `; re_eqvl] THEN \r
EXISTS_TAC ` &1 / ( diii * sin arrr * no_u * nov') ` THEN \r
\r
SUBGOAL_THEN ` &0 < diii * sin arrr * no_u * nov' `\r
ASSUME_TAC THENL [\r
\r
\r
MATCH_MP_TAC (\r
MESON[REAL_LT_MUL]` &0 < a /\ &0 < b /\ &0 < c /\ &0 < d \r
==> &0 < b * a * c * d `) THEN \r
CONJ_TAC THENL [EXPAND_TAC "arrr" THEN \r
UNDISCH_TAC `~ collinear {vec 0, u, (w:real^3)}` THEN \r
SIMP_TAC[ARC_SYM; NOT_COLL_IM_SIN_LT]; \r
UNDISCH_TAC `~(no_u = &0) `] THEN \r
UNDISCH_TAC ` ~(nov' = &0)` THEN \r
UNDISCH_TAC `~ collinear {vec 0, u, (w:real^3)}` THEN \r
NHANH NOT_COLLINEAR_IMP_2_UNEQUAL THEN STRIP_TAC THEN \r
FIRST_X_ASSUM MP_TAC THEN SIMP_TAC[DIST_NZ] THEN \r
EXPAND_TAC "diii" THEN EXPAND_TAC "no_u" THEN EXPAND_TAC "nov'" THEN \r
PHA THEN CONV_TAC NORM_ARITH; CONJ_TAC] THENL [\r
\r
MATCH_MP_TAC REAL_LT_DIV THEN \r
FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC;\r
\r
FIRST_X_ASSUM MP_TAC THEN NHANH REAL_POS_NZ THEN SIMP_TAC[REAL_MUL_RID] THEN \r
ONCE_REWRITE_TAC[REAL_RING`a * no * nv * di * az * z = az * a * (di * z * no * nv) `] THEN \r
SIMP_TAC[NOT_0_INVERTABLE; REAL_MUL_RID]]);;\r
\r
\r
let SET_TAC =\r
let basicthms =\r
[NOT_IN_EMPTY; IN_UNIV; IN_UNION; IN_INTER; IN_DIFF; IN_INSERT;\r
IN_DELETE; IN_REST; IN_INTERS; IN_UNIONS; IN_IMAGE] in\r
let allthms = basicthms @ map (REWRITE_RULE[IN]) basicthms @\r
[IN_ELIM_THM; IN] in\r
let PRESET_TAC =\r
TRY(POP_ASSUM_LIST(MP_TAC o end_itlist CONJ)) THEN\r
REPEAT COND_CASES_TAC THEN\r
REWRITE_TAC[EXTENSION; SUBSET; PSUBSET; DISJOINT; SING] THEN\r
REWRITE_TAC allthms in\r
fun ths ->\r
PRESET_TAC THEN\r
(if ths = [] then ALL_TAC else MP_TAC(end_itlist CONJ ths)) THEN\r
MESON_TAC[];;\r
let SET_RULE tm = prove(tm,SET_TAC[]);;\r
\r
\r
\r
\r
let ISRTTNZ = prove(` FINITE W /\\r
         CARD W = n /\\r
         (!x. W x ==> ~(x = vec 0)) /\\r
         xicm polar_cycle_on W /\\r
         W p /\ (?p q. W p /\ W q /\ ~(p = q))\r
         ==> sum (0..n - 1)\r
             (\i. arg_diff (ITER i xicm p) (ITER (i + 1) xicm p)) =\r
             &2 * pi /\\r
(!p i j.\r
              W p /\ 0 <= i /\ i <= j /\ j < n\r
              ==> arg_diff p (ITER i xicm p) +\r
                  arg_diff (ITER i xicm p) (ITER j xicm p) =\r
                  arg_diff p (ITER j xicm p))  `, STRIP_TAC THEN \r
MP_TAC (SPEC_ALL ARG_DIFF_SUCCESSIBLE_IN_FIRST_PERIOD) THEN \r
ANTS_TAC THENL [ASM_REWRITE_TAC[]; SIMP_TAC[]] THEN DISCH_TAC\r
THEN MP_TAC (SPEC_ALL LEMMA_SUM_ALL_OVER_CYCLIC_SET) THEN PHA THEN \r
ANTS_TAC THENL [ ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[];\r
SIMP_TAC[]]);;\r
\r
\r
end;;\r