1 (* ========================================================================== *)
\r
2 (* FLYSPECK - BOOK FORMALIZATION *)
\r
4 (* Chapter: Trigonometry *)
\r
5 (* Author: Nguyen Quang Truong *)
\r
6 (* Date: 2010-02-09 *)
\r
7 (* ========================================================================== *)
\r
11 module type Trigonometry2_type = sig
\r
15 flyspeck_needs "general/sphere.hl";;
\r
16 flyspeck_needs "leg/collect_geom.hl";;
\r
17 flyspeck_needs "trigonometry/trig1.hl";;
\r
19 module Trigonometry2 (* : Trigonometry2_type *) = struct
\r
23 let delta_x4 = Sphere.delta_x4;;
\r
24 let atn2 = Sphere.atn2;;
\r
25 (* let beta = Sphere.beta;; *)
\r
26 let aff = Sphere.aff;;
\r
27 let cyclic_set = Sphere.cyclic_set;;
\r
28 let ups_x = Sphere.ups_x;;
\r
30 let COL_EQ_UPS_0 = Collect_geom.COL_EQ_UPS_0;;
\r
32 let acs_atn2 = Trigonometry1.acs_atn2;;
\r
34 let BY = Hales_tactic.BY;;
\r
36 (* ========== QUANG TRUONG ========== *)
\r
37 let cosV = new_definition` cosV u v = (u dot v) / (norm u * norm v) `;;
\r
38 let sinV = new_definition` sinV u v = sqrt ( &1 - cosV u v pow 2 ) `;;
\r
43 [NOT_IN_EMPTY; IN_UNIV; IN_UNION; IN_INTER; IN_DIFF; IN_INSERT;
\r
44 IN_DELETE; IN_REST; IN_INTERS; IN_UNIONS; IN_IMAGE] in
\r
45 let allthms = basicthms @ map (REWRITE_RULE[IN]) basicthms @
\r
46 [IN_ELIM_THM; IN] in
\r
48 TRY(POP_ASSUM_LIST(MP_TAC o end_itlist CONJ)) THEN
\r
49 REPEAT COND_CASES_TAC THEN
\r
50 REWRITE_TAC[EXTENSION; SUBSET; PSUBSET; DISJOINT; SING] THEN
\r
51 REWRITE_TAC allthms in
\r
54 (if ths = [] then ALL_TAC else MP_TAC(end_itlist CONJ ths)) THEN
\r
57 let SET_RULE tm = prove(tm,SET_TAC[]);;
\r
59 let PHA = REWRITE_TAC[ MESON[] ` (a/\b)/\c <=> a/\ b /\ c `; MESON[]`
\r
60 a ==> b ==> c <=> a /\ b ==> c `];;
\r
62 let NGOAC = REWRITE_TAC[ MESON[] ` a/\b/\c <=> (a/\b)/\c `];;
\r
64 let DAO = NGOAC THEN REWRITE_TAC[ MESON[]` a /\ b <=> b /\ a`];;
\r
66 let PHAT = REWRITE_TAC[ MESON[] ` (a\/b)\/c <=> a\/b\/c `];;
\r
68 let NGOACT = REWRITE_TAC[ GSYM (MESON[] ` (a\/b)\/c <=> a\/b\/c `)];;
\r
70 let KHANANG = PHA THEN REWRITE_TAC[ MESON[]` ( a\/ b ) /\ c <=> a /\ c \/ b /\ c `] THEN
\r
71 REWRITE_TAC[ MESON[]` a /\ ( b \/ c ) <=> a /\ b \/ a /\ c `];;
\r
73 let ATTACH thm = MATCH_MP (MESON[]` ! a b. ( a ==> b ) ==> ( a <=> a /\ b )`) thm;;
\r
75 let NHANH tm = ONCE_REWRITE_TAC[ ATTACH (SPEC_ALL ( tm ))];;
\r
76 let LET_TR = CONV_TAC (TOP_DEPTH_CONV let_CONV);;
\r
78 let DOWN_TAC = REPEAT (FIRST_X_ASSUM MP_TAC) THEN REWRITE_TAC[IMP_IMP] THEN PHA;;
\r
79 let IMP_IMP_TAC = REWRITE_TAC[GSYM IMP_IMP] ;;
\r
84 let NOT_EQ_IMPCOS_ARC = prove(`~( v0 = (u:real^N) ) /\ ~ ( v0 = w ) ==> cos (arcV v0 u w) =
\r
85 ((u - v0) dot (w - v0)) / (norm (u - v0) * norm (w - v0))`,
\r
86 REWRITE_TAC[GSYM VECTOR_SUB_EQ; GSYM NORM_EQ_0] THEN
\r
87 NHANH (MESON[NORM_POS_LE]` ~(norm (x:real^N) = &0 ) ==> &0 <= norm x `) THEN
\r
88 REWRITE_TAC[REAL_ARITH` ~ ( a = &0 ) /\ &0 <= a <=>
\r
90 SIMP_TAC[NORM_SUB] THEN
\r
91 MP_TAC (SPECL[` u - (v0:real^N)`; `v0 - (w :real^N) `] NORM_CAUCHY_SCHWARZ_ABS) THEN
\r
92 NHANH (REAL_LT_MUL) THEN PHA THEN
\r
93 REWRITE_TAC[MESON[REAL_LE_DIV2_EQ; REAL_FIELD ` &0 < a ==> a / a = &1 `]` a <= b /\ l1 /\ l2 /\ &0 < b <=>
\r
94 a / b <= &1 /\ l1 /\ l2 /\ &0 < b `] THEN
\r
95 NHANH (MESON[REAL_LT_IMP_LE; REAL_ABS_REFL; REAL_ABS_DIV]`
\r
96 abs b / a <= &1 /\ l1 /\ l2 /\ &0 < a ==>
\r
97 abs ( b / a ) <= &1 `) THEN
\r
98 ONCE_REWRITE_TAC[ GSYM REAL_ABS_NEG] THEN
\r
99 REWRITE_TAC[REAL_ARITH` -- ( a / b ) = ( --a ) / b `;
\r
100 VECTOR_ARITH` --((u - v0) dot (v0 - w)) = ((u - v0) dot (w - v0)) `] THEN
\r
101 REWRITE_TAC[REAL_ABS_BOUNDS; arcV] THEN
\r
102 SIMP_TAC[NORM_SUB] THEN MESON_TAC[COS_ACS]);;
\r
106 let COLLINEAR_TRANSABLE = prove(
\r
107 `collinear {(a:real^N), b, c} <=> collinear {vec 0, b - a, c - a}`,
\r
108 REWRITE_TAC[collinear; IN_INSERT; NOT_IN_EMPTY] THEN EQ_TAC THENL
\r
109 [STRIP_TAC THEN EXISTS_TAC `u: real^N` THEN REPEAT GEN_TAC THEN
\r
110 ASM_MESON_TAC[VECTOR_ARITH` ( a - c ) - ( b - c ) = a - (b:real^N)`;
\r
111 VECTOR_SUB_REFL; VECTOR_ARITH` vec 0 - ( a - b ) = b - a `;
\r
112 VECTOR_ARITH` a - vec 0 = a `]; STRIP_TAC THEN EXISTS_TAC `u:real^N`
\r
113 THEN REPEAT GEN_TAC] THEN ASM_MESON_TAC[VECTOR_ARITH` ( a - c ) - ( b - c ) = a - (b:real^N)`;
\r
114 VECTOR_SUB_REFL; VECTOR_ARITH` vec 0 - ( a - b ) = b - a `;
\r
115 VECTOR_ARITH` a - vec 0 = a `]);;
\r
121 let ALLEMI_COLLINEAR = prove(`((vc - v0) dot ((vc: real^N) - v0)) % (va - v0) =
\r
122 ((va - v0) dot (vc - v0)) % (vc - v0)
\r
123 ==> collinear {v0, vc, va}`,
\r
124 ASM_CASES_TAC ` (vc - v0) dot (vc - (v0:real^N)) = &0 ` THENL
\r
125 [FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[DOT_EQ_0; VECTOR_SUB_EQ] THEN
\r
126 SIMP_TAC[INSERT_INSERT; COLLINEAR_2]; FIRST_X_ASSUM MP_TAC THEN
\r
127 PHA THEN NHANH (MESON[]` ~( a = &0 ) /\ b = c ==> &1 / a % b =
\r
128 &1 / a % c `) THEN SIMP_TAC[VECTOR_MUL_ASSOC] THEN PHA THEN
\r
129 ONCE_REWRITE_TAC[MESON[]` a /\b ==> c <=> a ==> b ==> c `] THEN
\r
130 SIMP_TAC[REAL_FIELD` ~ ( a = &0 ) ==> &1 / a * a = &1 `;
\r
131 VECTOR_MUL_LID] THEN ONCE_REWRITE_TAC[COLLINEAR_TRANSABLE ] THEN
\r
132 MESON_TAC[COLLINEAR_LEMMA]]);;
\r
135 let NOT_VEC0_IMP_LE1 = prove(`~( x = vec 0 ) /\ ~( y = vec 0 ) ==>
\r
136 abs (( x dot y )/ (( norm x ) * ( norm y ))) <= &1 `,
\r
137 REWRITE_TAC[GSYM NORM_POS_LT; REAL_ABS_DIV; REAL_ABS_MUL; REAL_ABS_NORM] THEN
\r
138 NHANH (REAL_LT_MUL) THEN
\r
139 SIMP_TAC[REAL_LE_LDIV_EQ; REAL_MUL_LID; NORM_CAUCHY_SCHWARZ_ABS]);;
\r
141 let sin_acs_t = prove(`! y. (-- &1 <= y /\ y <= &1) ==> (sin (acs(y)) = sqrt(&1 - y pow 2))`,
\r
142 REPEAT STRIP_TAC THEN MATCH_MP_TAC(GSYM SQRT_UNIQUE) THEN
\r
143 ASM_SIMP_TAC[ACS_BOUNDS; SIN_POS_PI_LE; REAL_EQ_SUB_RADD] THEN
\r
144 ASM_MESON_TAC[COS_ACS; SIN_CIRCLE]);;
\r
147 let ABS_LE_1_IMP_SIN_ACS = prove(`!y. abs y <= &1 ==> sin (acs y) = sqrt (&1 - y pow 2)`,
\r
148 SIMP_TAC[REAL_ABS_BOUNDS; sin_acs_t]);;
\r
151 let NOT_2EQ_IMP_SIN_ARCV = prove(`~( v0 = va) /\ ~(v0 = (vb:real^N)) ==>
\r
152 sin ( arcV v0 va vb ) = sqrt
\r
154 (((va - v0) dot (vb - v0)) / (norm (va - v0) * norm (vb - v0))) pow 2) `,
\r
155 REWRITE_TAC[arcV] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
\r
156 ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN NHANH (NOT_VEC0_IMP_LE1 ) THEN
\r
157 SIMP_TAC[ABS_LE_1_IMP_SIN_ACS]);;
\r
160 let ABS_NOT_EQ_NORM_MUL = prove(` ~ ( abs ( x dot y ) = norm x * norm y ) <=>
\r
161 abs ( x dot y ) < norm x * norm y `,
\r
162 SIMP_TAC[REAL_LT_LE; NORM_CAUCHY_SCHWARZ_ABS]);;
\r
166 let SQUARE_NORM_CAUCHY_SCHWARZ_POW2 = prove(`((x:real^N) dot y) pow 2 <= (norm x * norm y) pow 2`,
\r
167 REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN
\r
168 MESON_TAC[GSYM REAL_ABS_REFL; REAL_LE_MUL; NORM_POS_LE;
\r
169 NORM_CAUCHY_SCHWARZ_ABS]);;
\r
171 let REAL_LE_POW_2 = prove(` ! x. &0 <= x pow 2 `,
\r
172 REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]);;
\r
174 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
175 sqrt ((norm x * norm y) pow 2 - (x dot y) pow 2) /
\r
176 sqrt ((norm x * norm y) pow 2)`,
\r
177 MP_TAC SQUARE_NORM_CAUCHY_SCHWARZ_POW2 THEN
\r
178 ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN SIMP_TAC[REAL_LE_POW_2; SQRT_DIV]);;
\r
183 let COMPUTE_NORM_OF_P = prove(`norm ((vc dot vc) % va - (va dot vc) % vc) =
\r
184 sqrt ((vc dot vc) * ((va dot va) * (vc dot vc) - (va dot vc) pow 2))`,
\r
185 REWRITE_TAC[vector_norm; DOT_LSUB; DOT_RSUB; DOT_LMUL; DOT_RMUL] THEN
\r
186 MATCH_MP_TAC (MESON[]` a = b ==> P a = P b `) THEN SIMP_TAC[DOT_SYM] THEN REAL_ARITH_TAC);;
\r
191 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
192 norm vc * sqrt ((norm va * norm vc) pow 2 - (va dot vc) pow 2)`,
\r
193 MP_TAC (MESON[SQUARE_NORM_CAUCHY_SCHWARZ_POW2]`
\r
194 ((va: real^N) dot vc) pow 2 <= (norm va * norm vc) pow 2 `) THEN
\r
195 ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN
\r
196 SIMP_TAC[REAL_LE_POW_2; SQRT_MUL; NORM_POS_LE; POW_2_SQRT]);;
\r
198 let PI2_EQ_ACS0 = prove(` pi / &2 = acs ( &0 ) `,
\r
199 MP_TAC (REAL_ARITH` -- &1 <= &0 /\ &0 <= &1 `) THEN
\r
200 NHANH ACS_BOUNDS THEN STRIP_TAC THEN MATCH_MP_TAC COS_INJ_PI
\r
201 THEN ASM_SIMP_TAC[COS_PI2; COS_ACS] THEN ASSUME_TAC PI_POS
\r
202 THEN ASM_REAL_ARITH_TAC);;
\r
204 let ANGLE_EQ_ARCV = prove(`! vap vbp. angle (vap,vec 0,vbp) = arcV (vec 0) vap vbp `,
\r
205 REWRITE_TAC[arcV; angle; vector_angle] THEN REPEAT STRIP_TAC THEN
\r
206 COND_CASES_TAC THENL [POP_ASSUM DISJ_CASES_TAC THENL [
\r
207 ASM_SIMP_TAC[DOT_LZERO; REAL_ARITH` &0 / a = &0 `; PI2_EQ_ACS0];
\r
208 ASM_SIMP_TAC[DOT_RZERO; REAL_ARITH` &0 / a = &0 `; PI2_EQ_ACS0]];
\r
212 let dihV = prove(`! w0 w1 w2 w3. dihV w0 w1 w2 w3 =
\r
213 (let va = w2 - w0 in
\r
214 let vb = w3 - w0 in
\r
215 let vc = w1 - w0 in
\r
216 let vap = (vc dot vc) % va - (va dot vc) % vc in
\r
217 let vbp = (vc dot vc) % vb - (vb dot vc) % vc in arcV (vec 0) vap vbp)`,
\r
218 SIMP_TAC[dihV; ANGLE_EQ_ARCV]);;
\r
221 let RLXWSTK = prove(`! (v0: real^N) va vb vc. let gam = dihV v0 vc va vb in
\r
222 let a = arcV v0 vc vb in
\r
223 let b = arcV v0 vc va in
\r
224 let c = arcV v0 va vb in
\r
225 ~collinear {v0, vc, va} /\ ~collinear {v0, vc, vb}
\r
226 ==> cos gam = (cos c - cos a * cos b) / ( sin a * sin b )`,
\r
227 REPEAT GEN_TAC THEN REPEAT LET_TAC THEN EXPAND_TAC "gam" THEN
\r
228 REWRITE_TAC[dihV] THEN LET_TR THEN
\r
229 NHANH (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] ALLEMI_COLLINEAR) THEN
\r
230 ONCE_REWRITE_TAC[VECTOR_ARITH` a = b <=> vec 0 = a - b `] THEN
\r
231 SIMP_TAC[NOT_EQ_IMPCOS_ARC; VECTOR_SUB_RZERO ] THEN
\r
232 ABBREV_TAC ` (va_v0p: real^N) = ((vc - v0) dot (vc - v0)) % (va - v0) -
\r
233 ((va - v0) dot (vc - v0)) % (vc - v0) ` THEN
\r
234 ABBREV_TAC ` (vb_v0p :real^N) = ((vc - v0) dot (vc - v0)) % (vb - v0) -
\r
235 ((vb - v0) dot (vc - v0)) % (vc - v0) ` THEN
\r
236 EXPAND_TAC "c" THEN EXPAND_TAC "a" THEN EXPAND_TAC "b" THEN
\r
237 NHANH (MESON[COLLINEAR_2; INSERT_INSERT; INSERT_AC]`
\r
238 ~collinear {v0, vc, va} ==> ~( v0 = vc) /\ ~( v0 = va ) `) THEN
\r
239 SIMP_TAC[NOT_2EQ_IMP_SIN_ARCV; NOT_EQ_IMPCOS_ARC] THEN
\r
240 ONCE_REWRITE_TAC[COLLINEAR_TRANSABLE] THEN
\r
241 REWRITE_TAC[GSYM NORM_CAUCHY_SCHWARZ_EQUAL] THEN
\r
242 ONCE_REWRITE_TAC[VECTOR_ARITH` a = b <=> b - a = vec 0`] THEN
\r
243 SIMP_TAC[ GSYM NORM_EQ_0] THEN ONCE_REWRITE_TAC[ GSYM DE_MORGAN_THM] THEN
\r
244 REWRITE_TAC[GSYM REAL_ENTIRE] THEN SIMP_TAC[REAL_FIELD`~ ( c = &0 ) ==>
\r
245 &1 - ( b / c ) pow 2 = ( c pow 2 - b pow 2) / c pow 2 `] THEN
\r
246 SIMP_TAC[SQRT_SEPARATED] THEN SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; POW_2_SQRT] THEN
\r
247 SIMP_TAC[REAL_FIELD` x / (( b / a ) * ( c / aa )) = ( x * a * aa ) / ( b * c ) `] THEN
\r
248 REWRITE_TAC[REAL_SUB_RDISTRIB; REAL_MUL_AC; REAL_ENTIRE; DE_MORGAN_THM] THEN
\r
249 SIMP_TAC[REAL_FIELD` ~( a = &0 ) /\ ~( b = &0 )
\r
250 ==> x / ( a * b ) * a * b * c = x * c `;
\r
251 REAL_FIELD` ~( a = &0 ) /\ ~ ( b = &0 ) /\ ~ ( c = &0) ==>
\r
252 x / ( a * c ) * y / ( b * c ) * a * b * c * c = x * y `] THEN
\r
253 STRIP_TAC THEN EXPAND_TAC "va_v0p" THEN EXPAND_TAC "vb_v0p" THEN
\r
254 REWRITE_TAC[COMPUTE_NORM_OF_P] THEN
\r
255 REWRITE_TAC[ GSYM NORM_POW_2; REAL_ARITH` a pow 2 * b pow 2 = ( a * b ) pow 2`] THEN
\r
256 ABBREV_TAC `vaa = ( va - (v0:real^N))` THEN
\r
257 ABBREV_TAC `vbb = ( vb - (v0:real^N))` THEN
\r
258 ABBREV_TAC `vcc = ( vc - (v0:real^N))` THEN
\r
259 SIMP_TAC[MOVE_NORM_OUT_OF_SQRT; DOT_LSUB; DOT_RSUB] THEN
\r
260 SIMP_TAC[MOVE_NORM_OUT_OF_SQRT; DOT_LSUB; DOT_RSUB;
\r
261 DOT_LMUL; DOT_RMUL; DOT_SYM; GSYM NORM_POW_2] THEN
\r
262 REWRITE_TAC[REAL_ARITH` ( a * b ) * a * c = a pow 2 * b * c `] THEN
\r
263 REWRITE_TAC[REAL_FIELD` a / ( b * c ) = ( a / b ) / c `] THEN
\r
264 MATCH_MP_TAC (MESON[]` a = b ==> a / c = b / c `) THEN
\r
265 MATCH_MP_TAC (MESON[]` a = b ==> a / c = b / c `) THEN
\r
266 REWRITE_TAC[REAL_ARITH` norm vcc pow 2 * norm vcc pow 2 * (vaa dot vbb) -
\r
267 norm vcc pow 2 * (vbb dot vcc) * (vaa dot vcc) -
\r
268 ((vaa dot vcc) * norm vcc pow 2 * (vbb dot vcc) -
\r
269 (vaa dot vcc) * (vbb dot vcc) * norm vcc pow 2) =
\r
270 norm vcc pow 2 * ( norm vcc pow 2 * (vaa dot vbb) - (vaa dot vcc) * (vbb dot vcc) ) `] THEN
\r
271 UNDISCH_TAC `~ ( norm (vcc:real^N) = &0 ) ` THEN CONV_TAC REAL_FIELD);;
\r
278 let SIN_POW2_EQ_1_SUB_COS_POW2 = prove(` sin x pow 2 = &1 - cos x pow 2 `,
\r
279 MP_TAC (SPEC_ALL SIN_CIRCLE) THEN REAL_ARITH_TAC);;
\r
284 let LE_AND_NOT_0_EQ_LT = REAL_ARITH` &0 <= a /\ ~( a = &0 ) <=> &0 < a `;;
\r
286 let ABS_REFL = REAL_ABS_REFL;;
\r
287 let LT_IMP_ABS_REFL = MESON[REAL_ABS_REFL; REAL_LT_IMP_LE]`&0 < a ==> abs a = a`;;
\r
290 let ABS_MUL = REAL_ABS_MUL;;
\r
291 let NOT_COLLINEAR_IMP_NOT_SIN0 = prove(`~collinear {v0, va, vb} ==> ~(sin ( arcV v0 va vb ) = &0)`,
\r
292 SIMP_TAC[] THEN NHANH (MESON[INSERT_AC; COLLINEAR_2]` ~collinear {v0, va, vb}
\r
293 ==> ~( v0 = va ) /\ ~(v0 = vb) `) THEN
\r
294 SIMP_TAC[NOT_2EQ_IMP_SIN_ARCV] THEN
\r
295 ONCE_REWRITE_TAC[VECTOR_ARITH` a = b <=> b - a = vec 0 `] THEN
\r
296 SIMP_TAC[ GSYM NORM_POS_LT] THEN
\r
298 MATCH_MP_TAC (MESON[SQRT_EQ_0]` &0 <= x /\ ~( x = &0 ) ==> ~( sqrt x = &0 ) `) THEN
\r
300 ONCE_REWRITE_TAC[ COLLINEAR_TRANSABLE ] THEN
\r
301 REWRITE_TAC[ GSYM NORM_CAUCHY_SCHWARZ_EQUAL; ABS_NOT_EQ_NORM_MUL;
\r
302 LE_AND_NOT_0_EQ_LT ] THEN
\r
303 SIMP_TAC[REAL_FIELD`&0 < a /\ &0 < aa ==> &1 - ( b / ( a * aa )) pow 2
\r
304 = ( ( a * aa ) pow 2 - b pow 2 ) / ( a * aa ) pow 2 `] THEN
\r
306 MATCH_MP_TAC (SPEC_ALL REAL_LT_DIV) THEN
\r
307 REWRITE_TAC[REAL_SUB_LT; GSYM REAL_LT_SQUARE_ABS] THEN
\r
308 ONCE_REWRITE_TAC[REAL_ARITH` &0 = &0 pow 2 `] THEN
\r
310 REWRITE_TAC[REAL_SUB_LT; GSYM REAL_LT_SQUARE_ABS; REAL_ABS_0;
\r
312 SIMP_TAC[LT_IMP_ABS_REFL; REAL_LT_MUL ]);;
\r
314 MESON[REAL_LE_LDIV_EQ; REAL_MUL_LID]`
\r
315 ! x z. &0 < z /\ x <= z ==> x / z <= &1 `;;
\r
316 let NOT_IDEN_IMP_ABS_LE = prove(`~(v0 = va) /\ ~(v0 = vb)
\r
317 ==> abs (((va - v0) dot (vb - v0)) / (norm (va - v0) * norm (vb - v0))) <=
\r
318 &1`, ONCE_REWRITE_TAC[VECTOR_ARITH` a = b <=> b - a = vec 0`] THEN
\r
319 SIMP_TAC[REAL_ABS_DIV; REAL_ABS_MUL; REAL_ABS_NORM; GSYM NORM_POS_LT] THEN
\r
320 STRIP_TAC THEN MATCH_MP_TAC REAL_LE_LDIV
\r
321 THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_MUL_LID;
\r
322 REAL_DIV_1; NORM_CAUCHY_SCHWARZ_ABS]);;
\r
324 let ABS_1 = REAL_ABS_1;;
\r
325 let PROVE_SIN_LE = prove(`~(v0 = va) /\ ~(v0 = vb) ==> &0 <= sin ( arcV v0 va vb )`,
\r
326 SIMP_TAC[NOT_2EQ_IMP_SIN_ARCV; arcV] THEN
\r
327 NGOAC THEN NHANH (NOT_IDEN_IMP_ABS_LE ) THEN
\r
328 SIMP_TAC[ABS_LE_1_IMP_SIN_ACS] THEN STRIP_TAC THEN MATCH_MP_TAC SQRT_POS_LE THEN
\r
329 DOWN_TAC THEN ONCE_REWRITE_TAC[ GSYM ABS_1] THEN
\r
330 ASM_SIMP_TAC[REAL_SUB_LE; GSYM ABS_1; REAL_LE_SQUARE_ABS] THEN
\r
331 SIMP_TAC[REAL_ARITH`( &1 ) pow 2 = &1`; ABS_1]);;
\r
335 let MUL_POW2 = REAL_ARITH` (a*b) pow 2 = a pow 2 * b pow 2 `;;
\r
340 let COMPUTE_SIN_DIVH_POW2 = prove(`! (v0: real^N) va vb vc.
\r
341 let betaa = dihV v0 vc va vb in
\r
342 let a = arcV v0 vc vb in
\r
343 let b = arcV v0 vc va in
\r
344 let c = arcV v0 va vb in
\r
346 &1 - cos a pow 2 - cos b pow 2 - cos c pow 2 +
\r
347 &2 * cos a * cos b * cos c in
\r
348 ~collinear {v0, vc, va} /\ ~collinear {v0, vc, vb} ==>
\r
349 ( sin betaa ) pow 2 = p / ((sin a * sin b) pow 2) `,
\r
351 REPEAT STRIP_TAC THEN MP_TAC (SPEC_ALL RLXWSTK ) THEN
\r
352 REPEAT LET_TAC THEN SIMP_TAC[SIN_POW2_EQ_1_SUB_COS_POW2 ] THEN
\r
353 REPEAT STRIP_TAC THEN REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN
\r
354 NHANH (NOT_COLLINEAR_IMP_NOT_SIN0) THEN
\r
355 EXPAND_TAC "a" THEN EXPAND_TAC "b" THEN PHA THEN
\r
356 SIMP_TAC[REAL_FIELD` ~( a = &0 ) /\ ~ ( b = &0 ) ==>
\r
357 &1 - ( x / ( a * b )) pow 2 = (( a * b ) pow 2 - x pow 2 ) / (( a * b ) pow 2 ) `] THEN
\r
358 ASM_SIMP_TAC[] THEN STRIP_TAC THEN
\r
359 MATCH_MP_TAC (MESON[]` a = b ==> a / x = b / x `) THEN
\r
360 EXPAND_TAC "p" THEN SIMP_TAC[MUL_POW2; SIN_POW2_EQ_1_SUB_COS_POW2] THEN
\r
366 let PROVE_P_LE = prove(`!(v0:real^N) va vb vc.
\r
367 let a = arcV v0 vc vb in
\r
368 let b = arcV v0 vc va in
\r
369 let c = arcV v0 va vb in
\r
371 &1 - cos a pow 2 - cos b pow 2 - cos c pow 2 +
\r
372 &2 * cos a * cos b * cos c in
\r
373 ~collinear {v0, vc, va} /\ ~collinear {v0, vc, vb} ==> &0 <= p`,
\r
374 REPEAT GEN_TAC THEN MP_TAC (SPEC_ALL COMPUTE_SIN_DIVH_POW2 ) THEN
\r
375 REPEAT LET_TAC THEN REWRITE_TAC[MESON[]` ( a ==> b ) ==> a ==> c <=>
\r
376 a /\ b ==> c `] THEN NHANH (NOT_COLLINEAR_IMP_NOT_SIN0) THEN
\r
377 ASM_SIMP_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM MP_TAC THEN
\r
378 ASM_SIMP_TAC[REAL_FIELD` ~( a = &0 ) /\ ~( b = &0 ) ==>
\r
379 ( x = y / ( a * b ) pow 2 <=> x * ( a * b ) pow 2 = y ) `] THEN
\r
380 MESON_TAC[GSYM MUL_POW2; REAL_LE_POW_2]);;
\r
383 let POW2_COND = MESON[REAL_ABS_REFL; REAL_LE_SQUARE_ABS]` ! a b. &0 <= a /\ &0 <= b ==>
\r
384 ( a <= b <=> a pow 2 <= b pow 2 ) `;;
\r
387 let EQ_POW2_COND = prove(`!a b. &0 <= a /\ &0 <= b ==> (a = b <=> a pow 2 = b pow 2)`,
\r
388 REWRITE_TAC[REAL_ARITH` a = b <=> a <= b /\ b <= a `] THEN SIMP_TAC[POW2_COND]);;
\r
390 let NOT_COLLINEAR_IMP_2_UNEQUAL = MESON[INSERT_INSERT; COLLINEAR_2; INSERT_AC]`
\r
391 ~collinear {v0, va, vb} ==> ~(v0 = va) /\ ~(v0 = vb) `;;
\r
394 let NOT_COLL_IM_SIN_LT = prove(`~collinear {v0, va, vb} ==> &0 < sin (arcV v0 va vb)`,
\r
395 REWRITE_TAC[GSYM LE_AND_NOT_0_EQ_LT] THEN
\r
396 NHANH (NOT_COLLINEAR_IMP_2_UNEQUAL ) THEN
\r
397 SIMP_TAC[NOT_COLLINEAR_IMP_NOT_SIN0; PROVE_SIN_LE]);;
\r
399 let ARC_SYM = prove(` arcV v0 vc vb = arcV v0 vb vc `,
\r
400 SIMP_TAC[arcV; DOT_SYM; REAL_MUL_SYM]);;
\r
403 let DIV_POW2 = REAL_FIELD` ( a / b ) pow 2 = a pow 2 / b pow 2 `;;
\r
406 ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] ALLEMI_COLLINEAR;;
\r
408 let SIN_MUL_EXPAND = prove(` !(v0:real^N) va vb vc.
\r
409 let gam = dihV v0 vc va vb in
\r
410 let bet = dihV v0 vb vc va in
\r
411 let a = arcV v0 vc vb in
\r
412 let b = arcV v0 vc va in
\r
413 let c = arcV v0 va vb in
\r
415 &1 - cos a pow 2 - cos b pow 2 - cos c pow 2 +
\r
416 &2 * cos a * cos b * cos c in
\r
417 ~collinear {v0, vc, va} /\ ~collinear {v0, vc, vb} /\
\r
418 ~ collinear {v0,va,vb} ==>
\r
419 sin gam * sin bet = p / ( sin b * sin c * ( sin a pow 2 )) `,
\r
420 REPEAT GEN_TAC THEN
\r
421 MP_TAC (COMPUTE_SIN_DIVH_POW2) THEN
\r
422 REPEAT LET_TAC THEN
\r
423 REPEAT STRIP_TAC THEN
\r
424 MATCH_MP_TAC (MESON[EQ_POW2_COND]` &0 <= a /\ &0 <= b /\ a pow 2 = b pow 2
\r
426 CONJ_TAC THENL [ REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC) THEN
\r
427 EXPAND_TAC "gam" THEN EXPAND_TAC "betaa" THEN
\r
428 EXPAND_TAC "bet" THEN REWRITE_TAC[dihV] THEN LET_TR THEN
\r
429 NHANH (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] ALLEMI_COLLINEAR) THEN
\r
430 ONCE_REWRITE_TAC[SET_RULE` {a,b} = {b,a}`] THEN
\r
431 NHANH (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] ALLEMI_COLLINEAR) THEN
\r
432 ONCE_REWRITE_TAC[VECTOR_ARITH ` a = b <=> vec 0 = a - b `] THEN
\r
433 REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN
\r
434 ASM_SIMP_TAC[PROVE_SIN_LE]; REWRITE_TAC[]] THEN
\r
435 CONJ_TAC THENL [MP_TAC (SPEC_ALL PROVE_P_LE ) THEN
\r
436 REPEAT LET_TAC THEN
\r
438 ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
\r
440 FIRST_X_ASSUM MP_TAC THEN
\r
441 ASM_SIMP_TAC[] THEN
\r
442 MATCH_MP_TAC (MESON[]` (! a. a = b ==> &0 <= a ==> P a )
\r
443 ==> &0 <= b ==> P b `) THEN
\r
444 GEN_TAC THEN STRIP_TAC THEN
\r
445 UNDISCH_TAC `~collinear {v0, vc, (vb: real^N)}` THEN
\r
446 UNDISCH_TAC `~collinear {v0, vc, (va: real^N)}` THEN
\r
447 UNDISCH_TAC `~collinear {v0, va, (vb: real^N)}` THEN
\r
448 NHANH (NOT_COLL_IM_SIN_LT ) THEN
\r
449 NHANH (REAL_LT_IMP_LE) THEN
\r
450 REPEAT STRIP_TAC THEN
\r
451 MATCH_MP_TAC REAL_LE_DIV THEN
\r
452 ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_POW_2]; REWRITE_TAC[]] THEN
\r
453 EXPAND_TAC "gam" THEN EXPAND_TAC "betaa" THEN EXPAND_TAC "bet" THEN
\r
454 SIMP_TAC[MUL_POW2] THEN
\r
455 REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC) THEN
\r
457 FIRST_X_ASSUM MP_TAC THEN
\r
460 ONCE_REWRITE_TAC[SET_RULE` {a,b} = {b,a}`] THEN
\r
461 FIRST_X_ASSUM MP_TAC THEN
\r
463 REWRITE_TAC[REAL_FIELD` a / x * aa / y = ( a * aa ) / ( x * y ) `] THEN
\r
464 REPEAT STRIP_TAC THEN
\r
465 ASM_SIMP_TAC[ARC_SYM] THEN
\r
466 ONCE_REWRITE_TAC[ARC_SYM] THEN
\r
467 ASM_SIMP_TAC[] THEN
\r
468 SIMP_TAC[DIV_POW2; REAL_ARITH` ((sin a * sin b) pow 2 * (sin c * sin a) pow 2) =
\r
469 (sin b * sin c * sin a pow 2) pow 2 `] THEN
\r
470 MATCH_MP_TAC (MESON[]` a = b ==> a / x = b / x `) THEN
\r
471 EXPAND_TAC "p'" THEN
\r
472 EXPAND_TAC "p" THEN
\r
473 EXPAND_TAC "a" THEN
\r
474 EXPAND_TAC "b" THEN
\r
475 EXPAND_TAC "c" THEN
\r
476 EXPAND_TAC "a'" THEN
\r
477 EXPAND_TAC "b'" THEN
\r
478 EXPAND_TAC "c'" THEN
\r
479 SIMP_TAC[ARC_SYM] THEN
\r
483 let DIHV_SYM = prove(`dihV a b x y = dihV a b y x `,
\r
484 REWRITE_TAC[dihV] THEN LET_TR THEN SIMP_TAC[DOT_SYM; ARC_SYM]);;
\r
485 replaced Feb 13, 2013. Merged with version in Multivariate/flyspeck.ml.
\r
488 let DIHV_SYM = prove
\r
489 (`!v0 v1 v2 v3:real^N.
\r
490 dihV v0 v1 v3 v2 = dihV v0 v1 v2 v3`,
\r
491 REPEAT GEN_TAC THEN REWRITE_TAC[DIHV] THEN
\r
492 CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN
\r
493 REWRITE_TAC[DOT_SYM; ANGLE_SYM]);;
\r
498 (* (* redone below *)
\r
499 let NLVWBBW = prove(` !(v0:real^N) va vb vc.
\r
500 let al = dihV v0 va vb vc in
\r
501 let ga = dihV v0 vc va vb in
\r
502 let be = dihV v0 vb vc va in
\r
503 let a = arcV v0 vc vb in
\r
504 let b = arcV v0 vc va in
\r
505 let c = arcV v0 va vb in
\r
507 &1 - cos a pow 2 - cos b pow 2 - cos c pow 2 +
\r
508 &2 * cos a * cos b * cos c in
\r
509 ~collinear {v0, vc, va} /\ ~collinear {v0, vc, vb} /\
\r
510 ~ collinear {v0,va,vb} ==>
\r
511 cos c * sin al * sin be = cos ga + cos al * cos be `,
\r
512 REPEAT GEN_TAC THEN MP_TAC RLXWSTK THEN REPEAT LET_TAC THEN
\r
513 EXPAND_TAC "al" THEN EXPAND_TAC "be" THEN EXPAND_TAC "ga" THEN
\r
514 EXPAND_TAC "gam" THEN SIMP_TAC[INSERT_AC] THEN STRIP_TAC THEN
\r
515 MP_TAC SIN_MUL_EXPAND THEN REPEAT LET_TAC THEN EXPAND_TAC "bet" THEN
\r
516 SIMP_TAC[INSERT_AC; DIHV_SYM; ARC_SYM] THEN
\r
517 ONCE_REWRITE_TAC[MESON[DIHV_SYM]` aa * sin (dihV v0 va vb vc) * sin (dihV v0 vb va vc) =
\r
518 aa * sin (dihV v0 va vc vb) * sin (dihV v0 vb vc va)`] THEN
\r
519 DISCH_TAC THEN ONCE_REWRITE_TAC[MESON[INSERT_AC]`~collinear {v0, va, vc} /\
\r
520 ~collinear {v0, vb, vc} /\ ~collinear {v0, va, vb} <=>
\r
521 ~collinear {v0, vc, va} /\ ~collinear {v0, vb, va} /\
\r
522 ~collinear {v0, vc, vb} `] THEN FIRST_X_ASSUM MP_TAC THEN
\r
523 SIMP_TAC[] THEN DOWN_TAC THEN SIMP_TAC[ARC_SYM; DIHV_SYM] THEN
\r
524 STRIP_TAC THEN REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC) THEN
\r
525 NHANH (NOT_COLLINEAR_IMP_NOT_SIN0) THEN ASM_SIMP_TAC[ARC_SYM] THEN
\r
526 REPEAT STRIP_TAC THEN UNDISCH_TAC `~( sin a = &0 )` THEN
\r
527 UNDISCH_TAC `~( sin b = &0 )` THEN UNDISCH_TAC `~( sin c = &0 )` THEN
\r
528 PHA THEN SIMP_TAC[REAL_FIELD `~(c = &0) /\ ~(b = &0) /\ ~(a = &0)
\r
529 ==> x / (a * b) + y / (b * c) * z / (c * a) = ( x * c pow 2 + y * z ) / ( b * a * c pow 2 ) `] THEN
\r
530 STRIP_TAC THEN REWRITE_TAC[REAL_ARITH` a * ( x / y ) = ( a * x ) / y `] THEN
\r
531 MATCH_MP_TAC (MESON[]` a = b ==> a / x = b / x `) THEN
\r
532 SIMP_TAC[SIN_POW2_EQ_1_SUB_COS_POW2] THEN REAL_ARITH_TAC);;
\r
535 (* tchales removed extraneous p from statement *)
\r
537 let NLVWBBW = prove(` !(v0:real^N) va vb vc.
\r
538 let al = dihV v0 va vb vc in
\r
539 let ga = dihV v0 vc va vb in
\r
540 let be = dihV v0 vb vc va in
\r
541 let a = arcV v0 vc vb in
\r
542 let b = arcV v0 vc va in
\r
543 let c = arcV v0 va vb in
\r
544 ~collinear {v0, vc, va} /\ ~collinear {v0, vc, vb} /\
\r
545 ~ collinear {v0,va,vb} ==>
\r
546 cos c * sin al * sin be = cos ga + cos al * cos be `,
\r
547 REPEAT GEN_TAC THEN MP_TAC RLXWSTK THEN REPEAT LET_TAC THEN
\r
548 EXPAND_TAC "al" THEN EXPAND_TAC "be" THEN EXPAND_TAC "ga" THEN
\r
549 EXPAND_TAC "gam" THEN SIMP_TAC[INSERT_AC] THEN STRIP_TAC THEN
\r
550 MP_TAC SIN_MUL_EXPAND THEN REPEAT LET_TAC THEN EXPAND_TAC "bet" THEN
\r
551 SIMP_TAC[INSERT_AC; DIHV_SYM; ARC_SYM] THEN
\r
552 ONCE_REWRITE_TAC[MESON[DIHV_SYM]` aa * sin (dihV v0 va vb vc) * sin (dihV v0 vb va vc) =
\r
553 aa * sin (dihV v0 va vc vb) * sin (dihV v0 vb vc va)`] THEN
\r
554 DISCH_TAC THEN ONCE_REWRITE_TAC[MESON[INSERT_AC]`~collinear {v0, va, vc} /\
\r
555 ~collinear {v0, vb, vc} /\ ~collinear {v0, va, vb} <=>
\r
556 ~collinear {v0, vc, va} /\ ~collinear {v0, vb, va} /\
\r
557 ~collinear {v0, vc, vb} `] THEN FIRST_X_ASSUM MP_TAC THEN
\r
558 SIMP_TAC[] THEN DOWN_TAC THEN SIMP_TAC[ARC_SYM; DIHV_SYM] THEN
\r
559 STRIP_TAC THEN REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC) THEN
\r
560 NHANH (NOT_COLLINEAR_IMP_NOT_SIN0) THEN ASM_SIMP_TAC[ARC_SYM] THEN
\r
561 REPEAT STRIP_TAC THEN UNDISCH_TAC `~( sin a = &0 )` THEN
\r
562 UNDISCH_TAC `~( sin b = &0 )` THEN UNDISCH_TAC `~( sin c = &0 )` THEN
\r
563 PHA THEN SIMP_TAC[REAL_FIELD `~(c = &0) /\ ~(b = &0) /\ ~(a = &0)
\r
564 ==> x / (a * b) + y / (b * c) * z / (c * a) = ( x * c pow 2 + y * z ) / ( b * a * c pow 2 ) `] THEN
\r
565 STRIP_TAC THEN REWRITE_TAC[REAL_ARITH` a * ( x / y ) = ( a * x ) / y `] THEN
\r
566 MATCH_MP_TAC (MESON[]` a = b ==> a / x = b / x `) THEN
\r
567 SIMP_TAC[SIN_POW2_EQ_1_SUB_COS_POW2] THEN REAL_ARITH_TAC);;
\r
570 let COMPUTE_NORM_POW2 = prove(`
\r
571 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
572 (((norm vc pow 2 + norm vc pow 2) - dist (vc,vc) pow 2) / &2 *
\r
573 ((norm vb pow 2 + norm vb pow 2) - dist (vb,vb) pow 2) / &2 -
\r
574 ((norm vb pow 2 + norm vc pow 2) - dist (vb,vc) pow 2) / &2 *
\r
575 ((norm vb pow 2 + norm vc pow 2) - dist (vb,vc) pow 2) / &2) -
\r
576 ((norm vb pow 2 + norm vc pow 2) - dist (vb,vc) pow 2) / &2 *
\r
577 (((norm vc pow 2 + norm vc pow 2) - dist (vc,vc) pow 2) / &2 *
\r
578 ((norm vc pow 2 + norm vb pow 2) - dist (vc,vb) pow 2) / &2 -
\r
579 ((norm vb pow 2 + norm vc pow 2) - dist (vb,vc) pow 2) / &2 *
\r
580 ((norm vc pow 2 + norm vc pow 2) - dist (vc,vc) pow 2) / &2) `,
\r
581 MATCH_MP_TAC (MESON[]`(! c. c = b ==> a = c ) ==> a = b`) THEN REPEAT STRIP_TAC THEN
\r
582 SIMP_TAC[NORM_POW_2] THEN SIMP_TAC[GSYM dist;
\r
583 VECTOR_SUB_RZERO; DOT_LSUB; DOT_RSUB; DOT_LMUL;
\r
584 DOT_RMUL; DOT_NORM_NEG] THEN ASM_SIMP_TAC[]);;
\r
587 let UPS_X_AND_HERON = prove(`ups_x (x1 pow 2) (x2 pow 2) (x6 pow 2) =
\r
588 (x1 + x2 + x6) * (x1 + x2 - x6) * (x2 + x6 - x1) * (x6 + x1 - x2)`,
\r
589 SIMP_TAC[ups_x] THEN REAL_ARITH_TAC);;
\r
592 let UPS_X_POS = prove(`dist (v0,v1) pow 2 = v01 /\
\r
593 dist (v0,v2) pow 2 = v02 /\
\r
594 dist (v1,v2) pow 2 = v12
\r
595 ==> &0 <= ups_x v01 v02 v12`,
\r
596 ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
\r
597 SIMP_TAC[UPS_X_AND_HERON] THEN
\r
599 MATCH_MP_TAC REAL_LE_MUL THEN
\r
600 SIMP_TAC[DIST_POS_LE; REAL_LE_ADD] THEN
\r
601 MATCH_MP_TAC REAL_LE_MUL THEN
\r
603 MESON_TAC[ONCE_REWRITE_RULE[REAL_ARITH` a <= b + c <=> &0 <= b + c - a `]
\r
604 DIST_TRIANGLE; DIST_SYM; DIST_POS_LE];
\r
605 MATCH_MP_TAC REAL_LE_MUL] THEN
\r
606 MESON_TAC[ONCE_REWRITE_RULE[REAL_ARITH` a <= b + c <=> &0 <= b + c - a `]
\r
607 DIST_TRIANGLE; DIST_SYM; DIST_POS_LE]);;
\r
610 let DIST_TRANSABLE = prove(` dist ( a - v0, b ) = dist ( a , b + v0 ) `,
\r
611 REWRITE_TAC[dist; VECTOR_ARITH` a - v0 - b = (a:real^N) - ( b + v0 ) `]);;
\r
613 prove(` v2 - v0 = va /\
\r
614 v3 - v0 = vb ==> dist (va,vb) = dist ( v2,v3) `,
\r
615 ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
\r
616 SIMP_TAC[DIST_TRANSABLE; VECTOR_ARITH` a - b + b = ( a:real^N)`]);;
\r
618 let REAL_LE_SQUARE_POW =
\r
619 MESON[REAL_POW_2; REAL_LE_SQUARE]`! x. &0 <= x pow 2 `;;
\r
623 g ` dist ((v0:real^N),v1) pow 2 = v01 /\
\r
624 dist (v0,v2) pow 2 = v02 /\
\r
625 dist (v0,v3) pow 2 = v03 /\
\r
626 dist (v1,v2) pow 2 = v12 /\
\r
627 dist (v1,v3) pow 2 = v13 /\
\r
628 dist (v2,v3) pow 2 = v23 /\
\r
629 ~collinear {v0, v1, v2} /\
\r
630 ~collinear {v0, v1, v3}
\r
631 ==> (let va = v2 - v0 in
\r
632 let vb = v3 - v0 in
\r
633 let vc = v1 - v0 in
\r
634 let vap = (vc dot vc) % va - (va dot vc) % vc in
\r
635 let vbp = (vc dot vc) % vb - (vb dot vc) % vc in
\r
636 (((vap - vec 0) dot (vbp - vec 0)) /
\r
637 (norm (vap - vec 0) * norm (vbp - vec 0)))) =
\r
638 (delta_x4 v01 v02 v03 v23 v13 v12 /
\r
639 sqrt (ups_x v01 v02 v12 * ups_x v01 v03 v13))`;;
\r
641 e (REPEAT LET_TAC THEN STRIP_TAC);;
\r
642 e (EXPAND_TAC "vap" THEN EXPAND_TAC "vbp");;
\r
643 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
644 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
645 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
646 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
647 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
648 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
650 let PROVE_DELTA_OVER_SQRT_2UPS = top_thm();;
\r
653 let PROVE_DELTA_OVER_SQRT_2UPS = prove_by_refinement(
\r
654 ` dist ((v0:real^N),v1) pow 2 = v01 /\
\r
655 dist (v0,v2) pow 2 = v02 /\
\r
656 dist (v0,v3) pow 2 = v03 /\
\r
657 dist (v1,v2) pow 2 = v12 /\
\r
658 dist (v1,v3) pow 2 = v13 /\
\r
659 dist (v2,v3) pow 2 = v23 /\
\r
660 ~collinear {v0, v1, v2} /\
\r
661 ~collinear {v0, v1, v3}
\r
662 ==> (let va = v2 - v0 in
\r
663 let vb = v3 - v0 in
\r
664 let vc = v1 - v0 in
\r
665 let vap = (vc dot vc) % va - (va dot vc) % vc in
\r
666 let vbp = (vc dot vc) % vb - (vb dot vc) % vc in
\r
667 (((vap - vec 0) dot (vbp - vec 0)) /
\r
668 (norm (vap - vec 0) * norm (vbp - vec 0)))) =
\r
669 (delta_x4 v01 v02 v03 v23 v13 v12 /
\r
670 sqrt (ups_x v01 v02 v12 * ups_x v01 v03 v13))`,
\r
673 (REPEAT LET_TAC THEN STRIP_TAC);
\r
674 (EXPAND_TAC "vap" THEN EXPAND_TAC "vbp");
\r
675 (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
676 (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
677 (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
678 (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
679 (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
680 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
684 let FOR_LEMMA19 = prove(`!(v0:real^N) v1 v2 v3.
\r
685 let ga = dihV v0 v1 v2 v3 in
\r
686 let v01 = dist (v0,v1) pow 2 in
\r
687 let v02 = dist (v0,v2) pow 2 in
\r
688 let v03 = dist (v0,v3) pow 2 in
\r
689 let v12 = dist (v1,v2) pow 2 in
\r
690 let v13 = dist (v1,v3) pow 2 in
\r
691 let v23 = dist (v2,v3) pow 2 in
\r
692 ~collinear {v0, v1, v2} /\ ~collinear {v0, v1, v3}
\r
695 (delta_x4 v01 v02 v03 v23 v13 v12 /
\r
696 sqrt (ups_x v01 v02 v12 * ups_x v01 v03 v13))`,
\r
697 REPEAT STRIP_TAC THEN REPEAT LET_TAC THEN EXPAND_TAC "ga" THEN
\r
698 SIMP_TAC[dihV; arcV] THEN REPEAT LET_TAC THEN REPEAT STRIP_TAC THEN
\r
699 MATCH_MP_TAC (MESON[]` a = b ==> p a = p b `) THEN MP_TAC
\r
700 PROVE_DELTA_OVER_SQRT_2UPS THEN REPEAT LET_TAC THEN
\r
704 let COMPUTE_DELTA_OVER = prove(`dist ((v0:real^N),v1) pow 2 = v01 /\
\r
705 dist (v0,v2) pow 2 = v02 /\
\r
706 dist (v0,v3) pow 2 = v03 /\
\r
707 dist (v1,v2) pow 2 = v12 /\
\r
708 dist (v1,v3) pow 2 = v13 /\
\r
709 dist (v2,v3) pow 2 = v23 /\
\r
710 ~collinear {v0, v1, v2} /\
\r
711 ~collinear {v0, v1, v3}
\r
712 ==> ((((v1 - v0) dot (v1 - v0)) % (v2 - v0) -
\r
713 ((v2 - v0) dot (v1 - v0)) % (v1 - v0)) dot
\r
714 (((v1 - v0) dot (v1 - v0)) % (v3 - v0) -
\r
715 ((v3 - v0) dot (v1 - v0)) % (v1 - v0))) /
\r
717 (((v1 - v0) dot (v1 - v0)) % (v2 - v0) -
\r
718 ((v2 - v0) dot (v1 - v0)) % (v1 - v0)) *
\r
720 (((v1 - v0) dot (v1 - v0)) % (v3 - v0) -
\r
721 ((v3 - v0) dot (v1 - v0)) % (v1 - v0))) =
\r
722 delta_x4 v01 v02 v03 v23 v13 v12 /
\r
723 sqrt (ups_x v01 v02 v12 * ups_x v01 v03 v13)`,
\r
724 MP_TAC PROVE_DELTA_OVER_SQRT_2UPS THEN REWRITE_TAC[VECTOR_ARITH` a - vec 0 = a `]
\r
725 THEN LET_TR THEN SIMP_TAC[]);;
\r
734 let POS_COMPATIBLE_WITH_ATN2 = prove(` &0 < a ==> atn2 (x,y) = atn2 (a * x,a * y)`,
\r
735 SIMP_TAC[atn2; REAL_FIELD` &0 < a ==> ( a * b ) / (a * c ) = b / c `] THEN
\r
736 SIMP_TAC[ABS_MUL] THEN REWRITE_TAC[REAL_ARITH` a * y < &0 <=> &0 < a * ( -- y )`;
\r
737 REAL_ARITH` b < &0 <=> &0 < -- b `] THEN
\r
738 SIMP_TAC[ABS_MUL; LT_IMP_ABS_REFL; REAL_LT_LMUL_EQ; REAL_LT_MUL_EQ]);;
\r
742 let NOT_COLLINEAR_IMP_UPS_LT = prove( `
\r
743 ~( collinear {(v0:real^3),v1,v2} ) ==>
\r
744 let v01 = dist (v0,v1) pow 2 in
\r
745 let v02 = dist (v0,v2) pow 2 in
\r
746 let v12 = dist (v1,v2) pow 2 in
\r
747 &0 < ups_x v01 v02 v12 `,
\r
748 REPEAT (LET_TAC THEN (REPEAT STRIP_TAC)) THEN
\r
749 REWRITE_TAC[REAL_ARITH `&0 < x <=> (&0 <= x /\ ~(x = &0))`] THEN
\r
750 ASM_MESON_TAC[COL_EQ_UPS_0;UPS_X_POS]);;
\r
753 let NOT_COLLINEAR_IMP_UPS_LT = New_axiom `
\r
754 ~( collinear {(v0:real^N),v1,v2} ) ==>
\r
755 let v01 = dist (v0,v1) pow 2 in
\r
756 let v02 = dist (v0,v2) pow 2 in
\r
757 let v12 = dist (v1,v2) pow 2 in
\r
758 &0 < ups_x v01 v02 v12 `;;
\r
761 (* Jason have proved the following lemma in the first half
\r
765 let acs_atn2_t = `!y. (-- &1 <= y /\ y <= &1) ==> (acs y = pi/(&2) - atn2(sqrt(&1 - y pow 2),y))`;;
\r
766 let acs_atn2 = new_axiom acs_atn2_t;;
\r
769 let REAL_LT_DIV_0 = prove(` ! a b. &0 < b ==> ( &0 < a / b <=> &0 < a ) `,
\r
770 REPEAT STRIP_TAC THEN EQ_TAC THENL
\r
771 [ASSUME_TAC (UNDISCH (SPEC `b:real` REAL_LT_IMP_NZ)) THEN
\r
772 ASM_MESON_TAC[REAL_LT_MUL; REAL_DIV_LMUL];
\r
773 ASM_SIMP_TAC[REAL_LT_DIV]]);;
\r
775 let REAL_LE_RDIV_0 = prove(` ! a b. &0 < b ==> ( &0 <= a / b <=> &0 <= a ) `,
\r
776 REWRITE_TAC[REAL_ARITH ` &0 <= a <=> &0 < a \/ a = &0 `] THEN
\r
777 SIMP_TAC[REAL_LT_DIV_0] THEN
\r
778 SIMP_TAC[REAL_FIELD `&0 < b ==> ( a / b = &0 <=> a = &0 ) `]);;
\r
780 let POW_2 = REAL_POW_2;;
\r
782 let NOT_ZERO_EQ_POW2_LT = prove(` ~( a = &0 ) <=> &0 < a pow 2 `,
\r
783 SIMP_TAC[GSYM LE_AND_NOT_0_EQ_LT; POW_2;
\r
784 REAL_ENTIRE; REAL_LE_SQUARE]);;
\r
787 let OJEKOJF = prove(`!(v0:real^3) v1 v2 v3.
\r
788 let ga = dihV v0 v1 v2 v3 in
\r
789 let v01 = dist (v0,v1) pow 2 in
\r
790 let v02 = dist (v0,v2) pow 2 in
\r
791 let v03 = dist (v0,v3) pow 2 in
\r
792 let v12 = dist (v1,v2) pow 2 in
\r
793 let v13 = dist (v1,v3) pow 2 in
\r
794 let v23 = dist (v2,v3) pow 2 in
\r
795 ~collinear {v0, v1, v2} /\ ~collinear {v0, v1, v3}
\r
796 ==> ga = acs (delta_x4 v01 v02 v03 v23 v13 v12 /
\r
797 sqrt (ups_x v01 v02 v12 * ups_x v01 v03 v13)) /\
\r
798 ga = pi / &2 - atn2( sqrt ( &4 * v01 * delta_x v01 v02 v03 v23 v13 v12 ),
\r
799 delta_x4 v01 v02 v03 v23 v13 v12 ) `,
\r
800 REPEAT STRIP_TAC THEN
\r
801 MP_TAC (SPEC_ALL (INST_TYPE [`:3`,`:N`] FOR_LEMMA19) ) THEN REPEAT LET_TAC THEN
\r
802 SIMP_TAC[] THEN DOWN_TAC THEN NGOAC THEN
\r
803 REWRITE_TAC[MESON[]`l/\ ( a ==> b ) <=>( a ==> b ) /\ l `] THEN PHA THEN
\r
804 NHANH (COMPUTE_DELTA_OVER ) THEN
\r
805 NHANH (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] ALLEMI_COLLINEAR) THEN
\r
806 ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
\r
807 ABBREV_TAC ` (w1:real^3) = ((v1 - v0) dot (v1 - v0)) % (v2 - v0) -((v2 - v0) dot (v1 - v0)) % (v1 - v0)` THEN
\r
808 ABBREV_TAC ` (w2:real^3) = ((v1 - v0) dot (v1 - v0)) % (v3 - v0) -((v3 - v0) dot (v1 - v0)) % (v1 - v0) ` THEN
\r
809 ONCE_REWRITE_TAC[MESON[]`( a/\ b ) /\ c /\ d <=>a /\ c /\ b /\ d `] THEN
\r
810 NHANH (NOT_VEC0_IMP_LE1) THEN PHA THEN
\r
811 REWRITE_TAC[MESON[]` P a /\ a = b <=> a = b /\ P b `] THEN
\r
812 SIMP_TAC[REAL_ABS_BOUNDS; acs_atn2; REAL_ARITH ` a - x =a - y <=> x = y `] THEN
\r
813 NHANH (NOT_COLLINEAR_IMP_UPS_LT ) THEN
\r
816 NHANH (MESON[REAL_LT_MUL]` &0 < x /\ a1 /\ &0 < y /\ a2 ==> &0 < x * y `) THEN
\r
817 STRIP_TAC THEN FIRST_X_ASSUM MP_TAC THEN
\r
818 ASM_SIMP_TAC[] THEN NHANH SQRT_POS_LT THEN
\r
819 SIMP_TAC[MESON[POS_COMPATIBLE_WITH_ATN2]` &0 < a ==>atn2 ( x, y / a ) = atn2 ( a * x , a * ( y / a ) ) `] THEN
\r
820 SIMP_TAC[REAL_FIELD` &0 < a ==> a * ( y / a ) = y `] THEN
\r
821 REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN
\r
822 PHA THEN NGOAC THEN REWRITE_TAC[GSYM REAL_ABS_BOUNDS] THEN
\r
823 ONCE_REWRITE_TAC[GSYM ABS_1] THEN
\r
824 SIMP_TAC[REAL_LE_SQUARE_ABS; REAL_ARITH` a <= &1 <=> &0 <= &1 - a `; REAL_ARITH` ( &1 ) pow 2 = &1 `; ABS_1] THEN
\r
825 DAO THEN ONCE_REWRITE_TAC[GSYM IMP_IMP] THEN
\r
826 SIMP_TAC[REAL_FIELD` &0 < a ==> &1 - ( b / a ) pow 2= ( a pow 2 - b pow 2 ) / ( a pow 2 ) `] THEN
\r
827 NHANH (REAL_LT_IMP_NZ) THEN NHANH (REAL_LT_IMP_LE) THEN
\r
828 SIMP_TAC[NOT_ZERO_EQ_POW2_LT; REAL_LE_RDIV_0 ; SQRT_DIV] THEN
\r
829 NHANH (REAL_LT_IMP_LE) THEN SIMP_TAC[SQRT_DIV; REAL_LE_POW2] THEN
\r
830 SIMP_TAC[SQRT_DIV; REAL_LE_POW2; POW_2_SQRT; REAL_FIELD` &0 < a ==>a * b / a = b `] THEN
\r
831 REPEAT STRIP_TAC THEN
\r
832 MATCH_MP_TAC(MESON[]` a = b ==> atn2 ( sqrt a, c ) = atn2 ( sqrt b, c ) `) THEN
\r
833 ASM_SIMP_TAC[SQRT_WORKS; ups_x; delta_x4; delta_x] THEN
\r
837 (* Thales note: 2010-2-7, Here is N.Q. Truong's version that relied on an axiom. *)
\r
841 let OJEKOJF = prove(`!(v0:real^3) v1 v2 v3.
\r
842 let ga = dihV v0 v1 v2 v3 in
\r
843 let v01 = dist (v0,v1) pow 2 in
\r
844 let v02 = dist (v0,v2) pow 2 in
\r
845 let v03 = dist (v0,v3) pow 2 in
\r
846 let v12 = dist (v1,v2) pow 2 in
\r
847 let v13 = dist (v1,v3) pow 2 in
\r
848 let v23 = dist (v2,v3) pow 2 in
\r
849 ~collinear {v0, v1, v2} /\ ~collinear {v0, v1, v3}
\r
850 ==> ga = acs (delta_x4 v01 v02 v03 v23 v13 v12 /
\r
851 sqrt (ups_x v01 v02 v12 * ups_x v01 v03 v13)) /\
\r
852 ga = pi / &2 - atn2( sqrt ( &4 * v01 * delta_x v01 v02 v03 v23 v13 v12 ),
\r
853 delta_x4 v01 v02 v03 v23 v13 v12 ) `,
\r
854 REPEAT STRIP_TAC THEN
\r
855 MP_TAC (SPEC_ALL FOR_LEMMA19 ) THEN REPEAT LET_TAC THEN
\r
856 SIMP_TAC[] THEN DOWN_TAC THEN NGOAC THEN
\r
857 REWRITE_TAC[MESON[]`l/\ ( a ==> b ) <=>( a ==> b ) /\ l `] THEN PHA THEN
\r
858 NHANH (COMPUTE_DELTA_OVER ) THEN
\r
859 NHANH (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] ALLEMI_COLLINEAR) THEN
\r
860 ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
\r
861 ABBREV_TAC ` (w1:real^3) = ((v1 - v0) dot (v1 - v0)) % (v2 - v0) -
\r
862 ((v2 - v0) dot (v1 - v0)) % (v1 - v0)` THEN
\r
863 ABBREV_TAC ` (w2:real^3) = ((v1 - v0) dot (v1 - v0)) % (v3 - v0) -
\r
864 ((v3 - v0) dot (v1 - v0)) % (v1 - v0) ` THEN
\r
865 ONCE_REWRITE_TAC[MESON[]`( a/\ b ) /\ c /\ d <=>
\r
866 a /\ c /\ b /\ d `] THEN NHANH (NOT_VEC0_IMP_LE1) THEN PHA THEN
\r
867 REWRITE_TAC[MESON[]` P a /\ a = b <=> a = b /\ P b `] THEN
\r
868 SIMP_TAC[REAL_ABS_BOUNDS; acs_atn2; REAL_ARITH ` a - x =
\r
869 a - y <=> x = y `] THEN NHANH (NOT_COLLINEAR_IMP_UPS_LT ) THEN
\r
870 LET_TR THEN PHA THEN NHANH (MESON[REAL_LT_MUL]` &0 < x /\ a1 /\ &0 < y /\ a2 ==>
\r
871 &0 < x * y `) THEN STRIP_TAC THEN FIRST_X_ASSUM MP_TAC THEN
\r
872 ASM_SIMP_TAC[] THEN NHANH SQRT_POS_LT THEN
\r
873 SIMP_TAC[MESON[POS_COMPATIBLE_WITH_ATN2]` &0 < a ==>
\r
874 atn2 ( x, y / a ) = atn2 ( a * x , a * ( y / a ) ) `] THEN
\r
875 SIMP_TAC[REAL_FIELD` &0 < a ==> a * ( y / a ) = y `] THEN
\r
876 REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN
\r
877 PHA THEN NGOAC THEN REWRITE_TAC[GSYM REAL_ABS_BOUNDS] THEN
\r
878 ONCE_REWRITE_TAC[GSYM ABS_1] THEN
\r
879 SIMP_TAC[REAL_LE_SQUARE_ABS; REAL_ARITH` a <= &1 <=>
\r
880 &0 <= &1 - a `; REAL_ARITH` ( &1 ) pow 2 = &1 `; ABS_1] THEN
\r
881 DAO THEN ONCE_REWRITE_TAC[GSYM IMP_IMP] THEN
\r
882 SIMP_TAC[REAL_FIELD` &0 < a ==> &1 - ( b / a ) pow 2
\r
883 = ( a pow 2 - b pow 2 ) / ( a pow 2 ) `] THEN
\r
884 NHANH (REAL_LT_IMP_NZ) THEN NHANH (REAL_LT_IMP_LE) THEN
\r
885 SIMP_TAC[NOT_ZERO_EQ_POW2_LT; REAL_LE_RDIV_0 ; SQRT_DIV] THEN
\r
886 NHANH (REAL_LT_IMP_LE) THEN SIMP_TAC[SQRT_DIV; REAL_LE_POW2] THEN
\r
887 SIMP_TAC[SQRT_DIV; REAL_LE_POW2; POW_2_SQRT; REAL_FIELD` &0 < a ==>
\r
888 a * b / a = b `] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC
\r
889 (MESON[]` a = b ==> atn2 ( sqrt a, c ) = atn2 ( sqrt b, c ) `) THEN
\r
890 ASM_SIMP_TAC[SQRT_WORKS; ups_x; delta_x4; delta_x] THEN
\r
897 let LEMMA16_INTERPRETE = prove(`!(v0: real^N) va vb vc.
\r
898 ~collinear {v0, vc, va} /\ ~collinear {v0, vc, vb}
\r
899 ==> cos (dihV v0 vc va vb) =
\r
900 (cos (arcV v0 va vb) -
\r
901 cos (arcV v0 vc vb) * cos (arcV v0 vc va)) /
\r
902 (sin (arcV v0 vc vb) * sin (arcV v0 vc va))`,
\r
903 MP_TAC RLXWSTK THEN REPEAT LET_TAC THEN SIMP_TAC[]);;
\r
907 let NOT_COLLINEAR_IMP_VEC_FOR_DIHV = ONCE_REWRITE_RULE[GSYM VECTOR_SUB_EQ]
\r
908 (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] ALLEMI_COLLINEAR);;
\r
910 let ACS = ACS_BOUNDS;;
\r
911 let NOT_COLLINEAR_IMP_DIHV_BOUNDED = prove(
\r
912 ` ~( collinear {v0,v1,v2} ) /\ ~( collinear {v0,v1,v3} )
\r
913 ==> &0 <= dihV v0 v1 v2 v3 /\ dihV v0 v1 v2 v3 <= pi`,
\r
914 REWRITE_TAC[dihV; arcV] THEN REPEAT LET_TAC THEN
\r
915 NHANH (NOT_COLLINEAR_IMP_VEC_FOR_DIHV ) THEN
\r
916 ASM_SIMP_TAC[VECTOR_SUB_RZERO] THEN
\r
917 ONCE_REWRITE_TAC[MESON[]` ( a/\b) /\c /\d <=>
\r
918 a /\c/\b/\d`] THEN NHANH (NOT_VEC0_IMP_LE1) THEN
\r
919 SIMP_TAC[REAL_ABS_BOUNDS; ACS]) ;;
\r
923 let DIHV_FORMULAR = prove(` dihV v0 v1 v2 v3 = arcV (vec 0)
\r
924 (((v1 - v0) dot (v1 - v0)) % (v2 - v0) -
\r
925 ((v2 - v0) dot (v1 - v0)) % (v1 - v0))
\r
926 (((v1 - v0) dot (v1 - v0)) % (v3 - v0) -
\r
927 ((v3 - v0) dot (v1 - v0)) % (v1 - v0)) `, REWRITE_TAC[dihV]
\r
928 THEN REPEAT LET_TAC THEN REWRITE_TAC[]);;
\r
931 let COS_POW2_INTER = prove(` cos x pow 2 = &1 - sin x pow 2 `,
\r
932 MP_TAC (SPEC_ALL SIN_CIRCLE) THEN REAL_ARITH_TAC);;
\r
936 let ISTYLPH = prove(` ! (v0:real^N) v1 v2 v3.
\r
937 &0 <= cos (arcV (v0:real^N) v2 v3) /\
\r
938 dihV v0 v3 v1 v2 = pi / &2 /\
\r
939 ~ collinear {v0,v1,v2} /\
\r
940 ~ collinear {v0,v1,v3} /\
\r
941 ~ collinear {v0,v2,v3} /\
\r
942 psi = arcV v0 v2 v3 /\
\r
943 tte = arcV v0 v1 v2 ==>
\r
944 dihV v0 v1 v2 v3 = beta psi tte `,
\r
945 REPEAT GEN_TAC THEN
\r
946 ONCE_REWRITE_TAC[MESON[]` a /\ b ==> c <=>
\r
947 a ==> b ==> c `] THEN
\r
949 ONCE_REWRITE_TAC[SET_RULE` {a,b} = {b,a} `] THEN
\r
950 REWRITE_TAC[ MESON[]` a /\ b /\ c /\ d /\ e <=>
\r
951 a /\ b /\ (c /\ d )/\ e`] THEN
\r
952 NHANH (LEMMA16_INTERPRETE ) THEN
\r
953 PURE_ONCE_REWRITE_TAC[MESON[]` a = b /\ P a <=> a = b
\r
955 SIMP_TAC[COS_PI2] THEN
\r
956 NHANH (NOT_COLLINEAR_IMP_NOT_SIN0) THEN
\r
958 ONCE_REWRITE_TAC[MESON[REAL_ENTIRE]`~( a = &0 ) /\ a1 /\ ~( b = &0 ) /\ &0 = l /\ ll
\r
959 <=> a1 /\ ~ ( b * a = &0 ) /\ &0 = l /\ ll`] THEN
\r
960 ONCE_REWRITE_TAC[SET_RULE` {a,b} = {b,a} `] THEN
\r
961 ONCE_REWRITE_TAC[MESON[]`a /\ ~( aa = &0 ) /\ b /\ c <=>
\r
962 ~( aa = &0 ) /\ c /\ a /\ b `] THEN
\r
963 ABBREV_TAC `TU = sin (arcV v0 v3 v2) * sin (arcV v0 v3 (v1:real^N))` THEN
\r
964 ABBREV_TAC `MA = (cos (arcV v0 v1 v2) - cos (arcV v0 v3 v2) * cos (arcV v0 v3 (v1:real^N)))` THEN
\r
965 NHANH (MESON[REAL_FIELD`~( b = &0 ) /\ a / b = &0 ==> a = &0 `]`
\r
967 &0 = MA / TU /\ ll ==> MA = &0 `) THEN
\r
968 REWRITE_TAC[dihV;beta; arcV] THEN
\r
969 REPEAT LET_TAC THEN
\r
971 MATCH_MP_TAC (MESON[]` a = b ==> P a = P b `) THEN
\r
972 REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN
\r
973 NHANH ( NOT_COLLINEAR_IMP_VEC_FOR_DIHV ) THEN
\r
974 ASM_SIMP_TAC[] THEN
\r
975 PHA THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
\r
976 SIMP_TAC[GSYM NOT_EQ_IMPCOS_ARC] THEN
\r
978 ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
\r
981 EXPAND_TAC "va" THEN
\r
982 EXPAND_TAC "vb" THEN
\r
983 EXPAND_TAC "vc" THEN
\r
984 UNDISCH_TAC `vb' = v2 - (v0:real^N)` THEN
\r
985 UNDISCH_TAC `va' = v1 - (v0:real^N)` THEN
\r
986 UNDISCH_TAC `vc' = v3 - (v0:real^N)` THEN
\r
987 PHA THEN SIMP_TAC[GSYM DIHV_FORMULAR] THEN
\r
988 ASM_SIMP_TAC[LEMMA16_INTERPRETE] THEN
\r
990 UNDISCH_TAC `&0 = MA ` THEN
\r
991 ASM_SIMP_TAC[REAL_ARITH` &0 = a - b <=> a = b `; ARC_SYM;
\r
992 REAL_ARITH` a * b * a = b * a pow 2 `] THEN
\r
993 SIMP_TAC[COS_POW2_INTER; REAL_SUB_LDISTRIB; REAL_MUL_RID;
\r
994 REAL_ARITH` a - ( a - b ) = b `] THEN
\r
995 UNDISCH_TAC `~collinear {v0, v1,(v3:real^N)}` THEN
\r
996 NHANH (NOT_COLLINEAR_IMP_NOT_SIN0) THEN
\r
997 PHA THEN SIMP_TAC[REAL_FIELD` ~( a = &0 ) ==>
\r
998 ( b * a pow 2) / ( a * c ) = (b * a) / c `] THEN
\r
999 UNDISCH_TAC` ~collinear {v0, v1, (v2:real^N)}` THEN
\r
1000 NHANH (NOT_COLL_IM_SIN_LT) THEN
\r
1001 NHANH (REAL_LT_IMP_LE) THEN
\r
1002 UNDISCH_TAC `&0 <= cos (arcV v0 v2 (v3:real^N))` THEN
\r
1004 NHANH (MESON[REAL_LE_MUL; REAL_LE_DIV]`
\r
1005 &0 <= a1 /\aa /\aa1/\
\r
1006 &0 <= a3 /\aa2/\aa3/\
\r
1007 &0 <= a2 /\ lll ==> &0 <= ( a1 * a2 )/ a3 `) THEN
\r
1009 FIRST_X_ASSUM MP_TAC THEN
\r
1010 SIMP_TAC[MESON[POW_2_SQRT]`&0 <= a ==> ( a = b
\r
1011 <=> sqrt ( a pow 2 ) = b )`] THEN
\r
1013 MATCH_MP_TAC (MESON[]` a = b ==> P a = P b `) THEN
\r
1014 EXPAND_TAC "psi" THEN
\r
1015 EXPAND_TAC "tte" THEN
\r
1016 UNDISCH_TAC `va' = (vc:real^N)` THEN
\r
1017 UNDISCH_TAC `vb' = (va:real^N)` THEN
\r
1018 UNDISCH_TAC `vc' = (vb:real^N)` THEN
\r
1019 UNDISCH_TAC ` vb = v3 - v0 /\ vc = v1 - v0 /\ va = v2 - (v0 :real^N)` THEN
\r
1020 PHA THEN SIMP_TAC[GSYM arcV] THEN
\r
1022 SIMP_TAC[REAL_FIELD` ( a / b ) pow 2 = a pow 2 / b pow 2 `] THEN
\r
1023 MATCH_MP_TAC (MESON[]` a = b /\ aa = bb ==> a / aa
\r
1025 SIMP_TAC[SIN_POW2_EQ_1_SUB_COS_POW2; GSYM POW_2] THEN
\r
1026 SIMP_TAC[REAL_ARITH`(A * B ) pow 2 = A pow 2 *
\r
1027 B pow 2 `; SIN_POW2_EQ_1_SUB_COS_POW2] THEN
\r
1028 ASM_SIMP_TAC[] THEN REAL_ARITH_TAC);;
\r
1038 let INTERS_SUBSET = SET_RULE` P a ==> INTERS { x | P x } SUBSET a `;;
\r
1040 let AFFINE_SET_GENERARTED2 = prove(` affine {x | ? t. x = t % u + ( &1 - t ) % v } `,
\r
1041 REWRITE_TAC[affine; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
\r
1042 EXISTS_TAC `t * u' + (t':real) * v'` THEN FIRST_X_ASSUM MP_TAC THEN
\r
1043 SIMP_TAC[REAL_ARITH` a + b = c <=> a = c - b `] THEN
\r
1044 DISCH_TAC THEN ASM_SIMP_TAC[] THEN CONV_TAC VECTOR_ARITH);;
\r
1046 let BASED_POINT2 = prove(` {(u:real^N),v} SUBSET {x | ? t. x = t % u + ( &1 - t ) % v } `,
\r
1047 SIMP_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL
\r
1048 [EXISTS_TAC ` &1 ` THEN CONV_TAC VECTOR_ARITH; EXISTS_TAC ` &0 `] THEN
\r
1049 CONV_TAC VECTOR_ARITH);;
\r
1051 let AFFINE_AFF = prove(` affine ( aff s ) `,
\r
1052 SIMP_TAC[aff; AFFINE_AFFINE_HULL]);;
\r
1054 let INSERT_EMPTY_SUBSET = prove(`(x INSERT s SUBSET t <=> x IN t /\ s SUBSET t)
\r
1055 /\ (!s. {} SUBSET s)`, SIMP_TAC[INSERT_SUBSET; EMPTY_SUBSET]);;
\r
1059 let IN_P_HULL_INSERT = prove(`a IN P hull (a INSERT s)`,
\r
1060 MATCH_MP_TAC (SET_RULE` a IN A /\ A SUBSET P hull A ==> a IN P hull A `) THEN
\r
1061 SIMP_TAC[IN_INSERT; HULL_SUBSET]);;
\r
1063 let UV_IN_AFF2 = MESON[INSERT_AC;IN_P_HULL_INSERT ]`
\r
1064 u IN affine hull {u,v}/\ v IN affine hull {u,v}`;;
\r
1067 let AFF2 = prove(` ! u (v:real^N). aff {u,v} = {x | ? t. x = t % u + ( &1 - t ) % v } `,
\r
1068 SIMP_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REPEAT STRIP_TAC THENL
\r
1069 [SIMP_TAC[aff; hull] THEN MATCH_MP_TAC (INTERS_SUBSET) THEN
\r
1070 SIMP_TAC[BASED_POINT2 ;AFFINE_SET_GENERARTED2 ];
\r
1071 SIMP_TAC[SUBSET; IN_ELIM_THM]] THEN REPEAT STRIP_TAC THEN
\r
1072 MP_TAC (MESON[AFFINE_AFF]` affine ( aff {u, (v:real^N)})`) THEN
\r
1073 ASM_SIMP_TAC[aff; affine] THEN
\r
1074 MESON_TAC[UV_IN_AFF2; REAL_RING` a + &1 - a = &1 `]);;
\r
1077 GEN_ALL (SPECL [`p - (v0:real^N)`;`(u:real^N) - v0 `]
\r
1078 VECTOR_SUB_PROJECT_ORTHOGONAL);;
\r
1080 SPECL[` (u - (v:real^N))`;` (p:real^N)`]
\r
1081 VECTOR_SUB_PROJECT_ORTHOGONAL;;
\r
1084 let EXISTS_PROJECTING_POINT = prove(
\r
1085 `! (p:real^N) u v. ? pp. (u + pp ) IN aff {u,v} /\ (p - pp ) dot ( u - v ) = &0 `,
\r
1086 REPEAT STRIP_TAC THEN MP_TAC (SPECL[` (u - (v:real^N))`;` (p:real^N)`]
\r
1087 VECTOR_SUB_PROJECT_ORTHOGONAL) THEN STRIP_TAC THEN
\r
1088 EXISTS_TAC `((u - v) dot p) / ((u - v) dot (u - v)) % (u - (v:real^N))` THEN
\r
1089 ONCE_REWRITE_TAC[DOT_SYM] THEN
\r
1090 CONJ_TAC THENL [SIMP_TAC[AFF2; IN_ELIM_THM; VECTOR_ARITH` a + x % ( a - b ) =
\r
1091 (&1 + x ) % a + ( &1 - ( &1 + x )) % b `] THEN MESON_TAC[] ;
\r
1092 ASM_MESON_TAC[DOT_SYM]]);;
\r
1095 let UV_IN_AFF2_IMP_TRANSABLE = prove(`! v0 v1 u v.
\r
1096 u IN aff {v0,v1} /\ v IN aff {v0,v1} ==>
\r
1097 ( ( u - v0 ) dot ( v1 - v0 )) * ( ( v - v0) dot ( v1 - v0 )) =
\r
1098 (( v1 - v0 ) dot ( v1 - v0 ) ) * ((u - v0 ) dot ( v - v0 )) `,
\r
1099 REPEAT GEN_TAC THEN REWRITE_TAC[AFF2; IN_ELIM_THM] THEN
\r
1100 STRIP_TAC THEN ASM_SIMP_TAC[VECTOR_ARITH`(t % v0 + (&1 - t) % v1) - v0
\r
1101 = ( &1 - t ) % ( v1 - v0 )`] THEN SIMP_TAC[DOT_LMUL; DOT_RMUL] THEN
\r
1104 let WHEN_K_POS_ARCV_STABLE = prove(` &0 < k ==>
\r
1105 arcV ( vec 0 ) u v = arcV ( vec 0 ) u ( k % v ) `,
\r
1106 REWRITE_TAC[arcV; VECTOR_SUB_RZERO; DOT_RMUL; NORM_MUL] THEN
\r
1107 SIMP_TAC[LT_IMP_ABS_REFL; REAL_FIELD`&0 < a ==> ( a * b ) /
\r
1108 ( d * a * s ) = b / ( d * s ) `]);;
\r
1111 let ARCV_VEC0_FORM = prove(`arcV v0 u v = arcV (vec 0) (u - v0) (v - v0)`,
\r
1112 REWRITE_TAC[arcV; VECTOR_SUB_RZERO]);;
\r
1114 let WHEN_K_POS_ARCV_STABLE2 = prove(` k < &0 ==>
\r
1115 arcV ( vec 0 ) u v = arcV ( vec 0 ) u ( ( -- k) % v ) `,
\r
1116 REWRITE_TAC[REAL_ARITH` n < &0 <=> &0 < -- n `;
\r
1117 WHEN_K_POS_ARCV_STABLE ]);;
\r
1119 let WHEN_K_DIFF0_ARCV = prove(` ~ ( k = &0 ) ==>
\r
1120 arcV ( vec 0 ) u v = arcV ( vec 0 ) u ( ( abs k ) % v ) `,
\r
1121 REWRITE_TAC[REAL_ABS_NZ; WHEN_K_POS_ARCV_STABLE ]);;
\r
1125 let PITHAGO_THEOREM = prove(`x dot y = &0
\r
1126 ==> norm (x + y) pow 2 = norm x pow 2 + norm y pow 2 /\
\r
1127 norm (x - y) pow 2 = norm x pow 2 + norm y pow 2`,
\r
1128 SIMP_TAC[NORM_POW_2; DOT_LADD; DOT_RADD; DOT_RSUB; DOT_LSUB; DOT_SYM] THEN
\r
1132 let NORM_SUB_INVERTABLE = NORM_ARITH` norm (x - y) = norm (y - x)`;;
\r
1136 let OTHORGONAL_WITH_COS = prove(` ! v0 v1 w (p:real^N).
\r
1139 (w - p) dot (v1 - v0) = &0
\r
1140 ==> cos (arcV v0 v1 w) =
\r
1141 ((p - v0) dot (v1 - v0)) / (norm (v1 - v0) * norm (w - v0))`,
\r
1142 REPEAT GEN_TAC THEN SIMP_TAC[NOT_EQ_IMPCOS_ARC] THEN
\r
1143 REPEAT STRIP_TAC THEN
\r
1144 MATCH_MP_TAC (MESON[]` a = b ==> a / c = b / c `) THEN
\r
1145 ONCE_REWRITE_TAC[REAL_RING` a = b <=> a - b = &0 `] THEN
\r
1146 ONCE_REWRITE_TAC[MESON[DOT_SYM]` a dot b - c = b dot a - c `] THEN
\r
1147 FIRST_X_ASSUM MP_TAC THEN SIMP_TAC[GSYM DOT_LSUB; VECTOR_ARITH`
\r
1148 w - v0 - (p - v0) = w - (p:real^N)`; REAL_SUB_RZERO; DOT_SYM]);;
\r
1151 let SIMPLIZE_COS_IF_OTHOR = prove(` ! v0 v1 w (p:real^N).
\r
1153 ~(v0 = v1) /\ ( p - v0 ) = k % (v1 - v0 ) /\
\r
1154 (w - p) dot (v1 - v0) = &0
\r
1155 ==> cos (arcV v0 v1 w) =
\r
1156 k * norm ( v1 - v0 ) / norm (w - v0) `,
\r
1157 SIMP_TAC[OTHORGONAL_WITH_COS; DOT_LMUL; GSYM NORM_POW_2] THEN
\r
1158 REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
\r
1159 ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN REWRITE_TAC[GSYM NORM_POS_LT]
\r
1160 THEN CONV_TAC REAL_FIELD);;
\r
1163 let SIN_EQ_SQRT_ONE_SUB = prove(` ~((v0:real^N) = va) /\ ~(v0 = vb) ==>
\r
1164 sin ( arcV v0 va vb ) = sqrt ( &1 - cos ( arcV v0 va vb ) pow 2 ) `,
\r
1165 DISCH_TAC THEN MATCH_MP_TAC (SIN_COS_SQRT) THEN ASM_SIMP_TAC[PROVE_SIN_LE]);;
\r
1169 let SIN_DI_HOC = prove(`~((v0:real^N) = w) /\ ~(v0 = vb) /\ p IN aff {v0, w} /\ (p - vb) dot (w - v0) = &0
\r
1170 ==> sin (arcV v0 w vb) = norm (p - vb) / norm (vb - v0)`,
\r
1171 SIMP_TAC[SIN_EQ_SQRT_ONE_SUB] THEN ONCE_REWRITE_TAC[REAL_ARITH` a = &0 <=> -- a = &0 `] THEN
\r
1172 SIMP_TAC[GSYM DOT_LNEG; VECTOR_NEG_SUB; OTHORGONAL_WITH_COS] THEN
\r
1173 SIMP_TAC[AFF2; IN_ELIM_THM; VECTOR_ARITH` p = t % v0 + (&1 - t) % w
\r
1174 <=> p - v0 = (&1 - t ) % ( w - v0 ) `] THEN
\r
1175 STRIP_TAC THEN ASM_SIMP_TAC[DOT_LMUL; GSYM NORM_POW_2] THEN
\r
1176 ONCE_REWRITE_TAC[MESON[REAL_LE_DIV; POW_2_SQRT; NORM_POS_LE]`
\r
1177 norm a / norm b = sqrt (( norm a / norm b ) pow 2 ) `] THEN
\r
1178 MATCH_MP_TAC (MESON[]` a = b ==> p a = p b `) THEN
\r
1179 UNDISCH_TAC` ~(v0 = (w:real^N))` THEN UNDISCH_TAC`~(v0 = (vb:real^N))` THEN
\r
1180 ONCE_REWRITE_TAC[VECTOR_ARITH` a = b <=> (b:real^N) - a = vec 0 `] THEN
\r
1181 SIMP_TAC[ GSYM NORM_POS_LT; REAL_FIELD` &0 < a ==>
\r
1182 ( c * a pow 2 ) / ( a * b ) = (c * a )/ b /\
\r
1183 &1 - ( b / a ) pow 2 = ( a pow 2 - b pow 2 ) / a pow 2 `] THEN
\r
1184 REPEAT STRIP_TAC THEN SIMP_TAC[DIV_POW2] THEN
\r
1185 MATCH_MP_TAC (MESON[]` a = b ==> a / x = b / x `) THEN
\r
1186 SIMP_TAC[MUL_POW2] THEN ONCE_REWRITE_TAC[MESON[REAL_POW2_ABS]`
\r
1187 a pow 2 * t = ( abs a ) pow 2 * t`] THEN
\r
1188 SIMP_TAC[GSYM MUL_POW2; GSYM NORM_MUL] THEN DOWN_TAC THEN
\r
1189 ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN SIMP_TAC[] THEN
\r
1190 NHANH (MESON[]` a = b ==> ( vb - (p:real^N)) dot a
\r
1191 = ( vb - (p:real^N)) dot b `) THEN
\r
1192 REWRITE_TAC[DOT_RMUL; MESON[]` ( a /\ x * t = c ) /\
\r
1193 &0 = t /\ l <=> a /\ c = x * ( &0 ) /\ t = &0 /\ l `;
\r
1194 REAL_MUL_RZERO] THEN NHANH (PITHAGO_THEOREM) THEN
\r
1195 SIMP_TAC[VECTOR_ARITH` vb - p + p - v0 = vb - (v0:real^N)`] THEN
\r
1196 STRIP_TAC THEN SIMP_TAC[NORM_SUB] THEN REAL_ARITH_TAC );;
\r
1199 let CHANG_BIET_GI = prove(`pu - p = (&1 - t) % (w - p) ==> pu IN aff {p, w}`,
\r
1200 REWRITE_TAC[AFF2; IN_ELIM_THM; VECTOR_ARITH`pu - p = (&1 - t) % (w - p) <=>
\r
1201 pu = t % p + ( &1 - t ) % w `] THEN MESON_TAC[]);;
\r
1204 let SUB_DOT_EQ_0_INVERTALE = prove(` ( a - b ) dot c = &0 <=> ( b - a ) dot c = &0 `,
\r
1205 SIMP_TAC[DOT_LSUB] THEN REAL_ARITH_TAC);;
\r
1208 let SIN_DI_HOC2 = ONCE_REWRITE_RULE[SUB_DOT_EQ_0_INVERTALE] SIN_DI_HOC;;
\r
1212 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
1213 ( u - pu ) dot (w - p ) = &0 /\
\r
1214 ( v - pv ) dot (w - p ) = &0 /\
\r
1215 ~( p = u \/ p = v \/ p = w ) ==>
\r
1216 cos ( arcV p w u + arcV p w v ) - cos ( arcV p u v ) =
\r
1217 (-- ( v - pv ) dot ( u - pu ) - norm ( v - pv ) * norm ( u - pu )) /
\r
1218 (norm ( p - u ) * norm ( p - v ))`,
\r
1219 SIMP_TAC[COS_ADD; AFF2; IN_ELIM_THM; VECTOR_ARITH` pu = t % p + (&1 - t) % w <=> pu - p = ( &1 - t ) % (w - p ) `;
\r
1220 DE_MORGAN_THM] THEN
\r
1221 REPEAT STRIP_TAC THEN
\r
1223 NHANH (MESON[SIMPLIZE_COS_IF_OTHOR]` pu - p = (&1 - t) % (w - p) /\
\r
1224 pv - p = (&1 - t') % (w - p) /\
\r
1225 (u - pu) dot (w - p) = &0 /\
\r
1226 (v - pv) dot (w - p) = &0 /\
\r
1229 ~(p = w) ==> cos (arcV p w u) =
\r
1230 (&1 - t ) * norm (w - p) / norm (u - p) /\
\r
1231 cos (arcV p w v) =
\r
1232 ( &1 - t') * norm (w - p ) / norm ( v - p ) `) THEN
\r
1233 NHANH (CHANG_BIET_GI) THEN
\r
1234 NHANH (MESON[SIN_DI_HOC2]`(a11 /\ pu IN aff {p, w}) /\
\r
1235 (a22 /\ pv IN aff {p, w}) /\
\r
1236 (u - pu) dot (w - p) = &0 /\
\r
1237 (v - pv) dot (w - p) = &0 /\
\r
1241 sin (arcV p w u) = norm ( pu - u ) / norm ( u - p ) /\
\r
1242 sin (arcV p w v) = norm ( pv - v ) / norm ( v - p ) `) THEN
\r
1244 ASM_SIMP_TAC[NOT_EQ_IMPCOS_ARC; REAL_FIELD` a / b * aa / bb
\r
1245 = ( a * aa ) / ( b * bb ) `; REAL_RING` (a * b ) * c * d = a * c * b * d `;
\r
1246 REAL_FIELD` a * b / c = ( a * b ) / c `; REAL_FIELD ` a / b - c / b
\r
1247 = ( a - c ) / b `; NORM_SUB] THEN
\r
1248 MATCH_MP_TAC (MESON[]` a = b ==> a / x = b / x `) THEN
\r
1249 SIMP_TAC[NORM_SUB; REAL_MUL_SYM; REAL_ARITH` a - b - c = v - b <=>
\r
1250 a - c - v = &0 `] THEN
\r
1251 REWRITE_TAC[MESON[VECTOR_ARITH` a - b = a - x + x - (b:real^N)`]`
\r
1252 a - (u - p) dot (v - p) = a - (u - pu + pu - p) dot (v - pv + pv - p) `;
\r
1253 DOT_LADD; DOT_RADD] THEN
\r
1254 ASM_SIMP_TAC[DOT_LMUL; DOT_RMUL; DOT_SYM; REAL_MUL_RZERO;
\r
1255 REAL_ADD_RID; GSYM NORM_POW_2; GSYM POW_2; NORM_SUB;DOT_LNEG;
\r
1256 REAL_ADD_LID] THEN REAL_ARITH_TAC);;
\r
1262 let ARCV_BOUNDED = prove(` ~( v0 = u ) /\ ~ ( v0 = v ) ==>
\r
1263 &0 <= arcV v0 u v /\ arcV v0 u v <= pi`,
\r
1264 NHANH (NOT_IDEN_IMP_ABS_LE) THEN REWRITE_TAC[arcV; REAL_ABS_BOUNDS]
\r
1265 THEN SIMP_TAC[ACS_BOUNDS]);;
\r
1268 (* This lemma in Multivariate/transc.ml
\r
1269 let COS_MONO_LT_EQ = new_axiom
\r
1270 `!x y. &0 <= x /\ x <= pi /\ &0 <= y /\ y <= pi
\r
1271 ==> (cos(x) < cos(y) <=> y < x)`;;
\r
1275 let COS_MONOPOLY = prove(
\r
1276 ` ! a b. &0 <= a /\ a <= pi /\ &0 <= b /\ b <= pi ==>
\r
1277 ( a < b <=> cos b < cos a ) `, MESON_TAC[COS_MONO_LT_EQ]);;
\r
1279 let COS_MONOPOLY_EQ = prove(
\r
1280 ` ! a b. &0 <= a /\ a <= pi /\ &0 <= b /\ b <= pi ==>
\r
1281 ( a <= b <=> cos b <= cos a ) `,
\r
1282 REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT]
\r
1283 THEN ASM_MESON_TAC[COS_MONOPOLY ]);;
\r
1286 let END_POINT_ADD_IN_AFF2 = prove(`!k (u:real^N) v. u + k % (u - v) IN aff {u, v} /\
\r
1287 u + k % (v - u ) IN aff {u,v} `,
\r
1288 REWRITE_TAC[AFF2; VECTOR_ARITH` u + k % (u - v) =
\r
1289 ( &1 + k ) % u + ( &1 - ( &1 + k )) % v `] THEN
\r
1290 SIMP_TAC[VECTOR_ARITH` u + k % (v - u) =
\r
1291 (&1 - k) % u + (&1 - (&1 - k)) % v`] THEN SET_TAC[]);;
\r
1293 let EXISTS_PROJECTING_POINT2 = prove(`!(p:real^N) u v0 . ?pp. pp IN aff {u, v0} /\ (p - pp) dot (u - v0) = &0`,
\r
1294 REPEAT GEN_TAC THEN MP_TAC (SPECL[` u - (v0:real^N) `; `p - ( v0 :real^N)`]
\r
1295 VECTOR_SUB_PROJECT_ORTHOGONAL) THEN
\r
1296 SIMP_TAC[DOT_SYM; VECTOR_ARITH` a - b - c = a - ( b + (c:real^N))`] THEN
\r
1297 ONCE_REWRITE_TAC[INSERT_AC] THEN MESON_TAC[END_POINT_ADD_IN_AFF2 ]);;
\r
1300 let KEY_LEMMA_FOR_ANGLES1 =
\r
1301 ONCE_REWRITE_RULE[ INSERT_AC] KEY_LEMMA_FOR_ANGLES;;
\r
1303 SPECL[`p:real^N`; `u:real^N`; `v:real^N`;`x:real^N`;`ux:real^N`;`vx:real^N`]
\r
1304 KEY_LEMMA_FOR_ANGLES1;;
\r
1306 let ARCV_INEQUALTY = prove(`! p u v (x:real^N). ~ ( p = x ) /\ ~( p = u ) /\ ~( p = v ) ==>
\r
1307 arcV p u v <= arcV p u x + arcV p x v `,
\r
1308 NHANH (ARCV_BOUNDED) THEN
\r
1309 REPEAT GEN_TAC THEN
\r
1310 ASM_CASES_TAC` pi <= arcV p u x + arcV p x (v:real^N)` THENL
\r
1311 [ASM_MESON_TAC[REAL_LE_TRANS];
\r
1313 NHANH (MESON[ARCV_BOUNDED ]`~(p = x) /\ ~(p = u) /\ ~(p = v) /\ l
\r
1314 ==> &0 <= arcV p u x /\ &0 <= arcV p x v `) THEN
\r
1315 NHANH (REAL_LE_ADD) THEN
\r
1317 NHANH (REAL_ARITH` ~(a <= b ) ==> b <= a `) THEN
\r
1318 SIMP_TAC[COS_MONOPOLY_EQ ] THEN
\r
1319 MP_TAC (MESON[EXISTS_PROJECTING_POINT2]` ? (ux:real^N) vx.
\r
1320 ux IN aff {x,p} /\ vx IN aff {x,p} /\
\r
1321 ( u - ux ) dot (x - p ) = &0 /\
\r
1322 ( v - vx ) dot ( x - p ) = &0 `) THEN
\r
1323 REPEAT STRIP_TAC THEN
\r
1325 REWRITE_TAC[MESON[]` ux IN aff {x, p} /\
\r
1326 vx IN aff {x, p} /\
\r
1327 (u - ux) dot (x - p) = &0 /\
\r
1328 (v - vx) dot (x - p) = &0 /\a11/\a22 /\
\r
1331 ~(p = v) /\ l <=> a11 /\ a22 /\ l /\ ux IN aff {x, p} /\
\r
1332 vx IN aff {x, p} /\
\r
1333 (u - ux) dot (x - p) = &0 /\
\r
1334 (v - vx) dot (x - p) = &0 /\
\r
1335 ~(p = u \/ p = v \/ p = x) `] THEN
\r
1336 NHANH (SPECL[`p:real^N`; `u:real^N`; `v:real^N`;`x:real^N`;`ux:real^N`;`vx:real^N`]
\r
1337 KEY_LEMMA_FOR_ANGLES1) THEN
\r
1338 ONCE_REWRITE_TAC[REAL_ARITH` a <= b <=> a - b <= &0 `] THEN
\r
1339 SIMP_TAC[ARC_SYM; DE_MORGAN_THM] THEN
\r
1340 ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
\r
1341 SIMP_TAC[GSYM NORM_POS_LT; REAL_FIELD` a / ( b * c ) = ( a / b) / c `] THEN
\r
1342 SIMP_TAC[REAL_ARITH` (a/ b ) / c <= &0 <=> &0 <= (( -- a ) / b ) / c `;
\r
1343 REAL_LE_RDIV_0] THEN
\r
1345 REWRITE_TAC[REAL_ARITH`&0 <= -- ( a - b ) <=> a <= b `] THEN
\r
1346 MESON_TAC[NORM_NEG; NORM_CAUCHY_SCHWARZ]]);;
\r
1348 let KEITDWB = ARCV_INEQUALTY;;
\r
1352 g `! (p:real^N) (n:num) fv.
\r
1353 2 <= n /\ (!i. i <= n ==> ~(p = fv i))
\r
1354 ==> arcV p (fv 0) (fv n) <=
\r
1355 sum (0..n - 1) (\i. arcV p (fv i) (fv (i + 1)))`;;
\r
1359 e (SIMP_TAC[ARITH_RULE` ~( 2 <= 0 ) `]);;
\r
1360 e (SPEC_TAC (`n:num`,` a:num`));;
\r
1362 e (SIMP_TAC[ONE; ARITH_RULE` ~(2 <= SUC 0) `]);;
\r
1363 e (SPEC_TAC(`a:num`,`u:num`));;
\r
1365 e (SIMP_TAC[ARITH_RULE` 2 <= 2 `;ARITH_RULE `SUC ( SUC 0 ) = 2 ` ]);;
\r
1366 e (SIMP_TAC[ARITH_RULE` 0 < 1 /\ 2 - 1 = 1 `;ARITH_RULE` 0 <= 1 `; SUM_CLAUSES_RIGHT]);;
\r
1367 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
1368 e (SIMP_TAC[MESON[]` (! a. a = x \/ a = y \/ a = z ==> Q a ) <=> Q x /\ Q y /\ Q z `]);;
\r
1369 e (MP_TAC ARCV_INEQUALTY );;
\r
1370 e (SIMP_TAC[IN_INSERT; NOT_IN_EMPTY]);;
\r
1372 e (MP_TAC (ARITH_RULE` 2 <= SUC ( SUC u )`));;
\r
1373 e (ABBREV_TAC ` ed = ( SUC (SUC u ))`);;
\r
1374 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
1376 e (ONCE_REWRITE_TAC[MESON[]` a /\ b/\ c/\ d <=> b /\ d /\ a /\ c `]);;
\r
1377 e (REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC));;
\r
1379 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
1380 e (NHANH (ARITH_RULE` 2 <= d ==> 0 < d - 1 + 1 /\ 0 <= d - 1 + 1 `));;
\r
1381 e (SIMP_TAC[ARITH_RULE` 2 <= a ==> ( a + 1 ) - 1 = a - 1 + 1 `; SUM_CLAUSES_RIGHT]);;
\r
1382 e (ASM_SIMP_TAC[ARITH_RULE` (ed - 1 + 1) - 1 = ed - 1 `]);;
\r
1383 e (SIMP_TAC[ARITH_RULE` 2 <= d ==> d - 1 + 1 = d `]);;
\r
1385 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
1386 e (STRIP_TAC THEN FIRST_X_ASSUM MP_TAC);;
\r
1387 e (MATCH_MP_TAC (REAL_ARITH` a <= b + c ==> b <= x ==> a <= x + c `));;
\r
1388 e (FIRST_X_ASSUM MP_TAC);;
\r
1389 e (NHANH (MESON[LE_REFL; LE_0]` (! i. i <= d ==> p i ) ==> p ( 0 ) /\ p ( d ) `));;
\r
1390 e (MP_TAC (ARCV_INEQUALTY));;
\r
1391 e (ASM_SIMP_TAC[IN_INSERT; NOT_IN_EMPTY]);;
\r
1393 let FGNMPAV = top_thm();;
\r
1396 let FGNMPAV = prove_by_refinement(
\r
1397 `! (p:real^N) (n:num) fv.
\r
1398 2 <= n /\ (!i. i <= n ==> ~(p = fv i))
\r
1399 ==> arcV p (fv 0) (fv n) <=
\r
1400 sum (0..n - 1) (\i. arcV p (fv i) (fv (i + 1)))`,
\r
1405 BY((SIMP_TAC[ARITH_RULE` ~( 2 <= 0 ) `]));
\r
1406 (SPEC_TAC (`n:num`,` a:num`));
\r
1408 BY((SIMP_TAC[ONE; ARITH_RULE` ~(2 <= SUC 0) `]));
\r
1409 (SPEC_TAC(`a:num`,`u:num`));
\r
1411 (SIMP_TAC[ARITH_RULE` 2 <= 2 `;ARITH_RULE `SUC ( SUC 0 ) = 2 ` ]);
\r
1412 (SIMP_TAC[ARITH_RULE` 0 < 1 /\ 2 - 1 = 1 `;ARITH_RULE` 0 <= 1 `; SUM_CLAUSES_RIGHT]);
\r
1413 (SIMP_TAC[SUB_REFL; SUM_SING_NUMSEG; ADD; ARITH_RULE` 1 + 1 = 2 `; ARITH_RULE` i <= 2 <=> i = 0 \/ i = 1 \/ i = 2 `]);
\r
1414 (SIMP_TAC[MESON[]` (! a. a = x \/ a = y \/ a = z ==> Q a ) <=> Q x /\ Q y /\ Q z `]);
\r
1415 (MP_TAC ARCV_INEQUALTY );
\r
1416 BY((SIMP_TAC[IN_INSERT; NOT_IN_EMPTY]));
\r
1418 (MP_TAC (ARITH_RULE` 2 <= SUC ( SUC u )`));
\r
1419 (ABBREV_TAC ` ed = ( SUC (SUC u ))`);
\r
1420 (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
1422 (ONCE_REWRITE_TAC[MESON[]` a /\ b/\ c/\ d <=> b /\ d /\ a /\ c `]);
\r
1423 (REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC));
\r
1425 (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
1426 (NHANH (ARITH_RULE` 2 <= d ==> 0 < d - 1 + 1 /\ 0 <= d - 1 + 1 `));
\r
1427 (SIMP_TAC[ARITH_RULE` 2 <= a ==> ( a + 1 ) - 1 = a - 1 + 1 `; SUM_CLAUSES_RIGHT]);
\r
1428 (ASM_SIMP_TAC[ARITH_RULE` (ed - 1 + 1) - 1 = ed - 1 `]);
\r
1429 (SIMP_TAC[ARITH_RULE` 2 <= d ==> d - 1 + 1 = d `]);
\r
1431 (REWRITE_TAC[MESON[ARITH_RULE` 2 = ed + 1 ==> ~( 2 <= ed ) `]` ( a \/ 2 = ed + 1) /\ aa /\ 2 <= ed /\ ll <=> a /\ aa /\ 2 <= ed /\ ll `]);
\r
1432 (STRIP_TAC THEN FIRST_X_ASSUM MP_TAC);
\r
1433 (MATCH_MP_TAC (REAL_ARITH` a <= b + c ==> b <= x ==> a <= x + c `));
\r
1434 (FIRST_X_ASSUM MP_TAC);
\r
1435 (NHANH (MESON[LE_REFL; LE_0]` (! i. i <= d ==> p i ) ==> p ( 0 ) /\ p ( d ) `));
\r
1436 (MP_TAC (ARCV_INEQUALTY));
\r
1437 BY((ASM_SIMP_TAC[IN_INSERT; NOT_IN_EMPTY]))
\r
1441 let IMP_TAC = ONCE_REWRITE_TAC[MESON[]` a/\ b ==> c
\r
1442 <=> a ==> b ==> c `];;
\r
1445 g ` &0 <= t12 /\ t12 < &2 * pi /\ t12 = &2 * pi * real_of_int k12
\r
1448 e (ASM_CASES_TAC` (k12:int) < &0 `);;
\r
1449 e (MP_TAC (PI_POS));;
\r
1451 e (SIMP_TAC[GSYM REAL_NEG_GT0; int_lt; int_of_num_th]);;
\r
1452 e (NGOAC THEN NHANH (REAL_LT_MUL));;
\r
1453 e (REWRITE_TAC[REAL_ARITH` &0 < -- a * b <=> &2 * b * a < &0 `]);;
\r
1454 e (MESON_TAC[REAL_ARITH` ~( a < &0 /\ &0 <= a ) `]);;
\r
1455 e (ASM_CASES_TAC `(k12:int) = &0 `);;
\r
1456 e (ASM_SIMP_TAC[int_of_num_th; REAL_MUL_RZERO]);;
\r
1459 e (REWRITE_TAC[ARITH_RULE` ~(k12 < &0) /\ ~((k12:int) = &0) <=> &1 <= k12 `]);;
\r
1460 e (SIMP_TAC[int_le; int_of_num_th]);;
\r
1461 e (MP_TAC PI_POS);;
\r
1463 e (ONCE_REWRITE_TAC[MESON[REAL_LE_LMUL_EQ]` &0 < pi /\ &1 <= aa /\ l <=> &0 < pi /\ pi * &1 <= pi * aa /\ l `]);;
\r
1464 e (REWRITE_TAC[REAL_ARITH` a * &1 <= b <=> &2 * a <= &2 * b `]);;
\r
1465 e (MESON_TAC[REAL_ARITH` ~( a < b /\ b <= a ) `]);;
\r
1467 let IN_A_PERIOD_IDE0 = top_thm();;
\r
1470 let IN_A_PERIOD_IDE0 = prove_by_refinement(
\r
1471 ` &0 <= t12 /\ t12 < &2 * pi /\ t12 = &2 * pi * real_of_int k12
\r
1475 (ASM_CASES_TAC` (k12:int) < &0 `);
\r
1476 (MP_TAC (PI_POS));
\r
1478 (SIMP_TAC[GSYM REAL_NEG_GT0; int_lt; int_of_num_th]);
\r
1479 (NGOAC THEN NHANH (REAL_LT_MUL));
\r
1480 (REWRITE_TAC[REAL_ARITH` &0 < -- a * b <=> &2 * b * a < &0 `]);
\r
1481 BY((MESON_TAC[REAL_ARITH` ~( a < &0 /\ &0 <= a ) `]));
\r
1482 (ASM_CASES_TAC `(k12:int) = &0 `);
\r
1483 BY((ASM_SIMP_TAC[int_of_num_th; REAL_MUL_RZERO]));
\r
1486 (REWRITE_TAC[ARITH_RULE` ~(k12 < &0) /\ ~((k12:int) = &0) <=> &1 <= k12 `]);
\r
1487 (SIMP_TAC[int_le; int_of_num_th]);
\r
1490 (ONCE_REWRITE_TAC[MESON[REAL_LE_LMUL_EQ]` &0 < pi /\ &1 <= aa /\ l <=> &0 < pi /\ pi * &1 <= pi * aa /\ l `]);
\r
1491 (REWRITE_TAC[REAL_ARITH` a * &1 <= b <=> &2 * a <= &2 * b `]);
\r
1492 BY((MESON_TAC[REAL_ARITH` ~( a < b /\ b <= a ) `]))
\r
1498 let UNIQUE_PROPERTY_IN_A_PERIOD = prove(
\r
1499 `&0 <= t12 /\ t12 < &2 * pi /\ &0 <= a /\ a < &2 * pi /\
\r
1500 t12 = a + &2 * pi * real_of_int k12 ==> t12 = a `,
\r
1501 NHANH (REAL_FIELD` &0 <= t12 /\
\r
1504 a < &2 * pi /\ ll ==> t12 + -- a < &2 * pi /\
\r
1505 -- ( t12 + -- a ) < &2 * pi `) THEN
\r
1506 ASM_CASES_TAC` &0 <= t12 + -- a ` THENL [
\r
1507 REWRITE_TAC[REAL_ARITH` a = b + c <=> a + -- b = c `] THEN
\r
1509 ONCE_REWRITE_TAC[REAL_ARITH` a = b <=> a + -- b = &0 `] THEN
\r
1511 MESON_TAC[IN_A_PERIOD_IDE0 ];
\r
1512 SIMP_TAC[REAL_ARITH` a = b + c * d * e <=>
\r
1513 -- ( a + -- b ) = c * d * ( -- e ) `; GSYM int_neg_th] THEN
\r
1515 ONCE_REWRITE_TAC[REAL_ARITH` a = b <=> -- ( a + -- b ) = &0 `] THEN
\r
1517 NHANH (REAL_ARITH` ~(&0 <= b ) ==> &0 <= -- b `) THEN
\r
1518 MESON_TAC[IN_A_PERIOD_IDE0 ]]);;
\r
1522 g `!t1 t2 k12 k21.
\r
1531 t12 = t1 - t2 + &2 * pi * real_of_int k12 /\
\r
1532 t21 = t2 - t1 + &2 * pi * real_of_int k21
\r
1533 ==> (t1 = t2 ==> t12 + t21 = &0) /\ (~(t1 = t2) ==> t12 + t21 = &2 * pi)`;;
\r
1535 e (REPEAT STRIP_TAC);;
\r
1539 e (SIMP_TAC[REAL_SUB_REFL; REAL_ADD_LID; REAL_ADD_RID]);;
\r
1540 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
1541 e (ONCE_REWRITE_TAC[EQ_SYM_EQ]);;
\r
1542 e (SIMP_TAC[REAL_ADD_LID]);;
\r
1545 e (SPEC_TAC(`t1:real`,` t1:real`));;
\r
1546 e (SPEC_TAC(`t2:real`,` t2:real`));;
\r
1547 e (SPEC_TAC(`t12:real`,` t12:real`));;
\r
1548 e (SPEC_TAC(`t21:real`,` t21:real`));;
\r
1549 e (SPEC_TAC(`k12:int`,` k12:int`));;
\r
1550 e (SPEC_TAC(`k21:int`,` k21:int`));;
\r
1551 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
1555 e (SIMP_TAC[REAL_ADD_SYM]);;
\r
1556 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
1557 e (REPEAT STRIP_TAC);;
\r
1558 e (REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC));;
\r
1559 e (ONCE_REWRITE_TAC[REAL_ARITH` a <= b <=> &0 <= b - a `]);;
\r
1561 e (ONCE_REWRITE_TAC[GSYM REAL_SUB_0]);;
\r
1562 e (NHANH (REAL_FIELD` ~( t2 = &0) /\ t2 < pp /\ &0 <= t2 ==> &0 <= pp - t2 /\ pp - t2 < pp `));;
\r
1563 e (FIRST_X_ASSUM MP_TAC);;
\r
1564 e (ONCE_REWRITE_TAC[REAL_ARITH` a - b + &2* pi * c = &2 * pi - ( b - a ) + &2 * pi * ( c - &1 ) `]);;
\r
1565 e (ABBREV_TAC ` ttt = &2 * pi - (t1 - t2)`);;
\r
1566 e (ONCE_REWRITE_TAC[MESON[int_of_num_th]` &1 = real_of_int (&1)`]);;
\r
1568 e (REWRITE_TAC[GSYM int_sub_th]);;
\r
1569 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
1570 e (ONCE_REWRITE_TAC[EQ_SYM_EQ]);;
\r
1573 e (CONV_TAC REAL_RING);;
\r
1575 let PDPFQUK = top_thm();;
\r
1578 let PDPFQUK = prove_by_refinement(
\r
1588 t12 = t1 - t2 + &2 * pi * real_of_int k12 /\
\r
1589 t21 = t2 - t1 + &2 * pi * real_of_int k21
\r
1590 ==> (t1 = t2 ==> t12 + t21 = &0) /\ (~(t1 = t2) ==> t12 + t21 = &2 * pi)`,
\r
1593 (REPEAT STRIP_TAC);
\r
1597 (SIMP_TAC[REAL_SUB_REFL; REAL_ADD_LID; REAL_ADD_RID]);
\r
1598 (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
1599 (ONCE_REWRITE_TAC[EQ_SYM_EQ]);
\r
1600 BY((SIMP_TAC[REAL_ADD_LID]));
\r
1602 (SPEC_TAC(`t1:real`,` t1:real`));
\r
1603 (SPEC_TAC(`t2:real`,` t2:real`));
\r
1604 (SPEC_TAC(`t12:real`,` t12:real`));
\r
1605 (SPEC_TAC(`t21:real`,` t21:real`));
\r
1606 (SPEC_TAC(`k12:int`,` k12:int`));
\r
1607 (SPEC_TAC(`k21:int`,` k21:int`));
\r
1608 (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
1610 BY((MESON_TAC[]));
\r
1612 BY((SIMP_TAC[REAL_ADD_SYM]));
\r
1613 (NHANH (REAL_FIELD` &0 <= t1 /\ t1 < &2 * pi /\ &0 <= t2 /\ t2 < &2 * pi /\ &0 <= t12 /\ t12 < &2 * pi /\ l ==> t1 - t2 < &2 * pi`));
\r
1614 (REPEAT STRIP_TAC);
\r
1615 (REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC));
\r
1616 (ONCE_REWRITE_TAC[REAL_ARITH` a <= b <=> &0 <= b - a `]);
\r
1618 (ONCE_REWRITE_TAC[GSYM REAL_SUB_0]);
\r
1619 (NHANH (REAL_FIELD` ~( t2 = &0) /\ t2 < pp /\ &0 <= t2 ==> &0 <= pp - t2 /\ pp - t2 < pp `));
\r
1620 (FIRST_X_ASSUM MP_TAC);
\r
1621 (ONCE_REWRITE_TAC[REAL_ARITH` a - b + &2* pi * c = &2 * pi - ( b - a ) + &2 * pi * ( c - &1 ) `]);
\r
1622 (ABBREV_TAC ` ttt = &2 * pi - (t1 - t2)`);
\r
1623 (ONCE_REWRITE_TAC[MESON[int_of_num_th]` &1 = real_of_int (&1)`]);
\r
1625 (REWRITE_TAC[GSYM int_sub_th]);
\r
1626 (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
1627 (ONCE_REWRITE_TAC[EQ_SYM_EQ]);
\r
1630 BY((CONV_TAC REAL_RING))
\r
1639 let QAFHJNM = prove(`! (v:real^N) w x .
\r
1640 let e3 = ( &1 / norm ( w - v )) % (w - v ) in
\r
1641 let r = norm ( x - v ) in
\r
1642 let phi = arcV v w x in
\r
1643 ~( v = x ) /\ ~ ( v = w )
\r
1644 ==> (? u'. u' dot e3 = &0 /\
\r
1645 x = v + u' + ( r * cos phi ) % e3 ) `,
\r
1646 NHANH (MESON[EXISTS_PROJECTING_POINT2]`l /\ ~(v = w) ==> (?pp. (pp:real^N) IN aff {w, v}
\r
1647 /\ (x - pp) dot (w - v) = &0 ) `) THEN REPEAT STRIP_TAC THEN REPEAT LET_TAC THEN
\r
1648 SIMP_TAC[AFF2; IN_ELIM_THM; VECTOR_ARITH` pp = t % w + (&1 - t) % v <=> pp - v = t % ( w - v ) `]
\r
1649 THEN EXPAND_TAC "phi" THEN STRIP_TAC THEN EXISTS_TAC ` x - (pp:real^N)` THEN
\r
1650 REPLICATE_TAC 4 (FIRST_X_ASSUM MP_TAC) THEN PHA THEN NHANH (SIMPLIZE_COS_IF_OTHOR) THEN
\r
1651 EXPAND_TAC "e3" THEN SIMP_TAC[DOT_RMUL; REAL_MUL_RZERO; VECTOR_MUL_ASSOC] THEN
\r
1652 ONCE_REWRITE_TAC[VECTOR_ARITH` a = b <=> b - a = vec 0 `] THEN
\r
1653 SIMP_TAC[GSYM NORM_EQ_0] THEN EXPAND_TAC "r" THEN SIMP_TAC[GSYM NORM_EQ_0; REAL_FIELD`
\r
1654 ~(x = &0) /\ ~(w = &0) ==> ( x * t * w / x ) * &1 / w = t `] THEN
\r
1655 SIMP_TAC[VECTOR_ARITH` (v + x - pp + tt ) - x = (tt: real^N) - (pp - v) `]);;
\r
1657 (* August, 2009 *)
\r
1658 let YBXRVTS = prove(`! v w (u:real^3) x.
\r
1659 ~collinear {v,w,u} /\
\r
1660 n = (w - v) cross (u - v ) /\
\r
1661 x IN aff {v,w,u} ==>
\r
1662 angle (( v + n ), v, x) = pi / &2 `,
\r
1663 REWRITE_TAC[aff;AFFINE_HULL_3; IN_ELIM_THM;angle; vector_angle] THEN
\r
1664 REPEAT STRIP_TAC THEN COND_CASES_TAC THENL [REWRITE_TAC[];
\r
1665 UNDISCH_TAC ` u' + v' + w' = &1 ` THEN
\r
1666 ASM_SIMP_TAC[VECTOR_ARITH`(a + b ) - a = (b:real^N)`; REAL_ARITH` a + b = &1 <=> a = &1 - b `;
\r
1667 VECTOR_ARITH` ((&1 - (v' + w')) % v + v' % w + w' % u) - v = v' % ( w - v ) + w' % ( u - v ) `;
\r
1668 DOT_RADD; DOT_RMUL; DOT_CROSS_SELF;REAL_MUL_RZERO ;REAL_ADD_RID; REAL_ARITH` &0 / a = &0`; PI2_EQ_ACS0]]);;
\r
1673 let types_thm th = let cl = concl th in
\r
1674 List.map dest_var (frees cl );;
\r
1677 let (tms,tm) = top_goal () in
\r
1678 let vss = map frees (tm::tms) in
\r
1679 let vs = setify (flat vss) in
\r
1684 (* ========= NEW RULES and TAC TIC ============================= *)
\r
1685 (* ============================================================= *)
\r
1686 (* ============================================================= *)
\r
1689 let PAT_REWRITE_TAC tm thms =
\r
1690 (CONV_TAC (PAT_CONV tm (REWRITE_CONV thms )));;
\r
1693 let th1 = REWRITE_RULE[MESON[]` a /\ b ==> c <=>
\r
1694 a ==> b ==> c `] th in
\r
1695 let th2 = SPEC_ALL th1 in UNDISCH_ALL th2;;
\r
1697 (* change a th having form |- A ==> t to the form A |- t
\r
1698 to get ready to some other commands
\r
1702 ----------- FOR_ASM
\r
1706 let ASSUME_TAC2 = ASSUME_TAC o FOR_ASM;;
\r
1709 let PAT_ONCE_REWRITE_TAC tm thms =
\r
1710 (CONV_TAC (PAT_CONV tm (ONCE_REWRITE_CONV thms )));;
\r
1712 let ASM_PAT_RW_TAC tm thms = EVERY_ASSUM (fun th ->
\r
1713 (CONV_TAC (PAT_CONV tm (ONCE_REWRITE_CONV
\r
1714 ( th ::[ thms ] )))));;
\r
1716 let PAT_TH_TAC tm th =
\r
1717 (CONV_TAC (PAT_CONV tm (REWRITE_CONV[th] )));;
\r
1719 (* rewurte a goal with one theorem *)
\r
1721 let IMP_TO_EQ_RULE th = MATCH_MP (TAUT` (a ==> b ) ==>
\r
1722 ( a <=> a /\ b )`) (SPEC_ALL th);;
\r
1724 let NHANH_PAT tm th = PAT_ONCE_REWRITE_TAC tm
\r
1725 [ IMP_TO_EQ_RULE th ];;
\r
1729 let USE_FIRST tm tac = UNDISCH_TAC tm THEN DISCH_TAC THEN
\r
1733 let ONCE_SIMP_IDENT tm tth = (UNDISCH_TAC tm) THEN
\r
1734 DISCH_TAC THEN FIRST_ASSUM ( fun th ->
\r
1735 ONCE_REWRITE_TAC[(MATCH_MP tth th)] );;
\r
1738 let SIMP_TAC1 th = SIMP_TAC[ th];;
\r
1740 let SIMP_TACC1 th = ASSUME_TAC2 th THEN FIRST_X_ASSUM
\r
1743 let SIMP_IDENT thms tm = UNDISCH_TAC tm THEN (SIMP_TAC thms)
\r
1750 let ELIM_IDENTS th = ASSUME_TAC2 th THEN FIRST_X_ASSUM
\r
1751 ( fun thh -> SIMP_TAC[ thh]);;
\r
1753 (* ============================================================== *)
\r
1754 (* ============================================================== *)
\r
1755 (* ============================================================== *)
\r
1761 let GIVEN_POINT_EXISTS_2_NOT_COLLINEAR = prove(` !(x:real^3). ? y z. ~ collinear {x,y,z} `,
\r
1762 GEOM_ORIGIN_TAC `x:real^3` THEN EXISTS_TAC` (vector [&1; &0; &0 ]) : real^3` THEN
\r
1763 EXISTS_TAC` (vector [&0; &1; &0 ]) : real^3` THEN
\r
1764 REWRITE_TAC[GSYM CROSS_EQ_0; cross; VECTOR_3] THEN
\r
1765 CONV_TAC REAL_RAT_REDUCE_CONV THEN
\r
1766 REWRITE_TAC[VECTOR_EQ; DOT_LZERO; DOT_3; VECTOR_3] THEN REAL_ARITH_TAC);;
\r
1769 let NOT_BASISES_EQ_VEC0 = prove(` ~( basis 1 = ((vec 0): real^3) \/
\r
1770 basis 2 = ((vec 0): real^3) \/ basis 3 = ((vec 0): real^3) ) `,
\r
1771 REWRITE_TAC[DE_MORGAN_THM] THEN CONJ_TAC THENL [
\r
1772 MATCH_MP_TAC BASIS_NONZERO THEN REWRITE_TAC[DIMINDEX_3] THEN ARITH_TAC; CONJ_TAC THENL [
\r
1773 MATCH_MP_TAC BASIS_NONZERO THEN REWRITE_TAC[DIMINDEX_3] THEN ARITH_TAC;
\r
1774 MATCH_MP_TAC BASIS_NONZERO THEN REWRITE_TAC[DIMINDEX_3] THEN ARITH_TAC]]);;
\r
1777 let TOW_DISTINCT_POINTS_EXISTS_RD_NOT_COLLINEAR = prove(
\r
1778 `! x (y: real^3). ~( x = y ) ==> (? z. ~ collinear {x,y,z} )`,
\r
1779 GEOM_ORIGIN_TAC `x:real^3` THEN GEOM_BASIS_MULTIPLE_TAC 1 `y:real^3` THEN
\r
1780 ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN
\r
1781 REPEAT STRIP_TAC THEN EXISTS_TAC ` (basis 2) :real^3` THEN
\r
1782 REWRITE_TAC[GSYM CROSS_EQ_0; CROSS_LMUL; CROSS_BASIS] THEN
\r
1783 REWRITE_TAC[VECTOR_MUL_EQ_0] THEN FIRST_X_ASSUM MP_TAC THEN
\r
1784 SIMP_TAC[REWRITE_RULE[DE_MORGAN_THM] NOT_BASISES_EQ_VEC0 ]);;
\r
1787 let SUBSET_IMP_SUBSET_HULL = prove(`a SUBSET b ==> a SUBSET P hull b `,
\r
1788 MATCH_MP_TAC (SET_RULE`b SUBSET P hull b ==> a SUBSET b ==> a SUBSET P hull b `) THEN
\r
1789 REWRITE_TAC[HULL_SUBSET]);;
\r
1792 let THREE_POINT_IMP_EXISTS_3 = prove(`! (v1:real^3) v2 v3. ? w2 w3.
\r
1793 ~( collinear {v1,w2,w3} ) /\ {v1,v2,v3} SUBSET affine hull {v1,w2,w3} `,
\r
1794 REPEAT GEN_TAC THEN ASM_CASES_TAC` collinear {(v1: real^3),v2,v3} ` THENL
\r
1795 [FIRST_X_ASSUM MP_TAC THEN GEOM_ORIGIN_TAC `v1: real^3` THEN
\r
1796 REPEAT GEN_TAC THEN PAT_REWRITE_TAC `\x. x ==> _ ` [COLLINEAR_LEMMA] THEN
\r
1797 SPEC_TAC (`v3:real^3`,`v3: real^3`) THEN SPEC_TAC (`v2:real^3`,`v2: real^3`) THEN
\r
1798 MATCH_MP_TAC (MESON[]`(!a b. P a b <=> P b a) /\ (!v w. v = vec 0 \/ l v w ==> P v w)
\r
1799 ==> (!v w. v = vec 0 \/ w = vec 0 \/ l v w ==> P v w)`) THEN
\r
1800 SIMP_TAC[INSERT_AC] THEN REPEAT STRIP_TAC THENL [
\r
1801 ONCE_REWRITE_TAC[SET_RULE` {a,b,c} = {c,a,b} `] THEN
\r
1802 ASM_CASES_TAC `(v3:real^3) = vec 0 ` THENL [
\r
1803 MP_TAC (SPEC`(vec 0) :real^3` GIVEN_POINT_EXISTS_2_NOT_COLLINEAR) THEN
\r
1805 EXISTS_TAC `y: real^3` THEN
\r
1806 EXISTS_TAC `z: real^3` THEN
\r
1807 ASM_SIMP_TAC[INSERT_EMPTY_SUBSET] THEN
\r
1808 MATCH_MP_TAC HULL_INC THEN
\r
1810 FIRST_X_ASSUM MP_TAC THEN NHANH TOW_DISTINCT_POINTS_EXISTS_RD_NOT_COLLINEAR THEN
\r
1812 EXISTS_TAC `v3: real^3` THEN
\r
1813 EXISTS_TAC `z: real^3` THEN
\r
1814 FIRST_X_ASSUM MP_TAC THEN
\r
1815 SIMP_TAC[INSERT_COMM] THEN
\r
1817 MATCH_MP_TAC SUBSET_IMP_SUBSET_HULL THEN
\r
1818 ASM_SIMP_TAC[] THEN
\r
1819 SET_TAC[]]; ONCE_REWRITE_TAC[SET_RULE` {a,b,c} = {c,a,b} `] THEN
\r
1820 ASM_CASES_TAC`v2: real^3 = vec 0 ` THENL [UNDISCH_TAC `v3 = c % (v2: real^3)` THEN
\r
1821 MATCH_MP_TAC (TAUT` a ==> b ==> a `) THEN
\r
1822 ASM_CASES_TAC `(v3:real^3) = vec 0 ` THENL [
\r
1823 MP_TAC (SPEC`(vec 0) :real^3` GIVEN_POINT_EXISTS_2_NOT_COLLINEAR) THEN
\r
1825 EXISTS_TAC `y: real^3` THEN
\r
1826 EXISTS_TAC `z: real^3` THEN
\r
1827 ASM_SIMP_TAC[INSERT_EMPTY_SUBSET] THEN
\r
1828 MATCH_MP_TAC HULL_INC THEN
\r
1830 FIRST_X_ASSUM MP_TAC THEN NHANH TOW_DISTINCT_POINTS_EXISTS_RD_NOT_COLLINEAR THEN
\r
1832 EXISTS_TAC `v3: real^3` THEN
\r
1833 EXISTS_TAC `z: real^3` THEN
\r
1834 FIRST_X_ASSUM MP_TAC THEN
\r
1835 SIMP_TAC[INSERT_COMM] THEN
\r
1837 MATCH_MP_TAC SUBSET_IMP_SUBSET_HULL THEN
\r
1838 ASM_SIMP_TAC[] THEN
\r
1839 SET_TAC[]]; FIRST_X_ASSUM MP_TAC] THEN
\r
1840 ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
\r
1841 NHANH TOW_DISTINCT_POINTS_EXISTS_RD_NOT_COLLINEAR THEN
\r
1843 EXISTS_TAC`v2:real^3` THEN
\r
1844 EXISTS_TAC`z:real^3` THEN
\r
1845 ASM_SIMP_TAC[INSERT_EMPTY_SUBSET] THEN
\r
1846 ASM_SIMP_TAC[INSERT_EMPTY_SUBSET; IN_P_HULL_INSERT] THEN
\r
1847 ONCE_REWRITE_TAC[INSERT_AC] THEN
\r
1848 ASM_SIMP_TAC[AFFINE_HULL_3; IN_P_HULL_INSERT; IN_ELIM_THM] THEN
\r
1849 EXISTS_TAC `c: real` THEN
\r
1850 EXISTS_TAC `&1 - (c: real)` THEN
\r
1851 EXISTS_TAC `&0` THEN
\r
1852 SIMP_TAC[REAL_ARITH`c + &1 - c + &0 = &1 `] THEN
\r
1853 CONV_TAC VECTOR_ARITH]; ASM_MESON_TAC[HULL_SUBSET]]);;
\r
1857 let SUBSET_AFFINE_HULL3_EQ_SUB_PLANE = prove(`
\r
1858 (? (u: real^3 ) v w. S SUBSET affine hull {u, v, w}) <=> (?x. plane x /\ S SUBSET x)`,
\r
1859 REWRITE_TAC[plane] THEN EQ_TAC THENL [STRIP_TAC THEN
\r
1860 MP_TAC (SPECL [`u: real^3`;`v:real^3`;`w:real^3`] THREE_POINT_IMP_EXISTS_3) THEN
\r
1861 STRIP_TAC THEN EXISTS_TAC` affine hull {u, w2, (w3: real^3)}` THEN CONJ_TAC THENL [
\r
1862 ASM_MESON_TAC[]; FIRST_X_ASSUM MP_TAC THEN
\r
1863 NHANH_PAT `\x. x ==> y ` (MESON[HULL_MONO]` s SUBSET t ==> affine hull s SUBSET affine hull t`)
\r
1864 THEN ASM_SIMP_TAC[HULL_HULL] THEN ASM_MESON_TAC[SUBSET_TRANS]]; MESON_TAC[]]);;
\r
1866 let coplanar2 = coplanar;;
\r
1870 let NOT_COPLANAR_0_4_IMP_INDEPENDENT = prove
\r
1871 (`!v1 v2 v3:real^N. ~coplanar {vec 0,v1,v2,v3} ==> independent {v1,v2,v3}`,
\r
1872 REPEAT GEN_TAC THEN REWRITE_TAC[independent; CONTRAPOS_THM] THEN
\r
1873 REWRITE_TAC[dependent] THEN
\r
1875 `!v1 v2 v3:real^N. v1 IN span {v2,v3} ==> coplanar{vec 0,v1,v2,v3}`
\r
1877 [REPEAT STRIP_TAC THEN REWRITE_TAC[coplanar] THEN
\r
1878 MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `v2:real^N`; `v3:real^N`] THEN
\r
1879 SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT] THEN
\r
1880 REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
\r
1881 ASM_SIMP_TAC[SPAN_SUPERSET; IN_INSERT] THEN
\r
1882 POP_ASSUM MP_TAC THEN SPEC_TAC(`v1:real^N`,`v1:real^N`) THEN
\r
1883 REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[];
\r
1884 REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN
\r
1885 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
\r
1886 FIRST_X_ASSUM SUBST_ALL_TAC THENL
\r
1887 [FIRST_X_ASSUM(MP_TAC o SPECL [`v1:real^N`; `v2:real^N`; `v3:real^N`]);
\r
1888 FIRST_X_ASSUM(MP_TAC o SPECL [`v2:real^N`; `v3:real^N`; `v1:real^N`]);
\r
1889 FIRST_X_ASSUM(MP_TAC o SPECL [`v3:real^N`; `v1:real^N`; `v2:real^N`])]
\r
1890 THEN REWRITE_TAC[INSERT_AC] THEN DISCH_THEN MATCH_MP_TAC THEN
\r
1891 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
\r
1892 `a IN s ==> s SUBSET t ==> a IN t`)) THEN
\r
1893 MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]]);;
\r
1895 let NONCOPLANAR_3_BASIS = prove
\r
1896 (`!v1 v2 v3 v0 v:real^3.
\r
1897 ~coplanar {v0, v1, v2, v3}
\r
1899 v = t1 % (v1 - v0) + t2 % (v2 - v0) + t3 % (v3 - v0) /\
\r
1901 v = ta % (v1 - v0) + tb % (v2 - v0) + tc % (v3 - v0)
\r
1902 ==> ta = t1 /\ tb = t2 /\ tc = t3)`,
\r
1903 GEN_GEOM_ORIGIN_TAC `v0:real^3` ["v"] THEN REPEAT GEN_TAC THEN
\r
1904 MAP_EVERY (fun t ->
\r
1905 ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[INSERT_AC; COPLANAR_3]; ALL_TAC])
\r
1906 [`v1:real^3 = vec 0`; `v2:real^3 = vec 0`; `v3:real^3 = vec 0`;
\r
1907 `v2:real^3 = v1`; `v3:real^3 = v1`; `v3:real^3 = v2`] THEN
\r
1908 DISCH_THEN(ASSUME_TAC o MATCH_MP NOT_COPLANAR_0_4_IMP_INDEPENDENT) THEN
\r
1909 REWRITE_TAC[VECTOR_SUB_RZERO] THEN
\r
1910 MP_TAC(ISPECL [`(:real^3)`; `{v1,v2,v3}:real^3->bool`]
\r
1911 CARD_GE_DIM_INDEPENDENT) THEN
\r
1912 ASM_REWRITE_TAC[SUBSET_UNIV; DIM_UNIV; DIMINDEX_3] THEN
\r
1913 ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN
\r
1914 ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH; SUBSET; IN_UNIV] THEN
\r
1915 DISCH_THEN(MP_TAC o SPEC `v:real^3`) THEN
\r
1916 REWRITE_TAC[SPAN_BREAKDOWN_EQ; SPAN_EMPTY; IN_SING] THEN
\r
1917 REWRITE_TAC[VECTOR_ARITH `a - b:real^3 = c <=> a = b + c`] THEN
\r
1918 REWRITE_TAC[VECTOR_ADD_RID] THEN
\r
1919 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t1:real` THEN
\r
1920 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t2:real` THEN
\r
1921 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t3:real` THEN
\r
1922 DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
\r
1923 MAP_EVERY X_GEN_TAC [`ta:real`; `tb:real`; `tc:real`] THEN DISCH_TAC THEN
\r
1924 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INDEPENDENT_EXPLICIT]) THEN
\r
1925 REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN
\r
1926 DISCH_THEN(MP_TAC o SPEC
\r
1927 `(\x. if x = v1 then t1 - ta
\r
1928 else if x = v2 then t2 - tb else t3 - tc):real^3->real`) THEN
\r
1929 REWRITE_TAC[FORALL_IN_INSERT] THEN
\r
1930 SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN
\r
1931 ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; VECTOR_ADD_RID] THEN
\r
1932 REWRITE_TAC[REAL_ARITH `s - t = &0 <=> t = s`] THEN
\r
1933 DISCH_THEN MATCH_MP_TAC THEN UNDISCH_TAC
\r
1934 `t1 % v1 + t2 % v2 + t3 % v3:real^3 = ta % v1 + tb % v2 + tc % v3` THEN
\r
1935 VECTOR_ARITH_TAC);;
\r
1938 let coplanar = prove(` ! (S:real^3 -> bool ). coplanar S <=> (?x. plane x /\ S SUBSET x)`,
\r
1939 REWRITE_TAC[SUBSET_AFFINE_HULL3_EQ_SUB_PLANE; coplanar]);;
\r
1942 let COPLANAR_DET_EQ_0 = prove
\r
1943 (`!v0 v1 (v2: real^3) v3.
\r
1944 coplanar {v0,v1,v2,v3} <=>
\r
1945 det(vector[v1 - v0; v2 - v0; v3 - v0]) = &0`,
\r
1946 REPEAT GEN_TAC THEN REWRITE_TAC[DET_EQ_0_RANK; RANK_ROW] THEN
\r
1947 REWRITE_TAC[rows; row; LAMBDA_ETA] THEN
\r
1948 ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
\r
1949 REWRITE_TAC[GSYM numseg; DIMINDEX_3] THEN
\r
1950 CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN
\r
1951 SIMP_TAC[IMAGE_CLAUSES; VECTOR_3] THEN EQ_TAC THENL
\r
1952 [REWRITE_TAC[coplanar; plane; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
\r
1953 MAP_EVERY X_GEN_TAC
\r
1954 [`p:real^3->bool`; `a:real^3`; `b:real^3`; `c:real^3`] THEN
\r
1955 DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
\r
1956 FIRST_X_ASSUM SUBST1_TAC THEN
\r
1957 W(MP_TAC o PART_MATCH lhand AFFINE_HULL_INSERT_SUBSET_SPAN o
\r
1958 rand o lhand o goal_concl) THEN
\r
1959 REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
\r
1960 DISCH_THEN(MP_TAC o MATCH_MP SUBSET_TRANS) THEN
\r
1961 DISCH_THEN(MP_TAC o ISPEC `\x:real^3. x - a` o MATCH_MP IMAGE_SUBSET) THEN
\r
1962 ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
\r
1963 REWRITE_TAC[IMAGE_CLAUSES; GSYM IMAGE_o; o_DEF; VECTOR_ADD_SUB; IMAGE_ID;
\r
1964 SIMPLE_IMAGE] THEN
\r
1965 REWRITE_TAC[INSERT_SUBSET] THEN STRIP_TAC THEN
\r
1966 GEN_REWRITE_TAC LAND_CONV [GSYM DIM_SPAN] THEN MATCH_MP_TAC LET_TRANS THEN
\r
1967 EXISTS_TAC `CARD {b - a:real^3,c - a}` THEN
\r
1969 [MATCH_MP_TAC SPAN_CARD_GE_DIM;
\r
1970 SIMP_TAC[CARD_CLAUSES; FINITE_RULES] THEN ARITH_TAC] THEN
\r
1971 REWRITE_TAC[FINITE_INSERT; FINITE_RULES] THEN
\r
1972 GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_SPAN] THEN
\r
1973 MATCH_MP_TAC SPAN_MONO THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
\r
1974 MP_TAC(VECTOR_ARITH `!x y:real^3. x - y = (x - a) - (y - a)`) THEN
\r
1975 DISCH_THEN(fun th -> REPEAT CONJ_TAC THEN
\r
1976 GEN_REWRITE_TAC LAND_CONV [th]) THEN
\r
1977 MATCH_MP_TAC SPAN_SUB THEN ASM_REWRITE_TAC[];
\r
1981 MP_TAC(ISPECL [`{v1 - v0,v2 - v0,v3 - v0}:real^3->bool`; `2`]
\r
1982 LOWDIM_EXPAND_BASIS) THEN
\r
1983 ASM_REWRITE_TAC[ARITH_RULE `n <= 2 <=> n < 3`; DIMINDEX_3; ARITH] THEN
\r
1984 DISCH_THEN(X_CHOOSE_THEN `t:real^3->bool`
\r
1985 (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN
\r
1986 CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN
\r
1987 REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
\r
1988 MAP_EVERY X_GEN_TAC [`a:real^3`; `b:real^3`] THEN
\r
1989 DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN
\r
1990 REWRITE_TAC[coplanar; plane] THEN
\r
1991 EXISTS_TAC `affine hull {v0,v0 + a,v0 + b}:real^3->bool` THEN
\r
1993 [MAP_EVERY EXISTS_TAC [`v0:real^3`; `v0 + a:real^3`; `v0 + b:real^3`] THEN
\r
1994 REWRITE_TAC[COLLINEAR_3; COLLINEAR_LEMMA;
\r
1995 VECTOR_ARITH `--x = vec 0 <=> x = vec 0`;
\r
1996 VECTOR_ARITH `u - (u + a):real^3 = --a`;
\r
1997 VECTOR_ARITH `(u + b) - (u + a):real^3 = b - a`] THEN
\r
1998 REWRITE_TAC[DE_MORGAN_THM; VECTOR_SUB_EQ;
\r
1999 VECTOR_ARITH `b - a = c % -- a <=> (c - &1) % a + &1 % b = vec 0`] THEN
\r
2000 ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
\r
2001 [ASM_MESON_TAC[IN_INSERT; INDEPENDENT_NONZERO]; ALL_TAC] THEN
\r
2002 DISCH_THEN(X_CHOOSE_TAC `u:real`) THEN
\r
2003 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN
\r
2004 REWRITE_TAC[DEPENDENT_EXPLICIT] THEN
\r
2005 MAP_EVERY EXISTS_TAC [`{a:real^3,b}`;
\r
2006 `\x:real^3. if x = a then u - &1 else &1`] THEN
\r
2007 REWRITE_TAC[FINITE_INSERT; FINITE_RULES; SUBSET_REFL] THEN
\r
2009 [EXISTS_TAC `b:real^3` THEN ASM_REWRITE_TAC[IN_INSERT] THEN
\r
2012 SIMP_TAC[VSUM_CLAUSES; FINITE_RULES] THEN
\r
2013 ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; VECTOR_ADD_RID];
\r
2015 W(MP_TAC o PART_MATCH (lhs o rand) AFFINE_HULL_INSERT_SPAN o
\r
2016 rand o goal_concl) THEN
\r
2018 [REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN
\r
2019 REWRITE_TAC[VECTOR_ARITH `u = u + a <=> a = vec 0`] THEN
\r
2020 ASM_MESON_TAC[INDEPENDENT_NONZERO; IN_INSERT];
\r
2022 DISCH_THEN SUBST1_TAC THEN
\r
2023 ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
\r
2024 REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; IMAGE_ID; VECTOR_ADD_SUB] THEN
\r
2025 MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
\r
2026 `IMAGE (\v:real^3. v0 + v) (span{v1 - v0, v2 - v0, v3 - v0})` THEN
\r
2027 ASM_SIMP_TAC[IMAGE_SUBSET] THEN
\r
2028 REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_IMAGE] THEN CONJ_TAC THENL
\r
2029 [EXISTS_TAC `vec 0:real^3` THEN REWRITE_TAC[SPAN_0] THEN VECTOR_ARITH_TAC;
\r
2030 REWRITE_TAC[VECTOR_ARITH `v1:real^N = v0 + x <=> x = v1 - v0`] THEN
\r
2031 REWRITE_TAC[UNWIND_THM2] THEN REPEAT CONJ_TAC THEN
\r
2032 MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_INSERT]]]);;
\r
2035 let det_vec3 = new_definition ` det_vec3 (a:real^3) (b:real^3) (c:real^3) =
\r
2036 a$1 * b$2 * c$3 + b$1 * c$2 * a$3 + c$1 * a$2 * b$3 -
\r
2037 ( a$1 * c$2 * b$3 + b$1 * a$2 * c$3 + c$1 * b$2 * a$3 ) `;;
\r
2040 let DET_VEC3_EXPAND = prove
\r
2041 (`det (vector [a; b; (c:real^3)] ) = det_vec3 a b c`,
\r
2042 REWRITE_TAC[det_vec3; DET_3; VECTOR_3] THEN REAL_ARITH_TAC);;
\r
2044 let COPLANAR_DET_VEC3_EQ_0 = prove( `!v0 v1 (v2: real^3) v3.
\r
2045 coplanar {v0,v1,v2,v3} <=>
\r
2046 det_vec3 ( v1 - v0 ) ( v2 - v0 ) ( v3 - v0 ) = &0`, REWRITE_TAC[COPLANAR_DET_EQ_0; DET_VEC3_EXPAND]);;
\r
2049 let coplanar1 = coplanar;;
\r
2050 let coplanar = coplanar2;;
\r
2054 let DET_VEC3_AS_CROSS_DOT = prove(` det_vec3 v1 v2 v3 = (v1 cross v2 ) dot v3 `,
\r
2055 REWRITE_TAC[det_vec3; cross; DOT_3; VECTOR_3]
\r
2056 THEN REAL_ARITH_TAC);;
\r
2059 let ORTHONORMAL_IMP_NONZERO = prove
\r
2060 (`!e1 e2 e3. orthonormal e1 e2 e3
\r
2061 ==> ~(e1 = vec 0) /\ ~(e2 = vec 0) /\ ~(e3 = vec 0)`,
\r
2062 REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
\r
2063 REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN
\r
2064 ASM_REWRITE_TAC[orthonormal; DOT_LZERO] THEN REAL_ARITH_TAC);;
\r
2066 let ORTHONORMAL_IMP_DISTINCT = prove
\r
2067 (`!e1 e2 e3. orthonormal e1 e2 e3 ==> ~(e1 = e2) /\ ~(e1 = e3) /\ ~(e2 = e3)`,
\r
2068 REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
\r
2069 REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN
\r
2070 ASM_REWRITE_TAC[orthonormal; DOT_LZERO] THEN REAL_ARITH_TAC);;
\r
2072 let ORTHONORMAL_IMP_INDEPENDENT = prove
\r
2073 (`!e1 e2 e3. orthonormal e1 e2 e3 ==> independent {e1,e2,e3}`,
\r
2074 REPEAT STRIP_TAC THEN MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN
\r
2075 CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[ORTHONORMAL_IMP_NONZERO]] THEN
\r
2076 RULE_ASSUM_TAC(REWRITE_RULE[orthonormal]) THEN
\r
2077 REWRITE_TAC[pairwise; IN_INSERT; NOT_IN_EMPTY] THEN
\r
2078 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[orthogonal] THEN
\r
2079 ASM_MESON_TAC[DOT_SYM]);;
\r
2081 let ORTHONORMAL_IMP_SPANNING = prove
\r
2082 (`!e1 e2 e3. orthonormal e1 e2 e3 ==> span {e1,e2,e3} = (:real^3)`,
\r
2083 REPEAT STRIP_TAC THEN
\r
2084 MP_TAC(ISPECL [`(:real^3)`; `{e1:real^3,e2,e3}`] CARD_EQ_DIM) THEN
\r
2085 ASM_SIMP_TAC[ORTHONORMAL_IMP_INDEPENDENT; SUBSET_UNIV] THEN
\r
2086 REWRITE_TAC[DIM_UNIV; DIMINDEX_3; HAS_SIZE; FINITE_INSERT; FINITE_EMPTY] THEN
\r
2087 SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; IN_INSERT] THEN
\r
2088 FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHONORMAL_IMP_DISTINCT) THEN
\r
2089 ASM_REWRITE_TAC[NOT_IN_EMPTY; ARITH] THEN SET_TAC[]);;
\r
2093 orthonormal e1 e2 e3
\r
2094 ==> !x. ?t1 t2 t3.
\r
2095 x = t1 % e1 + t2 % e2 + t3 % e3 /\
\r
2097 x = tt1 % e1 + tt2 % e2 + tt3 % e3
\r
2098 ==> tt1 = t1 /\ tt2 = t2 /\ tt3 = t3`,
\r
2099 REPEAT STRIP_TAC THEN
\r
2100 FIRST_ASSUM(MP_TAC o MATCH_MP ORTHONORMAL_IMP_SPANNING) THEN
\r
2101 DISCH_THEN(MP_TAC o AP_TERM `(IN) (x:real^3)`) THEN
\r
2102 REWRITE_TAC[IN_UNIV; SPAN_BREAKDOWN_EQ; SPAN_EMPTY; IN_SING] THEN
\r
2103 SIMP_TAC[VECTOR_ARITH `x - a - b - c = vec 0 <=> x:real^3 = a + b + c`] THEN
\r
2104 MAP_EVERY (fun t -> MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC t)
\r
2105 [`t1:real`; `t2:real`; `t3:real`] THEN
\r
2106 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[] THEN REPEAT GEN_TAC THEN
\r
2107 ONCE_REWRITE_TAC[REAL_ARITH `x:real = y <=> y - x = &0`] THEN
\r
2108 REWRITE_TAC[VECTOR_ARITH
\r
2109 `a % x + b % y + c % z:real^3 = a' % x + b' % y + c' % z <=>
\r
2110 (a - a') % x + (b - b') % y + (c - c') % z = vec 0`] THEN
\r
2112 FIRST_ASSUM(MP_TAC o MATCH_MP ORTHONORMAL_IMP_INDEPENDENT) THEN
\r
2113 REWRITE_TAC[INDEPENDENT_EXPLICIT] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN
\r
2114 DISCH_THEN(MP_TAC o SPEC
\r
2115 `\x:real^3. if x = e1 then t1 - tt1:real
\r
2116 else if x = e2 then t2 - tt2
\r
2117 else t3 - tt3`) THEN
\r
2118 FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHONORMAL_IMP_DISTINCT) THEN
\r
2119 ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN
\r
2120 ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; VECTOR_ADD_RID] THEN
\r
2121 DISCH_THEN(fun th -> MAP_EVERY (MP_TAC o C SPEC th)
\r
2122 [`e1:real^3`; `e2:real^3`; `e3:real^3`]) THEN
\r
2125 (* the following lemma are in collect_geom.ml *)
\r
2128 In the very latest snapshot there is a theorem COPLANAR_DET_EQ_0
\r
2129 (I think I proved it because you asked for it some time ago). By
\r
2130 combing that with DET_3 you should be able to get your first
\r
2131 theorem COPLANAR_DET_VEC3_EQ_0.
\r
2133 I will work on the other one NONCOPLANAR_3_BASIS and send it later
\r
2140 Here is the other theorem. Fortunately I proved the rather tedious
\r
2141 lemma NOT_COPLANAR_0_4_IMP_INDEPENDENT earlier in this week for use
\r
2142 in the volume properties.
\r
2146 have been in trig.ml
\r
2148 let NOT_COPLANAR_0_4_IMP_INDEPENDENT = prove
\r
2149 (`!v1 v2 v3:real^N. ~coplanar {vec 0,v1,v2,v3} ==> independent {v1,v2,v3}`,
\r
2150 REPEAT GEN_TAC THEN REWRITE_TAC[independent; CONTRAPOS_THM] THEN
\r
2151 REWRITE_TAC[dependent] THEN
\r
2153 `!v1 v2 v3:real^N. v1 IN span {v2,v3} ==> coplanar{vec 0,v1,v2,v3}`
\r
2155 [REPEAT STRIP_TAC THEN REWRITE_TAC[coplanar] THEN
\r
2156 MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `v2:real^N`; `v3:real^N`] THEN
\r
2157 SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT] THEN
\r
2158 REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
\r
2159 ASM_SIMP_TAC[SPAN_SUPERSET; IN_INSERT] THEN
\r
2160 POP_ASSUM MP_TAC THEN SPEC_TAC(`v1:real^N`,`v1:real^N`) THEN
\r
2161 REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[];
\r
2162 REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN
\r
2163 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
\r
2164 FIRST_X_ASSUM SUBST_ALL_TAC THENL
\r
2165 [FIRST_X_ASSUM(MP_TAC o SPECL [`v1:real^N`; `v2:real^N`; `v3:real^N`]);
\r
2166 FIRST_X_ASSUM(MP_TAC o SPECL [`v2:real^N`; `v3:real^N`; `v1:real^N`]);
\r
2167 FIRST_X_ASSUM(MP_TAC o SPECL [`v3:real^N`; `v1:real^N`; `v2:real^N`])]
\r
2168 THEN REWRITE_TAC[INSERT_AC] THEN DISCH_THEN MATCH_MP_TAC THEN
\r
2169 FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
\r
2170 `a IN s ==> s SUBSET t ==> a IN t`)) THEN
\r
2171 MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]]);;
\r
2173 let NONCOPLANAR_3_BASIS = prove
\r
2174 (`!v1 v2 v3 v0 v:real^3.
\r
2175 ~coplanar {v0, v1, v2, v3}
\r
2177 v = t1 % (v1 - v0) + t2 % (v2 - v0) + t3 % (v3 - v0) /\
\r
2179 v = ta % (v1 - v0) + tb % (v2 - v0) + tc % (v3 - v0)
\r
2180 ==> ta = t1 /\ tb = t2 /\ tc = t3)`,
\r
2181 GEN_GEOM_ORIGIN_TAC `v0:real^3` ["v"] THEN REPEAT GEN_TAC THEN
\r
2182 MAP_EVERY (fun t ->
\r
2183 ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[INSERT_AC; COPLANAR_3]; ALL_TAC])
\r
2184 [`v1:real^3 = vec 0`; `v2:real^3 = vec 0`; `v3:real^3 = vec 0`;
\r
2185 `v2:real^3 = v1`; `v3:real^3 = v1`; `v3:real^3 = v2`] THEN
\r
2186 DISCH_THEN(ASSUME_TAC o MATCH_MP NOT_COPLANAR_0_4_IMP_INDEPENDENT) THEN
\r
2187 REWRITE_TAC[VECTOR_SUB_RZERO] THEN
\r
2188 MP_TAC(ISPECL [`(:real^3)`; `{v1,v2,v3}:real^3->bool`]
\r
2189 CARD_GE_DIM_INDEPENDENT) THEN
\r
2190 ASM_REWRITE_TAC[SUBSET_UNIV; DIM_UNIV; DIMINDEX_3] THEN
\r
2191 ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN
\r
2192 ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH; SUBSET; IN_UNIV] THEN
\r
2193 DISCH_THEN(MP_TAC o SPEC `v:real^3`) THEN
\r
2194 REWRITE_TAC[SPAN_BREAKDOWN_EQ; SPAN_EMPTY; IN_SING] THEN
\r
2195 REWRITE_TAC[VECTOR_ARITH `a - b:real^3 = c <=> a = b + c`] THEN
\r
2196 REWRITE_TAC[VECTOR_ADD_RID] THEN
\r
2197 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t1:real` THEN
\r
2198 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t2:real` THEN
\r
2199 MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t3:real` THEN
\r
2200 DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
\r
2201 MAP_EVERY X_GEN_TAC [`ta:real`; `tb:real`; `tc:real`] THEN DISCH_TAC THEN
\r
2202 FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INDEPENDENT_EXPLICIT]) THEN
\r
2203 REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN
\r
2204 DISCH_THEN(MP_TAC o SPEC
\r
2205 `(\x. if x = v1 then t1 - ta
\r
2206 else if x = v2 then t2 - tb else t3 - tc):real^3->real`) THEN
\r
2207 REWRITE_TAC[FORALL_IN_INSERT] THEN
\r
2208 SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN
\r
2209 ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; VECTOR_ADD_RID] THEN
\r
2210 REWRITE_TAC[REAL_ARITH `s - t = &0 <=> t = s`] THEN
\r
2211 DISCH_THEN MATCH_MP_TAC THEN UNDISCH_TAC
\r
2212 `t1 % v1 + t2 % v2 + t3 % v3:real^3 = ta % v1 + tb % v2 + tc % v3` THEN
\r
2213 VECTOR_ARITH_TAC);;
\r
2220 let DIV_POW2 = REAL_FIELD` (a/b) pow 2 = a pow 2 / (b pow 2 )`;;
\r
2224 let REAL_LE_SQUARE_POW = REWRITE_RULE[GSYM REAL_POW_2] REAL_LE_SQUARE;;
\r
2227 let NOT_EQ0_IMP_TRIGIZABLE = prove(` ~( x = &0 /\ y = &0 ) ==>
\r
2228 ( x / sqrt ( x pow 2 + y pow 2 )) pow 2
\r
2229 + ( y / sqrt ( x pow 2 + y pow 2 )) pow 2 = &1 `,REWRITE_TAC[DIV_POW2] THEN
\r
2230 ASSUME_TAC (MESON [REAL_LE_SQUARE_POW; REAL_LE_ADD]`
\r
2231 &0 <= x pow 2 + y pow 2 `) THEN
\r
2232 ASM_SIMP_TAC[SQRT_POW_2; REAL_FIELD` a / (m:real) + b / m =
\r
2233 ( a + b ) / m `;GSYM REAL_SOS_EQ_0; REAL_DIV_REFL]);;
\r
2237 let POW2_1 = REAL_ARITH` ( &1 ) pow 2 = &1`;;
\r
2239 let ABS_BOUNDS = REAL_ABS_BOUNDS;;
\r
2241 let POW2_1_BOUNDED = prove(
\r
2242 ` a pow 2 + b pow 2 = &1 ==> -- &1 <= a /\ a <= &1 `,
\r
2243 REWRITE_TAC[REAL_ARITH` a + b = c <=> b = c - a `] THEN
\r
2244 NHANH ( MESON[REAL_LE_POW_2]`a pow 2 = x ==> &0 <= x `) THEN
\r
2245 ONCE_REWRITE_TAC[REAL_ARITH` &1 = &1 pow 2 `] THEN
\r
2246 REWRITE_TAC[REAL_SUB_LE; GSYM REAL_LE_SQUARE_ABS; ABS_1; POW2_1;
\r
2247 ABS_BOUNDS] THEN SIMP_TAC[]);;
\r
2249 let POW2_1_BOUNDED =
\r
2250 MESON[REAL_ADD_SYM; POW2_1_BOUNDED; REAL_ABS_BOUNDS]`
\r
2251 a pow 2 + b pow 2 = &1 ==> abs a <= &1 /\ abs b <= &1 `;;
\r
2253 let SIN_COMPLEMENTIVE = prove(` sin x = sin ( pi - x ) `,
\r
2254 REWRITE_TAC[SIN_COS; REAL_ARITH` a / &2 - ( a - x ) =
\r
2255 -- ( a / &2 - x )`; COS_NEG]);;
\r
2258 let CYLINDER_CORDINATE = prove(` ! w u e1 e2 (e3:real^3) x.
\r
2259 orthonormal e1 e2 e3 /\
\r
2260 e3 = ( &1 / norm ( w - u )) % ( w - u ) /\
\r
2261 ~ ( x IN aff {w,u} ) /\ ~( w = u )
\r
2263 (? r phi h. &0 < r /\
\r
2264 x = u + (r * ( cos phi )) % e1 +
\r
2265 ( r * sin phi) % e2
\r
2266 + h % ( w - u ) ) `,
\r
2267 REPEAT GEN_TAC THEN
\r
2268 REWRITE_TAC[orthonormal; GSYM DET_VEC3_AS_CROSS_DOT] THEN
\r
2269 NHANH (REAL_LT_IMP_NZ) THEN
\r
2270 ONCE_REWRITE_TAC[MESON[VECTOR_SUB_RZERO]` fv a b c = fv ( a - vec 0 ) ( b - vec 0 )
\r
2271 ( c - vec 0 ) `] THEN
\r
2272 REWRITE_TAC[GSYM COPLANAR_DET_VEC3_EQ_0] THEN
\r
2273 NHANH (SPECL [`e1 : real^3`;` e2 :real^3`; `e3 :real^3`;
\r
2274 `(vec 0 : real^3)`; `(x : real^3) - u` ] NONCOPLANAR_3_BASIS) THEN
\r
2275 REWRITE_TAC[VECTOR_SUB_RZERO] THEN
\r
2277 ASM_CASES_TAC` t1 = &0 /\ t2 = &0 ` THENL [
\r
2278 FIRST_X_ASSUM (CONJUNCTS_THEN ASSUME_TAC) THEN
\r
2279 (ASSUME_TAC o FOR_ASM ) (prove(` t1 = &0 /\ t2 = &0 /\
\r
2280 x - u= t1 % e1 + t2 % e2 + t3 % e3
\r
2281 ==> (x:real^3) - u = t3 % e3 `,
\r
2282 SIMP_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID])) THEN
\r
2283 FIRST_X_ASSUM MP_TAC THEN
\r
2284 UNDISCH_TAC` e3 = &1 / norm (w - u) % (w - (u:real^3))` THEN
\r
2285 SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH`
\r
2286 a -(b:real^n) = n % ( c - b )<=> a = n % c +
\r
2287 ( &1 - n ) % b `] THEN
\r
2288 UNDISCH_TAC ` ~( x IN aff {w,(u:real^3)} )` THEN
\r
2289 REWRITE_TAC[AFF2; IN_ELIM_THM] THEN
\r
2291 FIRST_X_ASSUM MP_TAC] THEN
\r
2292 NHANH NOT_EQ0_IMP_TRIGIZABLE THEN
\r
2293 NHANH CIRCLE_SINCOS THEN
\r
2294 SIMP_TAC[GSYM REAL_SOS_EQ_0] THEN
\r
2295 ONCE_REWRITE_TAC[MESON[]` a /\b ==> c <=> a ==> b ==> c `] THEN
\r
2296 SIMP_TAC[GSYM SQRT_EQ_0; MESON[REAL_LE_POW_2;
\r
2297 REAL_LE_ADD]` &0 <= t1 pow 2 + t2 pow 2 `; REAL_FIELD`
\r
2298 ~ ( a = &0 ) ==> (t / a = d <=> t = a * d ) `] THEN
\r
2299 REPEAT STRIP_TAC THEN
\r
2300 UNDISCH_TAC`x - u = t1 % e1 + t2 % e2 + t3 % (e3: real^3)` THEN
\r
2301 REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN
\r
2302 UNDISCH_TAC` e3 = &1 / norm (w - u) % (w - (u:real^3))` THEN
\r
2303 PURE_ONCE_REWRITE_TAC[MESON[]` a = b ==> P a <=> a = b ==>
\r
2305 ABBREV_TAC `tt = t1 pow 2 + t2 pow 2 ` THEN
\r
2307 REPLICATE_TAC 3 DISCH_TAC THEN
\r
2308 REWRITE_TAC[VECTOR_ARITH` a - b = c <=> a = b + (c:real^N)`;
\r
2309 VECTOR_MUL_ASSOC] THEN REWRITE_TAC[REAL_ARITH` &0 < r /\ ~( r = &0 ) <=> &0 < r `] THEN
\r
2310 ASSUME_TAC2 (MESON[SQRT_POS_LE; REAL_LE_POW_2; REAL_LE_ADD]` t1 pow 2 +
\r
2311 t2 pow 2 = tt ==> &0 <= sqrt tt `) THEN
\r
2312 ASSUME_TAC2 (REAL_ARITH` ~ ( sqrt tt = &0 ) /\ &0 <= sqrt tt
\r
2313 ==> &0 < sqrt tt `) THEN FIRST_ASSUM MP_TAC THEN MESON_TAC[]);;
\r
2318 (* NOT NEED AT ALL
\r
2319 let arith_lemma = prove
\r
2320 (`!a d x. &0 < d ==>
\r
2321 ?y. (a <= y /\ y <= a + d) /\ ?n. y = x + &n * d \/ x = y + &n * d`,
\r
2322 REPEAT STRIP_TAC THEN DISJ_CASES_TAC (SPEC `(x - a):real` REAL_LE_NEGTOTAL)
\r
2323 THEN IMP_RES_THEN (IMP_RES_THEN STRIP_ASSUME_TAC) REAL_ARCH_LEAST THENL
\r
2324 [ EXISTS_TAC `x - &n * d` THEN STRIP_TAC THENL
\r
2325 [ (POP_ASSUM MP_TAC) THEN (POP_ASSUM MP_TAC) THEN
\r
2326 REWRITE_TAC [GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC ;
\r
2327 EXISTS_TAC `n:num` THEN REAL_ARITH_TAC ] ;
\r
2328 EXISTS_TAC `x + &(SUC n) * d` THEN STRIP_TAC THENL
\r
2329 [ (POP_ASSUM MP_TAC) THEN (POP_ASSUM MP_TAC) THEN
\r
2330 REWRITE_TAC [GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC ;
\r
2331 EXISTS_TAC `(SUC n):num` THEN REAL_ARITH_TAC ]]);;
\r
2335 let COS_SUM_2PI = prove(
\r
2336 `! x. cos x = cos ( &2 * pi - x ) `, GEN_TAC THEN
\r
2337 ONCE_REWRITE_TAC[GSYM COS_NEG] THEN
\r
2338 PAT_ONCE_REWRITE_TAC `\x. _ = x ` [GSYM COS_PERIODIC] THEN
\r
2339 REWRITE_TAC[REAL_ARITH` --( a - b) + a = b `; COS_NEG]);;
\r
2343 let POW2_EQ_0 = prove(` ! a. a pow 2 = &0 <=> a = &0 `,
\r
2344 GEN_TAC THEN MP_TAC REAL_LE_POW_2 THEN
\r
2345 ASSUME_TAC (GEN_ALL NOT_ZERO_EQ_POW2_LT) THEN
\r
2346 REWRITE_TAC[REAL_LE_LT] THEN
\r
2347 FIRST_ASSUM (fun th -> REWRITE_TAC[GSYM th] ) THEN
\r
2348 ASM_MESON_TAC[]);;
\r
2351 let UNIT_BOUNDED_IN_TOW_FORMS = prove(`-- &1 <= a /\ a <= &1 ==> &0 <= &1 - a pow 2 `,
\r
2352 DISCH_TAC THEN REWRITE_TAC[REAL_ARITH` &1 - a pow 2 = (&1 - a ) * ( &1 + a )`] THEN
\r
2353 MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC);;
\r
2356 let COS_TOTAL = prove(`-- &1 <= a /\ a <= &1 ==> (?!x. &0 <= x /\ x <= pi /\ cos x = a ) `,
\r
2357 NHANH (UNIT_BOUNDED_IN_TOW_FORMS) THEN NHANH_PAT `\a. a ==> _` SQRT_WORKS THEN
\r
2358 ONCE_REWRITE_TAC[REAL_ARITH` a = &1 - b pow 2 <=> b pow 2 + a = &1 `] THEN
\r
2359 SIMP_TAC[EXISTS_UNIQUE] THEN NHANH SINCOS_TOTAL_PI THEN
\r
2360 STRIP_TAC THEN EXISTS_TAC` t:real` THEN ASM_SIMP_TAC[] THEN
\r
2361 ASM_MESON_TAC[COS_INJ_PI]);;
\r
2366 let SUM_POW2_EQ1_UNIQUE_TRIG = prove(` ! a b. a pow 2 + b pow 2 = &1 ==> (?!x. &0 <= x /\
\r
2367 x < &2 * pi /\ cos x = a /\ sin x = b )`,
\r
2368 REPEAT GEN_TAC THEN NHANH (POW2_1_BOUNDED) THEN
\r
2369 REWRITE_TAC[REAL_ABS_BOUNDS] THEN
\r
2370 NHANH_PAT `\x. _ /\ x /\ _ ==> h ` COS_TOTAL THEN
\r
2371 PAT_REWRITE_TAC `\x. _ /\ _ /\ x ==> _ ` [REAL_ARITH`
\r
2372 -- &1 <= b /\ b <= &1 <=> -- &1 <= b /\ b < &0 \/ &0 <= b /\
\r
2373 b <= &1 `] THEN REWRITE_TAC[EXISTS_UNIQUE] THEN STRIP_TAC
\r
2374 THENL [ASSUME_TAC PI_POS THEN ASM_CASES_TAC ` x = &0 ` THENL [
\r
2375 FIRST_X_ASSUM SUBST_ALL_TAC THEN EXISTS_TAC ` &0` THEN
\r
2376 SUBST_ALL_TAC COS_0 THEN FIRST_X_ASSUM (SUBST_ALL_TAC o SYM )
\r
2377 THEN UNDISCH_TAC `&1 pow 2 + b pow 2 = &1 ` THEN
\r
2378 REWRITE_TAC[REAL_ARITH` &1 pow 2 + b = &1 <=>
\r
2379 b = &0 `; POW2_EQ_0] THEN DISCH_TAC THEN
\r
2380 ASM_MESON_TAC[REAL_ARITH` b < &0 /\ b = &0 ==> F `];
\r
2381 EXISTS_TAC ` &2 * pi - x ` THEN ASSUME_TAC2 (
\r
2382 REAL_ARITH` x <= pi /\ &0 < pi ==> &0 <= &2 * pi - x `) THEN
\r
2383 FIRST_X_ASSUM SIMP_TAC1 THEN
\r
2384 ASSUME_TAC2 (REAL_ARITH` &0 <= x /\ ~( x = &0 ) ==> &0 < x `) THEN
\r
2385 REWRITE_TAC[REAL_ARITH` a - b < a <=> &0 < b `] THEN
\r
2386 FIRST_X_ASSUM SIMP_TAC1 THEN
\r
2387 REWRITE_TAC[GSYM COS_SUM_2PI; REAL_ARITH` a - b =
\r
2388 -- b + a `; SIN_PERIODIC; SIN_NEG] THEN
\r
2389 SIMP_TACC1 (TAUT` cos x = a ==> cos x = a `) THEN
\r
2390 SIMP_IDENT[] `cos x = a ` THEN
\r
2391 ASSUME_TAC2 (REAL_ARITH` b < &0 ==> b <= &0 `) THEN
\r
2392 ASSUME_TAC (SPEC_ALL SIN_CIRCLE) THEN
\r
2393 USE_FIRST `cos x = a` SUBST_ALL_TAC THEN
\r
2394 ASSUME_TAC2 (REAL_ARITH` sin x pow 2 + a pow 2 = &1 /\
\r
2395 a pow 2 + b pow 2 = &1 ==> sin x pow 2 = b pow 2 `) THEN
\r
2396 SUBST_ALL_TAC (REAL_ARITH` b pow 2 = ( -- b ) pow 2 `) THEN
\r
2397 ASSUME_TAC2 (REAL_ARITH` b < &0 ==> &0 <= -- b `) THEN
\r
2398 ASSUME_TAC2 (SPEC_ALL SIN_POS_PI_LE) THEN
\r
2399 ASSUME_TAC2 (MESON[EQ_POW2_COND]` &0 <= -- b /\
\r
2400 &0 <= sin x /\sin x pow 2 = -- b pow 2 ==> sin x = -- b `) THEN
\r
2401 SIMP_IDENT[REAL_NEGNEG] `sin x = -- b ` THEN
\r
2402 REPEAT STRIP_TAC THEN
\r
2403 UNDISCH_TAC `y < &2 * pi ` THEN
\r
2404 ONCE_SIMP_IDENT ` &0 < pi ` (REAL_ARITH` &0 < p ==> ( x
\r
2405 < &2 * p <=> x <= p \/ p < x /\ x < &2 * p )`) THEN
\r
2406 STRIP_TAC] THENL [
\r
2407 ASSUME_TAC2 (SPEC `y:real` SIN_POS_PI_LE) THEN
\r
2408 ASSUME_TAC2 (REAL_ARITH` sin y = b /\ &0 <= sin y ==>
\r
2409 &0 <= b `) THEN UNDISCH_TAC ` b < &0 ` THEN
\r
2410 SIMP_IDENT[REAL_ARITH` &0 <= b <=> ~(b < &0 )`] `&0 <= b`;
\r
2411 REWRITE_TAC[REAL_ARITH` y = -- x + b <=> b - y = x `] THEN
\r
2412 REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN PHA THEN
\r
2413 REWRITE_TAC[REAL_ARITH` a < x /\ x < &2 * a <=>
\r
2414 &0 < &2 * a - x /\ &2 * a - x < a `] THEN
\r
2415 UNDISCH_TAC ` cos y = a ` THEN
\r
2416 ONCE_REWRITE_TAC[COS_SUM_2PI] THEN
\r
2417 NHANH (REAL_LT_IMP_LE) THEN
\r
2418 UNDISCH_TAC `!y. &0 <= y /\ y <= pi /\ cos y = a ==> y = x` THEN
\r
2419 MESON_TAC[]];EXISTS_TAC `x:real` THEN
\r
2420 SIMP_IDENT[] `&0 <= x ` THEN
\r
2421 SIMP_IDENT[]` cos x = a ` THEN
\r
2422 ASSUME_TAC PI_POS THEN
\r
2423 ASSUME_TAC2 (REAL_ARITH` x <= pi /\ &0 < pi ==>
\r
2424 x < &2 * pi `) THEN
\r
2425 SIMP_IDENT[]` x < &2 * pi` THEN
\r
2426 ASSUME_TAC (SPEC_ALL SIN_CIRCLE) THEN
\r
2427 USE_FIRST `cos x = a ` SUBST_ALL_TAC THEN
\r
2428 ASSUME_TAC2 (REAL_ARITH` a pow 2 + b pow 2 = &1 /\
\r
2429 sin x pow 2 + a pow 2 = &1 ==> b pow 2 = sin x pow 2 `) THEN
\r
2430 ASSUME_TAC2 (SPEC_ALL SIN_POS_PI_LE) THEN
\r
2431 ASSUME_TAC2 (MESON[EQ_POW2_COND]` b pow 2 = sin x pow 2
\r
2432 /\ &0 <= sin x /\ &0 <= b ==> sin x = b `) THEN
\r
2433 SIMP_IDENT[]` sin x = b ` THEN
\r
2434 ONCE_SIMP_IDENT ` &0 < pi ` (REAL_ARITH` &0 < p ==> ( x
\r
2435 < &2 * p <=> x <= p \/ p < x /\ x < &2 * p )`) THEN
\r
2436 REPEAT STRIP_TAC THENL [ASM_MESON_TAC[];
\r
2437 ASSUME_TAC2 (REAL_ARITH` pi < y /\ y < &2 * pi ==>
\r
2438 &0 < y - pi /\ y - pi < pi `)] THEN
\r
2439 ASSUME_TAC (UNDISCH (SPEC ` y - pi ` SIN_POS_PI)) THEN
\r
2440 UNDISCH_TAC ` &0 < sin ( y - pi )` THEN
\r
2441 ONCE_REWRITE_TAC[GSYM SIN_PERIODIC] THEN
\r
2442 REWRITE_TAC[REAL_ARITH` a - b + &2 * b = a + b `;
\r
2443 SIN_PERIODIC_PI] THEN ASM_REWRITE_TAC[] THEN
\r
2444 SIMP_IDENT[REAL_ARITH` &0 <= a ==> ~( &0 < -- a )`]
\r
2450 let PERIODIC_AT0_IMP_ANY = prove(
\r
2451 ` ! f p t. &0 < p /\
\r
2452 (! x. f x = f ( x + p )) ==>
\r
2453 ((?!x. &0 <= x /\ x < p /\ f x ) <=> (! t. &0 <= t /\
\r
2454 t < p ==> (?!x. t <= x /\
\r
2455 x < t + p /\ f x )))`,
\r
2456 REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE] THEN
\r
2457 EQ_TAC THENL [REPEAT STRIP_TAC
\r
2458 THEN ASM_CASES_TAC ` t <= (x:real) ` THENL [
\r
2459 EXISTS_TAC `x:real` THEN SIMP_IDENT[] `t <= x `
\r
2460 THEN SIMP_IDENT[] `(f: real -> bool) x` THEN
\r
2461 ELIM_IDENTS (REAL_ARITH` x < p /\ &0 <= t ==>
\r
2462 x < t + p `) THEN REPEAT STRIP_TAC THEN
\r
2463 ASM_CASES_TAC ` y < (p:real)` THENL [
\r
2464 ASSUME_TAC2 (REAL_ARITH` &0 <= t /\ t <= y ==>
\r
2465 &0 <= y `) THEN ASM_MESON_TAC[];
\r
2466 DOWN_TAC THEN REWRITE_TAC[REAL_ARITH` ~( a < b ) <=>
\r
2467 &0 <= a - b `; REAL_ARITH` a < b + c <=>
\r
2468 a - c < b `] THEN STRIP_TAC THEN
\r
2469 ASSUME_TAC2 (REAL_ARITH` y - p < t /\ t < p ==>
\r
2471 ASSUME_TAC2 (prove(`(! a. f a <=> f ( a + (p:real)) )/\ f y ==>
\r
2472 f ( y - p )`, PAT_ONCE_REWRITE_TAC `\x. _ /\ x ==> _`
\r
2473 [REAL_ARITH` a = a - p + p `] THEN MESON_TAC[])) THEN
\r
2475 MESON[]`(!y. &0 <= y /\ y < p /\ f y ==> y = x)
\r
2476 <=> (!y. &0 <= y ==> y < p ==> f y ==> y = x)`) THEN
\r
2478 MESON[]`(!(y:real). &0 <= y ==> y < p ==> f y ==> y = x) /\
\r
2479 &0 <= y - p /\y - p < p /\ f ((y:real) - p) ==> x = y - p `) THEN
\r
2480 REWRITE_TAC[REAL_ARITH` y = y - p <=> p = &0 `] THEN
\r
2481 ASM_MESON_TAC[REAL_ARITH` y < t /\ x = y ==>
\r
2482 ~( t <= x ) `]];EXISTS_TAC `x + p ` THEN
\r
2483 SUBST_ALL_TAC (REAL_ARITH` ~( t <= x ) <=> x < t `) THEN
\r
2484 ELIM_IDENTS (REAL_ARITH` t < p /\ &0 <= x /\ x < t ==>
\r
2485 t <= x + p /\ x + p < t + p `) THEN
\r
2486 ELIM_IDENTS (MESON[]`(!x. f x <=> f ( x + (p:real)))
\r
2487 /\ f x ==> f ( x + p )`) THEN
\r
2488 REWRITE_TAC[REAL_ARITH` a < b + c <=> a - c < b `] THEN
\r
2489 REPEAT STRIP_TAC THEN
\r
2490 ASM_CASES_TAC ` &0 <= y - p ` THEN
\r
2491 ASSUME_TAC2 (REAL_ARITH` y - p < t /\ t < p ==>
\r
2493 ASSUME_TAC2 (prove(`(! a. f a <=> f ( a + (p:real)) )/\ f y ==>
\r
2494 f ( y - p )`, PAT_ONCE_REWRITE_TAC `\x. _ /\ x ==> _`
\r
2495 [REAL_ARITH` a = a - p + p `] THEN MESON_TAC[]))]
\r
2496 THENL [SUBST_ALL_TAC (
\r
2497 MESON[]`(!y. &0 <= y /\ y < p /\ f y ==> y = x)
\r
2498 <=> (!y. &0 <= y ==> y < p ==> f y ==> y = x)`) THEN
\r
2500 MESON[]`(!y. &0 <= y ==> y < p ==> f y ==> y = x) /\
\r
2501 &0 <= y - p /\ y - p < p /\ f ( y - p) ==> y - p
\r
2503 (SIMP_IDENT[REAL_ARITH` a - b = c <=> a = b + c `]
\r
2504 `y - p = (x:real) `) THEN SIMP_TAC[REAL_ADD_SYM];
\r
2505 SUBST_ALL_TAC (REAL_ARITH`~( &0 <= y - p ) <=> y < p `) THEN
\r
2506 ASSUME_TAC2 (REAL_ARITH` &0 <= t /\ t <= y ==>
\r
2507 &0 <= y `) THEN SUBST_ALL_TAC (
\r
2508 MESON[]`(!y. &0 <= y /\ y < p /\ f y ==> y = x)
\r
2509 <=> (!y. &0 <= y ==> y < p ==> f y ==> y = x)`) THEN
\r
2510 ASSUME_TAC2 (MESON[]`(!y. &0 <= y ==> y < p ==> f y ==> y = x)/\
\r
2511 f y /\ y < p /\ &0 <= y ==> y = x `) THEN
\r
2512 (CONTR_TAC o UNDISCH_ALL o REAL_ARITH) ` y = x ==> x < t ==> t <= y ==> F `];
\r
2513 DISCH_TAC THEN FIRST_X_ASSUM (ASSUME_TAC o (SPEC
\r
2514 ` &0 ` )) THEN ASSUME_TAC (REAL_ARITH` &0 <= &0 `)
\r
2515 THEN DOWN_TAC THEN REWRITE_TAC[REAL_ADD_LID]
\r
2516 THEN MESON_TAC[]]);;
\r
2523 let SUM_TWO_POW2S = MESON[REAL_LE_POW_2; REAL_LE_ADD]` &0 <= a pow 2 + b pow 2 `;;
\r
2527 let IDENT_WHEN_IDENT_SIN_COS = prove(`
\r
2528 &0 <= x' /\ x' < &2 * pi /\ &0 <= p /\ p < &2 * pi /\
\r
2529 cos x' = cos p /\ sin x' = sin p ==> p = x' `,
\r
2530 MP_TAC SIN_CIRCLE THEN
\r
2531 ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
\r
2532 MESON_TAC[SUM_POW2_EQ1_UNIQUE_TRIG]);;
\r
2540 let UNIQUE_EXISTSENCE_OF_RPHIH =
\r
2541 prove(`!w u (e1: real^3) e2 e3 x.
\r
2542 orthonormal e1 e2 e3 /\
\r
2543 e3 = &1 / norm (w - u) % (w - u) /\
\r
2544 ~(x IN aff {w, u}) /\
\r
2551 u + (r * cos phii) % e1 + (r * sin phii) % e2 + h % (w - u)) /\
\r
2557 u + (rr * cos p) % e1 + (rr * sin p) % e2 + hh % (w - u)
\r
2558 ==> rr = r /\ p = phii /\ hh = h))`,
\r
2559 REPEAT GEN_TAC THEN
\r
2560 REWRITE_TAC[orthonormal; GSYM DET_VEC3_AS_CROSS_DOT] THEN
\r
2561 NHANH (REAL_LT_IMP_NZ) THEN
\r
2562 ONCE_REWRITE_TAC[MESON[VECTOR_SUB_RZERO]` fv a b c = fv ( a - vec 0 ) ( b - vec 0 )
\r
2563 ( c - vec 0 ) `] THEN
\r
2564 REWRITE_TAC[GSYM COPLANAR_DET_VEC3_EQ_0] THEN
\r
2565 NHANH (SPECL [`e1 : real^3`;` e2 :real^3`; `e3 :real^3`;
\r
2566 `(vec 0 : real^3)`; `(x : real^3) - u` ] NONCOPLANAR_3_BASIS) THEN
\r
2567 REWRITE_TAC[VECTOR_SUB_RZERO] THEN
\r
2569 ASM_CASES_TAC` t1 = &0 /\ t2 = &0 ` THENL [
\r
2570 FIRST_X_ASSUM (CONJUNCTS_THEN ASSUME_TAC) THEN
\r
2571 (ASSUME_TAC o FOR_ASM ) (prove(` t1 = &0 /\ t2 = &0 /\
\r
2572 x - u= t1 % e1 + t2 % e2 + t3 % e3
\r
2573 ==> (x:real^3) - u = t3 % e3 `,
\r
2574 SIMP_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID])) THEN
\r
2575 FIRST_X_ASSUM MP_TAC THEN
\r
2576 UNDISCH_TAC` e3 = &1 / norm (w - u) % (w - (u:real^3))` THEN
\r
2577 SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH`
\r
2578 a -(b:real^n) = n % ( c - b )<=> a = n % c +
\r
2579 ( &1 - n ) % b `] THEN
\r
2580 UNDISCH_TAC ` ~( x IN aff {w,(u:real^3)} )` THEN
\r
2581 REWRITE_TAC[AFF2; IN_ELIM_THM] THEN
\r
2583 FIRST_X_ASSUM MP_TAC THEN
\r
2584 NHANH NOT_EQ0_IMP_TRIGIZABLE THEN
\r
2585 NHANH SUM_POW2_EQ1_UNIQUE_TRIG THEN
\r
2586 PAT_REWRITE_TAC `\x. _ /\ _ /\ x ==> _ `
\r
2587 [REAL_ARITH` a < &2 * b <=> a < &0 + &2 * b `] THEN
\r
2588 SIMP_TAC[GSYM REAL_SOS_EQ_0] THEN
\r
2589 ONCE_REWRITE_TAC[MESON[]` a /\b ==> c <=> a ==> b ==> c `] THEN
\r
2590 SIMP_TAC[GSYM SQRT_EQ_0; MESON[REAL_LE_POW_2;
\r
2591 REAL_LE_ADD]` &0 <= t1 pow 2 + t2 pow 2 `; REAL_FIELD`
\r
2592 ~ ( a = &0 ) ==> (d = t / a <=> t = a * d ) `] THEN
\r
2593 REWRITE_TAC[EXISTS_UNIQUE] THEN
\r
2594 REPEAT STRIP_TAC THEN
\r
2595 UNDISCH_TAC`x - u = t1 % e1 + t2 % e2 + t3 % (e3: real^3)` THEN
\r
2596 ABBREV_TAC ` tt = t1 pow 2 + t2 pow 2 ` THEN
\r
2597 UNDISCH_TAC ` t1 = sqrt tt * cos x' ` THEN
\r
2598 UNDISCH_TAC ` t2 = sqrt tt * sin x' ` THEN
\r
2600 REWRITE_TAC[VECTOR_ARITH` a - b = c <=> a = b + (c:real^N)`] THEN
\r
2601 REPEAT STRIP_TAC THEN
\r
2602 EXISTS_TAC ` sqrt tt ` THEN
\r
2603 EXISTS_TAC ` x' :real ` THEN
\r
2604 EXISTS_TAC ` t3 * ( &1 / norm ( (w:real^3) - u )) ` THEN
\r
2606 UNDISCH_TAC`x = u + (sqrt tt * cos x') % e1 +
\r
2607 (sqrt tt * sin x') % e2 + t3 % (e3 : real^3 )` THEN
\r
2608 UNDISCH_TAC` e3 = &1 / norm (w - u) % (w - (u:real^3))` THEN
\r
2609 REWRITE_TAC[REAL_ARITH` &0 < a /\ ~( a = &0 ) <=> &0 < a `] THEN
\r
2610 ASSUME_TAC2 (REAL_ARITH` x' < &0 + &2 * pi ==> x' <
\r
2612 ASSUME_TAC2 (MESON[SQRT_POS_LE; REAL_LE_POW_2; REAL_LE_ADD]` t1 pow 2 +
\r
2613 t2 pow 2 = tt ==> &0 <= sqrt tt `) THEN
\r
2614 ASSUME_TAC2 (REAL_ARITH` ~ ( sqrt tt = &0 ) /\ &0 <= sqrt tt
\r
2615 ==> &0 < sqrt tt `) THEN
\r
2616 UNDISCH_TAC ` &0 < sqrt tt ` THEN
\r
2617 UNDISCH_TAC ` x' < &2 * pi ` THEN
\r
2618 UNDISCH_TAC ` &0 <= x' ` THEN
\r
2619 SIMP_TAC[VECTOR_MUL_ASSOC];
\r
2620 IMP_TAC THEN IMP_TAC THEN IMP_TAC THEN IMP_TAC THEN
\r
2621 REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN
\r
2622 UNDISCH_TAC `!ta tb tc.
\r
2623 x - (u:real^3) = ta % e1 + tb % e2 + tc % e3
\r
2624 ==> ta = t1 /\ tb = t2 /\ tc = t3` THEN
\r
2625 FIRST_X_ASSUM MP_TAC THEN
\r
2626 UNDISCH_TAC`x = u + (sqrt tt * cos x') % e1
\r
2627 + (sqrt tt * sin x') % e2 + t3 % (e3:real^3)` THEN
\r
2628 REWRITE_TAC[VECTOR_ARITH` a - b = (c:real^N)
\r
2629 <=> a = b + c `] THEN
\r
2630 UNDISCH_TAC`e3 = &1 / norm (w - u) % (w - (u:real^3))` THEN
\r
2631 UNDISCH_TAC` ~(w = (u:real^3) )` THEN
\r
2633 PAT_ONCE_REWRITE_TAC `\x. x /\ _ ==> _ `
\r
2634 [VECTOR_ARITH` ( a = (b:real^N))
\r
2635 <=> ( a - b = vec 0 )`] THEN
\r
2636 REWRITE_TAC[ GSYM NORM_POS_LT] THEN
\r
2637 NHANH (MESON[REAL_FIELD ` &0 < a ==> a * &1 / a = &1`;
\r
2638 VECTOR_MUL_ASSOC]` &0 < a /\ aa = &1 / a % bb /\ l ==>
\r
2639 a % aa = ( &1 )% bb `) THEN
\r
2640 REWRITE_TAC[VECTOR_MUL_LID] THEN
\r
2643 DISCH_THEN (ASSUME_TAC o SYM) THEN
\r
2644 FIRST_ASSUM ( fun th -> PAT_ONCE_REWRITE_TAC `
\r
2645 \x. _ /\ x /\ _ ==> _ ` [ th]) THEN
\r
2646 REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
\r
2647 NHANH (MESON[]` (!ta tb tc.
\r
2648 x = u + ta % e1 + tb % e2 + tc % e3 ==> tc = t3 /\ ta = t1 /\ tb = t2 ) /\
\r
2649 x = u + h1 % e1 + h2 % e2 + h3 % e3 /\
\r
2650 x = u + l1 % e1 + l2 % e2 + l3 % e3 /\ ll ==>
\r
2651 l1 = h1 /\ l2 = h2 /\ l3 = h3 `) THEN
\r
2653 ELIM_IDENTS (REAL_FIELD` &0 < norm ((w:real^3) - u) /\ t3 = hh * norm ( w - u )
\r
2654 ==> hh = t3 * &1 / norm ( w - u ) `) THEN
\r
2655 REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC) THEN
\r
2657 NHANH (MESON[]` a = b /\ aa = bb /\ l ==> a pow 2 + aa pow 2 =
\r
2658 b pow 2 + bb pow 2 `) THEN
\r
2659 REWRITE_TAC[REAL_ARITH` (a * b ) pow 2 + (a * c ) pow 2 =
\r
2660 a pow 2 * ( c pow 2 + b pow 2 ) `; SIN_CIRCLE; REAL_MUL_RID] THEN
\r
2661 ASSUME_TAC2 (MESON[SUM_TWO_POW2S]` t1 pow 2 + t2 pow 2 = tt
\r
2662 ==> &0 <= tt `) THEN
\r
2663 ASSUME_TAC2 (SPEC `tt:real` SQRT_POS_LE) THEN
\r
2664 ASSUME_TAC2 (SPECL[` &0`;` rr:real `] REAL_LT_IMP_LE) THEN
\r
2665 ASSUME_TAC2 (SPECL[` rr:real `;` sqrt tt `] EQ_POW2_COND) THEN
\r
2666 FIRST_X_ASSUM (MP_TAC o SYM) THEN
\r
2667 PAT_ONCE_REWRITE_TAC `\x. (x <=> _ ) ==> _` [EQ_SYM_EQ] THEN
\r
2669 REPEAT STRIP_TAC THEN
\r
2670 FIRST_X_ASSUM (SUBST_ALL_TAC o SYM) THEN
\r
2671 ASSUME_TAC2 (REAL_FIELD` &0 < rr /\ rr * cos x' = rr * cos p /\
\r
2672 rr * sin x' = rr * sin p ==>
\r
2673 cos x' = cos p /\ sin x' = sin p `) THEN
\r
2674 SUBST_ALL_TAC (REAL_ARITH` x' < &0 + &2 * pi <=> x' < &2 * pi `) THEN
\r
2675 FIRST_X_ASSUM (CONJUNCTS_THEN ASSUME_TAC) THEN
\r
2676 ELIM_IDENTS IDENT_WHEN_IDENT_SIN_COS]]);;
\r
2680 let REAL_EXISTS_UNIQUE_TRANSABLE =
\r
2681 prove(` ! f (t:real). (?!x. f x ) <=> (?!x. f (x - t))`,
\r
2682 REWRITE_TAC[EXISTS_UNIQUE] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [
\r
2683 STRIP_TAC THEN EXISTS_TAC `x + (t:real)` THEN
\r
2684 ASM_REWRITE_TAC[REAL_ARITH` (a + b ) - b = a `] THEN
\r
2685 ASM_MESON_TAC[REAL_EQ_SUB_RADD; REAL_ARITH` (a + b ) - b = a `];
\r
2686 STRIP_TAC THEN EXISTS_TAC ` x - (t:real)` THEN
\r
2687 ASM_REWRITE_TAC[] THEN GEN_TAC THEN ONCE_REWRITE_TAC
\r
2688 [REAL_ARITH` x = ( x + t ) - t `] THEN DISCH_TAC THEN
\r
2689 SUBGOAL_THEN ` y + t = (x:real)` ASSUME_TAC THENL
\r
2690 [ASM_MESON_TAC[]; ASM_REAL_ARITH_TAC]]);;
\r
2692 (* ==================================================================== *)
\r
2693 (* in thms_doing_works.ml *)
\r
2694 (* ==================================================================== *)
\r
2695 (* ==================================================================== *)
\r
2699 let COND_FOR_EXISTS_ANY_PERI = prove(` &0 < p /\ (!x. f x <=> f (x + p))
\r
2700 /\ (?!x. &0 <= x /\ x < p /\ f x) ==>
\r
2701 (! t . &0 <= t /\ t < p ==> (?!x. t <= x /\ x < t + p /\ f x)) `,
\r
2702 ASSUME_TAC (SPEC_ALL PERIODIC_AT0_IMP_ANY) THEN ASM_MESON_TAC[]);;
\r
2706 let IN_ORIGIN_PERIOD_IMP_UNIQUENESS =
\r
2707 prove(` ! x t. &0 <= t /\ t < &2 * pi ==> (?!gg. &0 <= gg /\
\r
2708 gg < &2 * pi /\ cos x = cos ( t + gg )
\r
2709 /\ sin x = sin ( t + gg )) `, REPEAT STRIP_TAC THEN
\r
2710 MP_TAC (ONCE_REWRITE_RULE[REAL_ADD_SYM] (SPEC_ALL SIN_CIRCLE)) THEN
\r
2711 NHANH SUM_POW2_EQ1_UNIQUE_TRIG THEN STRIP_TAC THEN
\r
2712 ONCE_REWRITE_TAC[REAL_EXISTS_UNIQUE_TRANSABLE] THEN
\r
2713 REWRITE_TAC[REAL_SUB_LE; REAL_LT_SUB_RADD; REAL_SUB_ADD2 ] THEN
\r
2714 ASSUME_TAC SIN_PERIODIC THEN ASSUME_TAC COS_PERIODIC THEN
\r
2715 MP_TAC PI_POS THEN
\r
2716 PAT_ONCE_REWRITE_TAC `\x. x ==> _ ` [REAL_ARITH` &0 < a <=>
\r
2717 &0 < &2 * a `] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
\r
2718 ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
\r
2719 DISCH_TAC THEN UNDISCH_TAC ` t < &2 * pi ` THEN
\r
2720 UNDISCH_TAC ` &0 <= t ` THEN PHA THEN
\r
2721 SPEC_TAC (`t:real`,`t:real`) THEN
\r
2722 MATCH_MP_TAC COND_FOR_EXISTS_ANY_PERI THEN ASM_MESON_TAC[]);;
\r
2726 let GIVEN_VALUED_IMP_UNIQUE_EXISTENCE = prove(
\r
2727 `! x0. (?!x. &0 <= x /\ x < &2 * pi /\ cos x = cos x0 /\
\r
2728 sin x = sin x0 )`, REPEAT STRIP_TAC THEN
\r
2729 MP_TAC (ONCE_REWRITE_RULE[REAL_ADD_SYM] SIN_CIRCLE) THEN
\r
2730 NHANH SUM_POW2_EQ1_UNIQUE_TRIG THEN SIMP_TAC[]);;
\r
2734 let EYFCXPP = prove(` !w u e1 e2 e3 (x1:real ^3 ) x2.
\r
2735 orthonormal e1 e2 e3 /\
\r
2736 e3 = &1 / norm (w - u) % (w - u) /\
\r
2737 ~(x1 IN aff {w, u}) /\
\r
2738 ~(x2 IN aff {w,u}) /\
\r
2740 ==> (? r1 r2 phii ssi h1 h2.
\r
2743 &0 <= ssi /\ ssi < &2 * pi /\
\r
2744 &0 < r1 /\ &0 < r2 /\
\r
2747 (r1 * cos phii) % e1 +
\r
2748 (r1 * sin phii) % e2 +
\r
2751 (r2 * cos (phii + ssi )) % e1 +
\r
2752 (r2 * sin (phii + ssi )) % e2 +
\r
2754 (! rr1 rr2 pphii ssii h11 h22.
\r
2756 pphii < &2 * pi /\
\r
2757 &0 <= ssii /\ ssii < &2 * pi /\
\r
2758 &0 < rr1 /\ &0 < rr2 /\
\r
2761 (rr1 * cos pphii) % e1 +
\r
2762 (rr1 * sin pphii) % e2 +
\r
2765 (rr2 * cos (pphii + ssii )) % e1 +
\r
2766 (rr2 * sin (pphii + ssii )) % e2 +
\r
2767 h22 % (w - u)) ==>
\r
2768 rr1 = r1 /\ rr2 = r2 /\ pphii = phii /\
\r
2769 ssii = ssi /\ h11 = h1 /\ h22 = h2 ) )`,
\r
2770 ONCE_REWRITE_TAC[MESON[]` a1 /\a2/\a3/\a4 /\a5 <=>
\r
2771 (a1/\a2/\a3/\a5) /\ a4 `] THEN
\r
2772 NHANH UNIQUE_EXISTSENCE_OF_RPHIH THEN
\r
2773 ONCE_REWRITE_TAC[MESON[]` (( a1 /\a2/\a3/\a4) /\ss)/\a5 <=>
\r
2774 (a1/\a2/\a5/\a4)/\a3/\ss`] THEN
\r
2775 NHANH UNIQUE_EXISTSENCE_OF_RPHIH THEN REPEAT STRIP_TAC THEN
\r
2776 UNDISCH_TAC ` phii' < &2 * pi ` THEN UNDISCH_TAC ` &0 <= phii' ` THEN
\r
2777 PHA THEN NHANH_PAT `\x. x ==> _ ` (SPEC `phii: real` IN_ORIGIN_PERIOD_IMP_UNIQUENESS)
\r
2778 THEN REWRITE_TAC[EXISTS_UNIQUE] THEN STRIP_TAC THEN
\r
2779 EXISTS_TAC `r': real` THEN EXISTS_TAC `r:real` THEN
\r
2780 EXISTS_TAC ` phii': real` THEN EXISTS_TAC `gg: real` THEN
\r
2781 EXISTS_TAC ` h': real` THEN EXISTS_TAC ` h: real` THEN
\r
2782 ASM_REWRITE_TAC[] THEN REPEAT GEN_TAC THEN REWRITE_TAC[TAUT`
\r
2783 a /\ b ==> c <=> a ==> b ==> c`] THEN REPEAT DISCH_TAC THEN
\r
2784 REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC) THEN
\r
2785 UNDISCH_TAC ` (x2: real^3 ) = u + (r * cos phii) % e1 +
\r
2786 (r * sin (phii)) % e2 + h % (w - u)` THEN
\r
2787 UNDISCH_TAC `(x1 : real^3) = u + (r' * cos phii') % e1 +
\r
2788 (r' * sin phii') % e2 + h' % (w - u)` THEN
\r
2789 ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[]
\r
2790 THEN REPEAT DISCH_TAC THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
\r
2791 ASSUME_TAC2 (UNDISCH (MESON[]`(!rr p hh. &0 <= p /\ p < &2 * pi /\ &0 < rr /\
\r
2792 (x1: real^3) = u + (rr * cos p) % e1 + (rr * sin p) % e2 + hh % (w - u)
\r
2793 ==> rr = r' /\ p = phii' /\ hh = h') ==>
\r
2794 u + (rr1 * cos pphii) % e1 + (rr1 * sin pphii) % e2 + h11 % (w - u) =
\r
2795 x1 /\ &0 <= pphii /\ pphii < &2 * pi /\ &0 < rr1 ==>
\r
2796 rr1 = r' /\ pphii = phii' /\ h11 = h' `)) THEN ASM_REWRITE_TAC[]
\r
2797 THEN REPEAT (FIRST_X_ASSUM (CONJUNCTS_THEN ASSUME_TAC)) THEN
\r
2798 MP_TAC (SPEC `pphii + (ssii: real)`
\r
2799 GIVEN_VALUED_IMP_UNIQUE_EXISTENCE) THEN
\r
2800 REWRITE_TAC[EXISTS_UNIQUE] THEN STRIP_TAC THEN
\r
2801 UNDISCH_TAC ` (u: real^3) + (rr2 * cos (pphii + ssii)) % e1 +
\r
2802 (rr2 * sin (pphii + ssii)) % e2 + h22 % (w - u) = x2` THEN
\r
2803 REPLICATE_TAC 3 (FIRST_X_ASSUM MP_TAC) THEN
\r
2804 ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN SIMP_TAC[] THEN
\r
2805 PHA THEN STRIP_TAC THEN
\r
2806 ASSUME_TAC2 ((UNDISCH o MESON[])`(!rr p hh. &0 <= p /\ p < &2 * pi /\ &0 < rr /\
\r
2807 (x2: real^3) = u + (rr * cos p) % e1 + (rr * sin p) % e2 + hh % (w - u)
\r
2808 ==> rr = r /\ p = phii /\ hh = h) ==>
\r
2809 &0 < rr2 /\ &0 <= x /\ x < &2 * pi /\
\r
2810 x2 = u + (rr2 * cos x) % e1 + (rr2 * sin x) % e2 + h22 % (w - u)
\r
2811 ==> r = rr2 /\ h = h22 /\ x = phii `) THEN
\r
2812 FIRST_ASSUM (fun x -> REWRITE_TAC[ x]) THEN
\r
2813 USE_FIRST `(pphii: real) = phii' ` SUBST_ALL_TAC THEN
\r
2814 REPEAT (FIRST_X_ASSUM (CONJUNCTS_THEN ASSUME_TAC)) THEN
\r
2815 FIRST_X_ASSUM SUBST_ALL_TAC THEN
\r
2816 ELIM_IDENTS ((UNDISCH o MESON[])`(!y. &0 <= y /\
\r
2817 y < &2 * pi /\ cos phii = cos (phii' + y) /\
\r
2818 sin phii = sin (phii' + y) ==> y = gg) ==>
\r
2819 cos (phii' + ssii) = cos phii /\
\r
2820 sin (phii' + ssii) = sin phii /\ &0 <= ssii /\ ssii < &2 * pi
\r
2821 ==> gg = ssii `));;
\r
2825 (* ========================== *)
\r
2826 (* ========================== *)
\r
2829 let INTERGRAL_UNIONS_INTERVALS =
\r
2830 prove(`! N. UNIONS {{x | &(n - 1) <= x /\ x < &n} | 0 < n /\ n <= N} =
\r
2831 {x | &0 <= x /\ x < &N}`, INDUCT_TAC THENL
\r
2832 [REWRITE_TAC[ARITH_RULE`~( 0 < b /\ b <= 0 )`; REAL_ARITH`~( &0 <= x /\ x < &0 )`] THEN
\r
2834 REWRITE_TAC[ARITH_RULE`0 < n /\ n <= SUC N <=> 0 < n /\ n <= N \/ n = N + 1`; SET_RULE` UNIONS
\r
2835 { f x | h x \/ x = N} = ( UNIONS { f x | h x }) UNION ( f N ) `] THEN
\r
2836 REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD; REAL_ARITH` &0 <= x /\ x < &N + &1 <=>
\r
2837 &0 <= x /\ x < &N \/ &N <= x /\ x < &N + &1 `] THEN
\r
2838 ASM_SIMP_TAC[ARITH_RULE` (a + 1) - 1 = a `] THEN SET_TAC[]]);;
\r
2841 let REAL_LE_EQ_OR_LT = REAL_ARITH` &0 <= a <=> a = &0 \/ &0 < a `;;
\r
2844 let EXISTS_IN_UNIT_INTERVAL = prove(`!x. ?n. &0 <= x + real_of_int n /\ x + real_of_int n < &1`,
\r
2845 MATCH_MP_TAC (MESON[REAL_ARITH` &0 <= a \/ &0 <= -- a `]` (! a. P a ==> P ( -- a ))
\r
2846 /\ (! a. &0 <= a ==> P a ) /\ (! a. a = -- ( -- a )) ==> (! a . P a )`) THEN CONJ_TAC THENL [
\r
2847 GEN_TAC THEN REWRITE_TAC[REAL_LE_EQ_OR_LT ] THEN STRIP_TAC THENL [
\r
2848 EXISTS_TAC ` -- (n:int)` THEN
\r
2849 ASM_REWRITE_TAC[int_neg_th; GSYM REAL_NEG_ADD; REAL_NEG_EQ_0] THEN REAL_ARITH_TAC;
\r
2850 EXISTS_TAC ` -- n + (&1: int)` THEN
\r
2851 ASM_REWRITE_TAC[int_neg_th; GSYM REAL_NEG_ADD; REAL_NEG_EQ_0;int_add_th; int_of_num_th]
\r
2852 THEN ASM_REAL_ARITH_TAC];REWRITE_TAC[REAL_NEGNEG] THEN GEN_TAC THEN
\r
2853 CHOOSE_TAC (SPEC `x: real` (MATCH_MP REAL_ARCH (REAL_ARITH` &0 < &1 `))) THEN
\r
2854 ASSUME_TAC (SPEC `n: num ` INTERGRAL_UNIONS_INTERVALS) THEN
\r
2855 DOWN_TAC THEN REWRITE_TAC[REAL_MUL_RID] THEN
\r
2856 NHANH (SET_RULE` x < &n /\ aa = {x | &0 <= x /\ x < &n} /\
\r
2857 &0 <= x ==> x IN aa `) THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN
\r
2858 STRIP_TAC THEN EXISTS_TAC` -- ( &(n' - 1): int) ` THEN
\r
2859 REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN
\r
2860 PHA THEN NHANH (SET_RULE` t = {x| P x } /\ x IN t ==> P x `) THEN
\r
2861 REWRITE_TAC[int_neg_th; int_of_num_th] THEN STRIP_TAC THEN
\r
2862 REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN
\r
2863 ASSUME_TAC2 (ARITH_RULE` 0 < n' ==> 1 <= n'`) THEN
\r
2864 ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB] THEN REAL_ARITH_TAC]);;
\r
2866 let TWO_PI_POS = prove(` &0 < &2 * pi `, MP_TAC PI_POS THEN REAL_ARITH_TAC);;
\r
2869 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
2870 ONCE_REWRITE_TAC [GSYM (MATCH_MP REAL_LE_RDIV_0 TWO_PI_POS)] THEN
\r
2871 ONCE_REWRITE_TAC[GSYM (MATCH_MP REAL_LT_DIV2_EQ TWO_PI_POS)] THEN
\r
2872 REWRITE_TAC[REAL_ARITH` ( a + b ) / c = a / c + b / c `; MATCH_MP (REAL_FIELD` &0 < a ==> a / a = &1 `) TWO_PI_POS;
\r
2873 MATCH_MP (REAL_FIELD` &0 < c ==> (a * c ) / c = a `) TWO_PI_POS] THEN MESON_TAC[EXISTS_IN_UNIT_INTERVAL ]);;
\r
2877 let SIN_TOTAL_PERIODIC = prove(`! n. sin (x + &n * &2 * pi) = sin x `,
\r
2878 INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN
\r
2879 ASM_REWRITE_TAC[ADD1;GSYM REAL_OF_NUM_ADD;
\r
2880 REAL_ARITH` x + (&n + &1) * a = (x + &n * a ) + a `; SIN_PERIODIC]);;
\r
2883 let SIN_PERIODIC_IN_WHOLE = prove(` !n. sin ( x + real_of_int n * &2 * pi ) = sin x `,
\r
2884 GEN_TAC THEN ASM_CASES_TAC` &0 <= (n: int) ` THENL [
\r
2885 ASSUME_TAC2 (SPEC `n: int ` INT_OF_NUM_OF_INT) THEN EXPAND_TAC "n" THEN
\r
2886 REWRITE_TAC[int_of_num_th; SIN_TOTAL_PERIODIC ]; FIRST_X_ASSUM MP_TAC] THEN
\r
2887 NHANH (ARITH_RULE` ~( &0 <= (n: int) ) ==> &0 <= -- n `) THEN STRIP_TAC THEN
\r
2888 ASSUME_TAC2 (SPEC `-- n: int ` INT_OF_NUM_OF_INT) THEN
\r
2889 ONCE_REWRITE_TAC[ARITH_RULE` (a: int) = -- -- a `] THEN
\r
2890 ONCE_REWRITE_TAC[int_neg_th] THEN FIRST_X_ASSUM (SUBST1_TAC o SYM) THEN
\r
2891 REWRITE_TAC[int_of_num_th; REAL_MUL_LNEG] THEN
\r
2892 MESON_TAC[SIN_TOTAL_PERIODIC; REAL_ARITH`(a + -- b ) + (b:real) = a `]);;
\r
2896 let COS_PERIODIC_IN_WHOLE = prove(` cos ( x + real_of_int n * &2 * pi ) = cos x `,
\r
2897 REWRITE_TAC[COS_SIN; REAL_ARITH` a - (b + c ) = a - b - c `] THEN
\r
2898 MESON_TAC[REAL_ARITH` x = x - y + y `; SIN_PERIODIC_IN_WHOLE]);;
\r
2901 let SIN_COS_PERIODIC_IN_WHOLE =
\r
2902 GEN_ALL (CONJ (SPEC_ALL SIN_PERIODIC_IN_WHOLE) COS_PERIODIC_IN_WHOLE);;
\r
2905 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
2906 REPEAT GEN_TAC THEN EQ_TAC THENL [CHOOSE_TAC (SPEC` x:real` MOVE_TO_UNIT_INTERVAL ) THEN
\r
2907 CHOOSE_TAC (SPEC` y:real` MOVE_TO_UNIT_INTERVAL ) THEN
\r
2908 ASSUME_TAC (GSYM (SPECL[`n:int`;`x:real`] SIN_COS_PERIODIC_IN_WHOLE)) THEN
\r
2909 FIRST_X_ASSUM (fun x -> PAT_ONCE_REWRITE_TAC`\x. x = _ /\ x = _ ==> _ ` [x]) THEN
\r
2910 ASSUME_TAC (GSYM (SPECL[`n':int`;`y:real`] SIN_COS_PERIODIC_IN_WHOLE)) THEN
\r
2911 FIRST_X_ASSUM (fun x -> PAT_ONCE_REWRITE_TAC `\x. _ = x /\ _ = x ==> _ ` [x]) THEN
\r
2912 DOWN_TAC THEN NHANH IDENT_WHEN_IDENT_SIN_COS THEN
\r
2913 REWRITE_TAC[REAL_ARITH`y + a * t = x + b * t <=> x = y + (a -b ) * t`; GSYM int_sub_th] THEN
\r
2914 STRIP_TAC THEN EXISTS_TAC ` n' - (n:int)` THEN ASM_REWRITE_TAC[];
\r
2915 STRIP_TAC THEN ASM_SIMP_TAC[SIN_COS_PERIODIC_IN_WHOLE ]]);;
\r
2918 let NOT_EQ_IMP_AFF_AND_COLL3 = prove(`! v (w:real^N) u. ~( v = w ) ==>
\r
2919 ( u IN aff {v,w} <=> collinear {v,w,u}) `, ONCE_REWRITE_TAC[COLLINEAR_3] THEN
\r
2920 REWRITE_TAC[COLLINEAR_LEMMA; VECTOR_SUB_EQ] THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN
\r
2921 MATCH_MP_TAC (MESON[]` (P ==> Q) /\ (Q <=> L) ==> (L <=> P \/ Q)`) THEN CONJ_TAC THENL [
\r
2922 STRIP_TAC THEN EXISTS_TAC `&0` THEN
\r
2923 ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_REFL]; REWRITE_TAC[AFF2; IN_ELIM_THM] THEN
\r
2924 EQ_TAC THENL [STRIP_TAC THEN EXISTS_TAC `c:real` THEN FIRST_X_ASSUM MP_TAC THEN
\r
2925 VECTOR_ARITH_TAC; STRIP_TAC THEN EXISTS_TAC `t:real` THEN FIRST_X_ASSUM MP_TAC THEN
\r
2926 VECTOR_ARITH_TAC]]);;
\r
2928 let R_SIN_CIRCLE = prove(` ! r x. ( r * cos x ) pow 2 + ( r * sin x ) pow 2 = r pow 2 `,
\r
2929 REPEAT GEN_TAC THEN MP_TAC (SPEC_ALL SIN_CIRCLE) THEN CONV_TAC REAL_RING);;
\r
2932 let R_SIN_COS_IDENT = prove(`! r rr x y. &0 <= r /\ &0 <= rr /\
\r
2933 r * cos x = rr * cos y /\ r * sin x = rr * sin y ==> r = rr /\ (
\r
2934 r = &0 \/ cos x = cos y /\ sin x = sin y ) `,
\r
2935 NHANH (MESON[R_SIN_CIRCLE ]`r * cos x = rr * cos y /\ r * sin x = rr * sin y ==>
\r
2936 r pow 2 = rr pow 2 `) THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
\r
2937 SUBGOAL_THEN `r = (rr: real)` ASSUME_TAC THENL [ASM_SIMP_TAC[EQ_POW2_COND];
\r
2938 ASM_SIMP_TAC[]] THEN ASM_CASES_TAC ` rr = &0 ` THENL [ASM_SIMP_TAC[]; DISJ2_TAC] THEN
\r
2939 FIRST_X_ASSUM SUBST_ALL_TAC THEN DOWN_TAC THEN
\r
2940 REWRITE_TAC[REAL_EQ_MUL_LCANCEL] THEN MESON_TAC[]);;
\r
2943 let R_POS_SIN_COS_IDENT = prove(`! r rr x y. &0 < r /\ &0 < rr /\
\r
2944 r * cos x = rr * cos y /\ r * sin x = rr * sin y ==> r = rr /\
\r
2945 cos x = cos y /\ sin x = sin y `,
\r
2946 MESON_TAC[REAL_LT_IMP_LE; R_SIN_COS_IDENT; REAL_ARITH` &0 < a ==> ~( a = &0 )`]);;
\r
2949 let BEGIN_POINT_PERIODIC = prove(` ! x k. &0 <= x /\ x < &2 * pi /\ x = real_of_int k * &2 * pi ==> x = &0 `,
\r
2950 REPEAT GEN_TAC THEN ASSUME_TAC (SPEC` &0` REAL_LE_REFL) THEN ASSUME_TAC TWO_PI_POS THEN
\r
2951 STRIP_TAC THEN FIRST_X_ASSUM MP_TAC THEN
\r
2952 PAT_ONCE_REWRITE_TAC `\x. _ = x ==> _` [REAL_ARITH` a = &0 + a `] THEN
\r
2953 ASM_MESON_TAC[SIN_COS_PERIODIC_IN_WHOLE; IDENT_WHEN_IDENT_SIN_COS]);;
\r
2956 let BODE_YEU_ANH_DI = prove(`! k. &0 <= ppsssi /\ ppsssi < &2 * pi /\
\r
2957 &0 <= ppsssi1 /\ ppsssi1 < &2 * pi /\ &0 <= aa /\
\r
2959 aa = ppsssi - ppsssi1 + real_of_int k * &2 * pi ==>
\r
2960 ( aa = &0 <=> ppsssi = ppsssi1 ) `,
\r
2961 REPEAT STRIP_TAC THEN
\r
2962 EQ_TAC THENL [ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH` a - b + c = &0 <=> b = a + c `]
\r
2963 THEN ASM_MESON_TAC[IDENT_WHEN_IDENT_SIN_COS; SIN_COS_IDEN_IFF_DIFFER_PERS];
\r
2964 DISCH_THEN SUBST_ALL_TAC THEN DOWN_TAC THEN REWRITE_TAC[REAL_SUB_REFL; REAL_ADD_LID] THEN
\r
2965 MESON_TAC[BEGIN_POINT_PERIODIC ]]);;
\r
2969 (* ====================== *)
\r
2970 (* ====================== *)
\r
2971 (* ========= LEMMA 1.31 =========== *)
\r
2976 let ORTHONORMAL_BASIS = prove(
\r
2977 ` orthonormal ( basis 1 ) (basis 2 ) ( basis 3 ) `,
\r
2978 MP_TAC (MESON[DOT_BASIS_BASIS]`! i j. 1 <= i /\ i <= dimindex (:3) /\ 1 <= j /\ j <= dimindex (:3)
\r
2979 ==> ((basis i): real^3) dot basis j = (if i = j then &1 else &0)`) THEN
\r
2980 REWRITE_TAC[orthonormal; DIMINDEX_3; ARITH_RULE` 1 <= i /\ i <= 3 <=> i = 1 \/ i = 2 \/ i = 3 `] THEN
\r
2982 REWRITE_TAC[ARITH_RULE` 1 <= i /\ i <= 3 <=> i = 1 \/ i = 2 \/ i = 3 `] THEN
\r
2984 REWRITE_TAC[TAUT`(a \/ v) \/ c <=> a \/ v \/ c `] THEN
\r
2985 SIMP_TAC[TAUT`(a \/ v) \/ c <=> a \/ v \/ c `; MESON[]`(! i j. i = a /\ j = b \/ Q i j ==> R i j)
\r
2986 <=> R a b /\ (! i j. Q i j ==> R i j)`; ARITH_RULE` ~(1 = 2 )/\ ~( 1 = 3 ) /\ ~( 2 = 3 )` ] THEN
\r
2988 FIRST_X_ASSUM (MP_TAC o (SPECL[` 3`;`3`])) THEN
\r
2990 SIMP_TAC[CROSS_BASIS; REAL_ARITH` &0 < &1 `]);;
\r
2995 let ORTHO_IMP_NORM_CROSS_PRODUCT =
\r
2996 prove(`! x y. x dot y = &0 ==> norm (x cross y) pow 2 = (norm x * norm y) pow 2 `,
\r
2997 REPEAT STRIP_TAC THEN MP_TAC (SPEC_ALL NORM_CROSS_DOT) THEN
\r
2998 ASM_SIMP_TAC[REAL_ARITH` a + &0 pow 2 = a `]);;
\r
3001 let TWO_UNIT_ORTH_VECTORS_IMP_ORTHONORMAL = prove(`! e1 (e3:real^3). norm e1 = &1 /\ norm e3 = &1 /\ e1 dot e3 = &0 ==> (? e2.
\r
3002 orthonormal e1 e2 e3 ) `,
\r
3003 REPEAT STRIP_TAC THEN
\r
3004 EXISTS_TAC ` e3 cross e1 ` THEN
\r
3005 ASM_SIMP_TAC[DOT_CROSS_SELF; orthonormal; CROSS_LAGRANGE; DOT_LSUB;
\r
3006 DOT_LMUL; DOT_SQUARE_NORM; DOT_SYM] THEN
\r
3007 ASM_SIMP_TAC[DOT_RSUB; DOT_RMUL; GSYM NORM_POW_2; DOT_SYM] THEN
\r
3008 FIRST_X_ASSUM (MP_TAC o (ONCE_REWRITE_RULE[DOT_SYM])) THEN
\r
3009 NHANH ORTHO_IMP_NORM_CROSS_PRODUCT THEN
\r
3010 ASM_SIMP_TAC[] THEN
\r
3013 let ORTHONORMAL_BASIS3 = REWRITE_RULE[orthonormal] ORTHONORMAL_BASIS;;
\r
3015 let EXISTS_OTHOR_VECTOR_DIFFF_VEC0 = prove(
\r
3016 `! (u: real^3). ? v . ~(v = vec 0) /\ u dot v = &0 `,
\r
3017 GEOM_BASIS_MULTIPLE_TAC 1 `u:real^3` THEN REPEAT STRIP_TAC THEN
\r
3018 EXISTS_TAC `( basis 2): real^3` THEN MP_TAC ORTHONORMAL_BASIS THEN
\r
3019 SIMP_TAC[orthonormal; DOT_LMUL; REAL_MUL_RZERO;
\r
3020 REWRITE_RULE[DE_MORGAN_THM] NOT_BASISES_EQ_VEC0]);;
\r
3022 let INVERT_NORM_POS_LE = prove(` ! (x: real^N). &0 <= &1 / norm x `,
\r
3023 GEN_TAC THEN MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[NORM_POS_LE] THEN REAL_ARITH_TAC);;
\r
3025 let NOT_0_INVERTABLE = REAL_FIELD` ~( a = &0) <=> &1 / a * a = &1 `;;
\r
3028 let NOT_VEC0_UNITABLE = prove(`! (u: real^N). ~( u = vec 0 ) <=> norm ( &1 / norm u % u ) = &1 `,
\r
3029 SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; ABS_1; GSYM NORM_EQ_0; NOT_0_INVERTABLE]);;
\r
3032 let EXISTS_UNIT_OTHOR_VECTOR = prove(` !(u: real^3). ?v. norm v = &1 /\ u dot v = &0 `,
\r
3033 GEN_TAC THEN (CHOOSE_TAC (SPEC` u:real^3 ` EXISTS_OTHOR_VECTOR_DIFFF_VEC0)) THEN
\r
3034 EXISTS_TAC ` &1 / norm v % ( v:real^3) ` THEN ASM_SIMP_TAC[GSYM NOT_VEC0_UNITABLE; DOT_RMUL; REAL_MUL_RZERO]);;
\r
3038 let AFF3_TRANSLATION_IMAGE = prove(
\r
3039 ` aff (IMAGE (\x. (v:real^N) + x) {v1, v2, v3}) = IMAGE (\x. v + x) ( aff {v1,v2,v3} ) `,
\r
3040 REWRITE_TAC[IMAGE_CLAUSES; aff; AFFINE_HULL_3; FUN_EQ_THM; IN_ELIM_THM] THEN
\r
3041 GEN_TAC THEN EQ_TAC THENL [PAT_ONCE_REWRITE_TAC ` \x. _ ==> x ` [GSYM IN] THEN
\r
3042 STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE] THEN
\r
3043 EXISTS_TAC ` u % v1 + v' % v2 + w % (v3:real^N)` THEN
\r
3044 CONJ_TAC THENL [DOWN_TAC THEN SIMP_TAC[REAL_ARITH` a + b = &1 <=> a = &1 - b `]
\r
3045 THEN DISCH_TAC THEN VECTOR_ARITH_TAC; ASM_MESON_TAC[]];
\r
3046 PAT_ONCE_REWRITE_TAC ` \x. x ==> _ ` [GSYM IN]] THEN
\r
3047 REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC `u:real` THEN
\r
3048 EXISTS_TAC `v':real` THEN EXISTS_TAC `w:real` THEN
\r
3049 ASM_SIMP_TAC[VECTOR_ARITH` u % (v + v1) + v' % (v + v2) + w % (v + v3) = (u + v' + w ) % v +
\r
3050 u % v1 + v' % v2 + w % v3 `; VECTOR_MUL_LID]);;
\r
3053 let IMAGE_INTER_AFF3 = prove(`IMAGE (\x. (v:real^N) + x) s INTER aff (IMAGE (\x. v + x) {v1,v2,v3}) =
\r
3054 IMAGE (\x. v + x) (s INTER aff {v1,v2,v3})`,
\r
3055 SUBGOAL_THEN ` ! x y. (\x. (v:real^N) + x) y = (\x. v + x) x ==> y = x ` MP_TAC THENL [
\r
3056 REWRITE_TAC[BETA_THM; VECTOR_ARITH` a + b = a + c ==> b = (c:real^N)`];
\r
3057 SIMP_TAC[AFF3_TRANSLATION_IMAGE; GSYM IMAGE_INTER_INJ]]);;
\r
3060 let DIHV_TRASABLE = prove(`! (v: real^N). dihV (v + u) (v + w) (v + v1) (v + v2) = dihV u w v1 v2`,
\r
3061 REWRITE_TAC[dihV; VECTOR_ARITH` ((v:real^N) + v1) - (v + u) = v1 - u `]);;
\r
3064 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
3065 REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `a :real` THEN
\r
3066 ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_FIELD` ~( a = &0) ==> ( a * &1 / a ) = &1 `
\r
3067 ; VECTOR_MUL_LID]));;
\r
3070 let AFF2_VEC0 = prove(` aff {vec 0, (w: real^N)} = { x | ? k. x = k % w }`,
\r
3071 REWRITE_TAC[AFF2; FUN_EQ_THM; IN_ELIM_THM] THEN
\r
3072 GEN_TAC THEN EQ_TAC THENL [STRIP_TAC THEN EXISTS_TAC ` &1 - t ` THEN
\r
3073 EVERY_ASSUM MP_TAC THEN SIMP_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID];
\r
3074 STRIP_TAC THEN EXISTS_TAC ` &1 - k ` THEN
\r
3075 ASM_SIMP_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; REAL_ARITH` a - ( a - b ) = b `]]);;
\r
3078 let PERPENCULAR_PART_IDENT0 = prove(`~(w = vec 0) /\ (w dot w) % v1 - (v1 dot w) % w = vec 0
\r
3079 ==> v1 IN aff {vec 0, w}`, PAT_REWRITE_TAC `\x. x /\ _ ==> _ `[GSYM DOT_EQ_0] THEN
\r
3080 REWRITE_TAC[VECTOR_SUB_EQ] THEN NHANH (VECTOR_MUL_R_TO_L) THEN
\r
3081 REWRITE_TAC[AFF2_VEC0; IN_ELIM_THM; VECTOR_MUL_ASSOC] THEN MESON_TAC[]);;
\r
3084 let INSERT_INTER_EMPTY = SET_RULE` {} INTER s = {} /\ (( a INSERT s ) INTER ss = {} <=>
\r
3085 ~( a IN ss ) /\ s INTER ss = {} )`;;
\r
3091 There is a related theorem AZIM_SPECIAL_SCALE already there in
\r
3092 "Multivariate/flyspeck.ml". This only covers scaling of one of the
\r
3093 arguments, but the proof can be generalized to handle all of them;
\r
3094 see the proof script below.
\r
3096 Since the definition of "azim" has multiple quantifier alternations, I
\r
3097 handle things in a more automatic way using the same quantifier
\r
3098 modification conversion PARTIAL_EXPAND_QUANTS_CONV that is used inside
\r
3099 the "without loss of generality" tactics.
\r
3105 let COLLINEAR_SCALE_ALL = prove
\r
3106 (`!a b v w. ~(a = &0) /\ ~(b = &0)
\r
3107 ==> (collinear {vec 0,a % v,b % w} <=> collinear {vec 0,v,w})`,
\r
3108 REPEAT STRIP_TAC THEN ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE] THEN
\r
3109 ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN
\r
3110 ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE]);;
\r
3112 let AZIM_SCALE_ALL = prove
\r
3114 &0 < a /\ &0 < b /\ &0 < c
\r
3115 ==> azim (vec 0) (a % v) (b % w1) (c % w2) = azim (vec 0) v w1 w2`,
\r
3116 let lemma = MESON[REAL_LT_IMP_NZ; REAL_DIV_LMUL]
\r
3117 `!a. &0 < a ==> (!y. ?x. a * x = y)` in
\r
3118 let SCALE_QUANT_TAC side asm avoid =
\r
3119 MP_TAC(MATCH_MP lemma (ASSUME asm)) THEN
\r
3120 DISCH_THEN(MP_TAC o MATCH_MP QUANTIFY_SURJECTION_THM) THEN
\r
3121 DISCH_THEN(CONV_TAC o side o PARTIAL_EXPAND_QUANTS_CONV avoid) in
\r
3122 REPEAT STRIP_TAC THEN
\r
3123 ASM_SIMP_TAC[azim_def; COLLINEAR_SCALE_ALL; REAL_LT_IMP_NZ] THEN
\r
3124 COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_SUB_RZERO] THEN
\r
3125 ASM_SIMP_TAC[DIST_0; NORM_MUL; GSYM VECTOR_MUL_ASSOC] THEN
\r
3126 ASM_SIMP_TAC[REAL_ARITH `&0 < a ==> abs a = a`; VECTOR_MUL_LCANCEL] THEN
\r
3127 ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN
\r
3128 SCALE_QUANT_TAC RAND_CONV `&0 < a` ["psi"; "r1"; "r2"] THEN
\r
3129 SCALE_QUANT_TAC LAND_CONV `&0 < b` ["psi"; "h2"; "r2"] THEN
\r
3130 SCALE_QUANT_TAC LAND_CONV `&0 < c` ["psi"; "h1"; "r1"] THEN
\r
3131 ASM_SIMP_TAC[GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_LDISTRIB;
\r
3132 VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; REAL_LT_MUL_EQ] THEN
\r
3133 REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_AC]);;
\r
3135 let AZIM_SCALE_INV_NORM = prove
\r
3137 ~(w = vec 0) /\ ~(v1 = vec 0) /\ ~(v2 = vec 0)
\r
3138 ==> azim (vec 0) w v1 v2 =
\r
3139 azim (vec 0) (&1 / norm w % w) (&1 / norm v1 % v1)
\r
3140 (&1 / norm v2 % v2)`,
\r
3141 REWRITE_TAC[real_div; REAL_MUL_LID] THEN
\r
3142 SIMP_TAC[REAL_LT_INV_EQ; NORM_POS_LT; AZIM_SCALE_ALL]);;
\r
3148 let ARCV_VEC0_ABS = prove(` ~(ku = &0) /\ ~( kv = &0 ) ==> arcV (vec 0) (u: real^N) v =
\r
3149 arcV (vec 0) ( abs ku % u ) (abs kv % v)`, STRIP_TAC THEN
\r
3150 ABBREV_TAC ` ahah = arcV (vec 0) (abs ku % (u: real^N)) (abs kv % v) ` THEN
\r
3151 FIRST_X_ASSUM (fun x -> ONCE_REWRITE_TAC[MATCH_MP WHEN_K_DIFF0_ARCV x]) THEN
\r
3152 ONCE_REWRITE_TAC[ARC_SYM] THEN FIRST_X_ASSUM (fun x -> ONCE_REWRITE_TAC[MATCH_MP WHEN_K_DIFF0_ARCV x])
\r
3153 THEN EXPAND_TAC "ahah" THEN SIMP_TAC[ARC_SYM]);;
\r
3155 let WHEN_A_B_POS_ARCV_STABLE = MESON[ARC_SYM; WHEN_K_POS_ARCV_STABLE]
\r
3156 ` ! a b (x: real^N) y. &0 < a /\ &0 < b ==> arcV ( vec 0 ) x y = arcV ( vec 0 ) ( a % x ) ( b % y ) `;;
\r
3158 let THREE_POS_IMP_DIHV_STABLE = prove(`!x y z.
\r
3159 &0 < a /\ &0 < b /\ &0 < c
\r
3160 ==> dihV (vec 0) x y z = dihV (vec 0) (a % x) (b % y) (c % z)`,
\r
3161 REWRITE_TAC[DIHV_FORMULAR; VECTOR_SUB_RZERO] THEN
\r
3162 REWRITE_TAC[DOT_LMUL; DOT_RMUL; VECTOR_MUL_ASSOC] THEN
\r
3163 REWRITE_TAC[REAL_ARITH` ((a * a * xx) * b) = ( a pow 2 * b ) * xx `;
\r
3164 REAL_ARITH` (b * a * c) * a = ( a pow 2 * b ) * c `] THEN
\r
3165 ONCE_REWRITE_TAC[GSYM VECTOR_MUL_ASSOC] THEN
\r
3166 REWRITE_TAC[REAL_ARITH` ((a * a * xx) * b) = ( a pow 2 * b ) * xx `;
\r
3167 REAL_ARITH` (b * a * c) * a = ( a pow 2 * b ) * c `; GSYM VECTOR_SUB_LDISTRIB] THEN
\r
3168 REPEAT STRIP_TAC THEN MATCH_MP_TAC WHEN_A_B_POS_ARCV_STABLE THEN
\r
3169 CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_MUL THEN
\r
3170 ASM_SIMP_TAC[POW_2; REAL_LT_MUL];MATCH_MP_TAC REAL_LT_MUL THEN
\r
3171 ASM_SIMP_TAC[POW_2; REAL_LT_MUL]]);;
\r
3174 let VECTOR_OF_DIHV_ORTHONORMAL = prove(` ((w dot w) % (v1: real^N) - (v1 dot w) % w ) dot w = &0 `,
\r
3175 REWRITE_TAC[DOT_LSUB; DOT_LMUL] THEN REAL_ARITH_TAC);;
\r
3177 let ORTHOGORNAL_UNITIZE = prove(` ! x (y:real^N). x dot y = &0 ==> ( &1 / norm x % x ) dot ( &1 / norm y % y ) = &0 `,
\r
3178 REWRITE_TAC[DOT_LMUL; DOT_RMUL] THEN SIMP_TAC[REAL_MUL_RZERO]);;
\r
3180 let NOT_MUL_EQ0_EQ = MESON[REAL_ENTIRE]`!x y. ~( x * y = &0 ) <=> ~( x = &0 ) /\ ~( y = &0) `;;
\r
3182 let UNITS_NOT_EQ_0 = MESON[NOT_MUL_EQ0_EQ; REAL_ARITH` ~( &1 = &0 )`]`! x y. x * y = &1 ==> ~( x = &0 ) /\ ~( y = &0) `;;
\r
3184 let REAL_MUL_LRINV =
\r
3185 let t1 = UNDISCH (SPEC_ALL REAL_MUL_LINV) in
\r
3186 let t2 = UNDISCH (SPEC_ALL REAL_MUL_RINV) in
\r
3187 let t3 = CONJ t1 t2 in DISCH ` ~( x = &0 ) ` t3;;
\r
3189 let NOT_EQ0_IMP_NEITHER_INVERT = prove(` ~( a = &0 ) ==> ~( &1 / a = &0 ) `,
\r
3190 REWRITE_TAC[NOT_0_INVERTABLE; REAL_FIELD` &1 / ( &1 / a ) = a `] THEN SIMP_TAC[REAL_MUL_SYM]);;
\r
3193 let PROJECTOR_NOT_EQ_VEC0 = prove(`! w v1. ~( (w:real^N) = vec 0 ) /\ ~(v1 IN aff {vec 0, w}) <=>
\r
3194 ~( (w dot w) % v1 - (v1 dot w) % w = vec 0 ) `, REPEAT GEN_TAC THEN
\r
3195 EQ_TAC THENL [REWRITE_TAC[GSYM DE_MORGAN_THM; CONTRAPOS_THM] THEN
\r
3196 ASM_CASES_TAC ` (w:real^N) = vec 0 ` THENL [ASM_SIMP_TAC[];
\r
3197 ASM_SIMP_TAC[PERPENCULAR_PART_IDENT0]];
\r
3198 ASM_CASES_TAC ` (w:real^N) = vec 0 ` THENL [
\r
3199 ASM_SIMP_TAC[DOT_RZERO; VECTOR_MUL_LZERO; VECTOR_SUB_RZERO];
\r
3200 ASM_SIMP_TAC[CONTRAPOS_THM; AFF2_VEC0; IN_ELIM_THM]] THEN STRIP_TAC THEN
\r
3201 ASM_SIMP_TAC[VECTOR_MUL_ASSOC; DOT_LMUL; REAL_MUL_SYM; VECTOR_SUB_REFL]]);;
\r
3203 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
3204 REPEAT STRIP_TAC THEN EQ_TAC THENL [REWRITE_TAC[AFF2_VEC0; IN_ELIM_THM; COLLINEAR_LEMMA] THEN
\r
3205 MESON_TAC[]; REWRITE_TAC[AFF2_VEC0; IN_ELIM_THM; COLLINEAR_LEMMA] THEN
\r
3206 STRIP_TAC THENL [ASM_MESON_TAC[]; EXISTS_TAC `&0 ` THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO];
\r
3207 ASM_MESON_TAC[]]]);;
\r
3210 let NOT_EQ_IMP_EXISTS_BASIC = prove(`! v (w:real^3). ~( v = w ) ==>
\r
3211 (? e1 e2 e3. orthonormal e1 e2 e3 /\ dist (w,v) % e3 = w - v)`,
\r
3212 REPEAT STRIP_TAC THEN
\r
3213 CHOOSE_TAC (SPEC `w - (v:real^3)` EXISTS_UNIT_OTHOR_VECTOR) THEN
\r
3214 DOWN_TAC THEN ONCE_REWRITE_TAC[MESON[]` ~( a = b ) <=> ~ (b = a )`]
\r
3215 THEN PAT_ONCE_REWRITE_TAC`\ x. x ==> y ` [GSYM VECTOR_SUB_EQ] THEN
\r
3216 REWRITE_TAC[NOT_VEC0_UNITABLE] THEN
\r
3217 ABBREV_TAC` e1 = &1 / norm ( w - v ) % ( w - (v:real^3))`
\r
3218 THEN REWRITE_TAC[DOT_LNEG; REAL_NEG_EQ_0] THEN
\r
3219 NHANH (MESON[REAL_MUL_RZERO] ` a = &0 ==>
\r
3220 (&1 / norm ( w - (v:real^3))) * a = &0 `) THEN
\r
3221 ASM_REWRITE_TAC[GSYM DOT_LMUL] THEN
\r
3222 MATCH_MP_TAC (MESON[]` ( a /\ b /\ d ==> e ) ==> a /\ b
\r
3223 /\ c /\ d ==> e `) THEN
\r
3224 NHANH TWO_UNIT_ORTH_VECTORS_IMP_ORTHONORMAL THEN
\r
3225 STRIP_TAC THEN EXISTS_TAC` e2:real^3` THEN
\r
3226 EXISTS_TAC` v' : real^3` THEN EXISTS_TAC` e1: real^3` THEN
\r
3227 FIRST_X_ASSUM MP_TAC THEN SIMP_TAC[ORTHONORMAL_PERMUTE] THEN
\r
3228 STRIP_TAC THEN UNDISCH_TAC ` norm (e1:real^3) = &1 ` THEN
\r
3229 EXPAND_TAC "e1" THEN
\r
3230 REWRITE_TAC[GSYM NOT_VEC0_UNITABLE; GSYM NORM_EQ_0;
\r
3231 VECTOR_MUL_ASSOC; dist] THEN
\r
3232 SIMP_TAC[REAL_FIELD`~ ( a = &0 ) ==> ( a * &1 / a ) = &1 `;
\r
3233 VECTOR_MUL_LID]);;
\r
3236 (* =========================================== *)
\r
3237 (* =========================================== *)
\r
3238 let YVREJIS = prove(`! (v: real^3) w w1 w2.
\r
3239 cyclic_set {w1, w2} v w
\r
3240 ==> (azim v w w1 w2 = &0 ==> azim v w w1 w2 + azim v w w2 w1 = &0) /\
\r
3241 (~(azim v w w1 w2 = &0)
\r
3242 ==> azim v w w1 w2 + azim v w w2 w1 = &2 * pi)`,
\r
3243 REWRITE_TAC[cyclic_set] THEN
\r
3244 NHANH NOT_EQ_IMP_EXISTS_BASIC THEN
\r
3245 REPEAT GEN_TAC THEN STRIP_TAC THEN
\r
3246 ASSUME_TAC (SPECL[`v:real^3`;` w:real^3`] azim ) THEN
\r
3247 ASM_REWRITE_TAC[] THEN FIRST_ASSUM (ASSUME_TAC o SPEC_ALL) THEN
\r
3248 FIRST_X_ASSUM MP_TAC THEN STRIP_TAC THEN
\r
3249 UNDISCH_TAC `~(v = w:real^3)` THEN
\r
3250 UNDISCH_TAC `dist (w,v) % e3 = w - (v:real^3)` THEN
\r
3251 UNDISCH_TAC `orthonormal e1 e2 e3` THEN PHA THEN
\r
3252 ONCE_REWRITE_TAC[MESON[]`~(a = b ) <=> ~( b = a )`] THEN
\r
3253 FIRST_ASSUM NHANH THEN FIRST_X_ASSUM MP_TAC THEN
\r
3254 FIRST_X_ASSUM (ASSUME_TAC o (SPECL[`w2:real^3`;` w1:real^3`])) THEN
\r
3255 REPEAT (FIRST_X_ASSUM (CONJUNCTS_THEN ASSUME_TAC)) THEN
\r
3256 REPEAT (FIRST_X_ASSUM CHOOSE_TAC) THEN
\r
3257 FIRST_ASSUM (NHANH_PAT `\x. _ ==> x `) THEN
\r
3258 STRIP_TAC THEN STRIP_TAC THEN UNDISCH_TAC `w1 - v =
\r
3259 (r2 * cos (psi + azim v w w2 w1)) % e1 +
\r
3260 (r2 * sin (psi + azim v w w2 w1)) % e2 +
\r
3261 h2' % (w - v)` THEN
\r
3262 UNDISCH_TAC `w1 - (v: real^3) = (r1' * cos psi') % e1 +
\r
3263 (r1' * sin psi') % e2 + h1 % (w - v)` THEN
\r
3264 USE_FIRST ` dist (w,v) % e3 = w - (v:real^3)` (SUBST1_TAC o SYM) THEN
\r
3265 UNDISCH_TAC `orthonormal e1 e2 (e3: real^3)` THEN PHA THEN
\r
3266 REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
\r
3267 NHANH (MESON[th]` orthonormal e1 e2 e3 /\ x = a1 % e1 + a2 % e2 + a3 % e3 /\
\r
3268 x = aa1 %e1 + aa2 % e2 + aa3 % e3 ==> a1 = aa1 /\ a2 = aa2 /\ a3 = aa3 `) THEN
\r
3270 UNDISCH_TAC` w2 - (v: real^3) = (r1 * cos psi) % e1 + (r1 * sin psi) % e2 + h1' % (w - v)` THEN
\r
3271 UNDISCH_TAC` w2 - v =
\r
3272 (r2' * cos (psi' + azim v w w1 w2)) % e1 +
\r
3273 (r2' * sin (psi' + azim v w w1 w2)) % e2 + h2 % (w - v)` THEN
\r
3274 UNDISCH_TAC `orthonormal e1 e2 (e3: real^3)` THEN
\r
3275 USE_FIRST ` dist (w,v) % e3 = w - (v:real^3)` (SUBST1_TAC o SYM) THEN
\r
3276 REWRITE_TAC[VECTOR_MUL_ASSOC] THEN PHA THEN
\r
3277 NHANH (MESON[th]` orthonormal e1 e2 e3 /\ x = a1 % e1 + a2 % e2 + a3 % e3 /\
\r
3278 x = aa1 %e1 + aa2 % e2 + aa3 % e3 ==> a1 = aa1 /\ a2 = aa2 /\ a3 = aa3 `) THEN STRIP_TAC THEN
\r
3279 UNDISCH_TAC`{w1, w2} INTER affine hull {(v: real^3), w} = {}` THEN
\r
3280 REWRITE_TAC[ GSYM aff; SET_RULE` {a,b} INTER s = {} <=> ~( a IN s ) /\ ~( b IN s ) `] THEN
\r
3281 UNDISCH_TAC `~(w = (v:real^3))` THEN
\r
3282 SIMP_TAC[EQ_SYM_EQ; NOT_EQ_IMP_AFF_AND_COLL3] THEN
\r
3283 STRIP_TAC THEN STRIP_TAC THEN
\r
3284 ASSUME_TAC2 (MESON[]`~collinear {v, w, w2} /\ (~collinear {(v:real^3), w, w2} ==> &0 < r1) ==>
\r
3286 ASSUME_TAC2 (MESON[]`~collinear {v, w, w2} /\ (~collinear {(v:real^3), w, w2} ==> &0 < r2') ==>
\r
3288 ASSUME_TAC2 (MESON[]`~collinear {v, w, w1} /\ (~collinear {(v:real^3), w, w1} ==> &0 < r1') ==>
\r
3290 ASSUME_TAC2 (MESON[]`~collinear {v, w, w1} /\ (~collinear {(v:real^3), w, w1} ==> &0 < r2) ==>
\r
3292 UNDISCH_TAC` r2' * sin (psi' + azim (v: real^3) w w1 w2) = r1 * sin psi` THEN
\r
3293 UNDISCH_TAC`r2' * cos (psi' + azim v w w1 w2) = r1 * cos psi` THEN
\r
3294 UNDISCH_TAC`&0 < r1` THEN UNDISCH_TAC`&0 < r2'` THEN PHA THEN
\r
3295 NHANH R_POS_SIN_COS_IDENT THEN
\r
3296 REWRITE_TAC[SIN_COS_IDEN_IFF_DIFFER_PERS ] THEN STRIP_TAC THEN
\r
3297 UNDISCH_TAC` r1' * sin psi' = r2 * sin (psi + azim v w w2 w1)` THEN
\r
3298 UNDISCH_TAC` r1' * cos psi' = r2 * cos (psi + azim v w w2 w1)` THEN
\r
3299 UNDISCH_TAC` &0 < r2 ` THEN UNDISCH_TAC` &0 < r1' ` THEN
\r
3300 PHA THEN NHANH R_POS_SIN_COS_IDENT THEN
\r
3301 REWRITE_TAC[SIN_COS_IDEN_IFF_DIFFER_PERS ] THEN STRIP_TAC THEN
\r
3302 CHOOSE_TAC (SPEC` psi: real` MOVE_TO_UNIT_INTERVAL ) THEN
\r
3303 CHOOSE_TAC (SPEC` psi': real` MOVE_TO_UNIT_INTERVAL ) THEN
\r
3304 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
3305 azim v w w1 w2 = ( psi + real_of_int n * &2 * pi) - ( psi' + real_of_int n' * &2 * pi)
\r
3306 + (real_of_int k + real_of_int n' - real_of_int n )* &2 * pi `)) THEN
\r
3307 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
3308 azim v w w2 w1 = (psi' + real_of_int n' * &2 * pi) - (psi + real_of_int n * &2 * pi)
\r
3309 + (real_of_int n - real_of_int k' - real_of_int n') * &2 * pi `)) THEN
\r
3310 ABBREV_TAC ` ppsssi = psi + real_of_int n * &2 * pi ` THEN
\r
3311 ABBREV_TAC ` ppsssi1 = psi' + real_of_int n' * &2 * pi ` THEN
\r
3312 REPEAT (FIRST_X_ASSUM (CONJUNCTS_THEN ASSUME_TAC)) THEN
\r
3313 ASSUME_TAC2 (SPECL [` azim v w w1 w2 `;` k + n' - (n: int) `] (GEN `aa: real` BODE_YEU_ANH_DI)) THEN
\r
3314 REWRITE_TAC[MESON[]` a = b ==> b + c = &0 <=> a = b ==> a + c = &0`] THEN
\r
3315 FIRST_X_ASSUM SUBST1_TAC THEN
\r
3316 UNDISCH_TAC `azim v w w2 w1 = ppsssi1 - ppsssi + real_of_int (n - k' - n') * &2 * pi` THEN
\r
3317 UNDISCH_TAC `azim v w w1 w2 = ppsssi - ppsssi1 + real_of_int (k + n' - n) * &2 * pi` THEN
\r
3318 UNDISCH_TAC` azim v w w2 w1 < &2 * pi ` THEN
\r
3319 UNDISCH_TAC` &0 <= azim v w w2 w1 ` THEN UNDISCH_TAC` azim v w w1 w2 < &2 * pi ` THEN
\r
3320 UNDISCH_TAC` &0 <= azim v w w1 w2 ` THEN UNDISCH_TAC` ppsssi1 < &2 * pi ` THEN
\r
3321 UNDISCH_TAC`&0 <= ppsssi1 ` THEN UNDISCH_TAC` ppsssi < &2 * pi ` THEN
\r
3322 UNDISCH_TAC`&0 <= ppsssi ` THEN PHA THEN
\r
3323 REWRITE_TAC[REWRITE_RULE[REAL_ARITH` &2 * a * b = b * &2 * a `] PDPFQUK]);;
\r
3326 let QQZKTXU = prove(`! v w v1 (v2:real^3). let gammma = dihV v w v1 v2 in {v1,v2} INTER aff {v,w} = {} /\
\r
3327 ~( v = w ) ==> cos ( azim v w v1 v2 ) = cos gammma `,
\r
3328 GEOM_ORIGIN_TAC `v:real^3` THEN
\r
3329 ONCE_REWRITE_TAC[SET_RULE`{a} = {a,a}`] THEN
\r
3330 REWRITE_TAC[IMAGE_INTER_AFF3] THEN
\r
3331 REWRITE_TAC[IMAGE_CLAUSES] THEN
\r
3332 REWRITE_TAC[IMAGE_CLAUSES; IMAGE_EQ_EMPTY; INSERT_INSERT] THEN
\r
3333 ONCE_REWRITE_TAC[SPEC ` -- v:real^N` (GSYM DIHV_TRASABLE)] THEN
\r
3334 REWRITE_TAC[VECTOR_ARITH` -- a + a + b = (b:real^N)`] THEN
\r
3335 REPEAT STRIP_TAC THEN
\r
3337 MP_TAC (SPECL [`(vec 0): real^3`;`w:real^3`; `v1:real^3`;`v2:real^3`] azim) THEN
\r
3338 REPEAT STRIP_TAC THEN
\r
3339 EXPAND_TAC "gammma" THEN
\r
3340 REWRITE_TAC[DIHV_FORMULAR; VECTOR_SUB_RZERO] THEN
\r
3341 REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN PHA THEN
\r
3342 REWRITE_TAC[INSERT_INTER_EMPTY] THEN
\r
3343 DAO THEN NGOAC THEN
\r
3344 ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
\r
3345 NHANH (MATCH_MP (MESON[]`(a /\ b ==> c) ==> ( a /\ ~ c ==> ~ b ) `)
\r
3346 PERPENCULAR_PART_IDENT0) THEN
\r
3347 NHANH (MATCH_MP (MESON[]` a dot b = &0 ==> ~( a = vec 0) ==> a dot b = &0`)
\r
3348 VECTOR_OF_DIHV_ORTHONORMAL) THEN
\r
3349 NHANH ORTHOGORNAL_UNITIZE THEN
\r
3350 REWRITE_TAC[NOT_VEC0_UNITABLE] THEN
\r
3351 ABBREV_TAC `e11 = &1 / norm ((w dot w) % v1 - (v1 dot w) % w) %
\r
3352 ((w dot w) % v1 - (v1 dot w) % (w: real^3))` THEN
\r
3353 ABBREV_TAC ` e33 = &1 / norm w % (w:real^3)` THEN
\r
3355 UNDISCH_TAC `e11 dot (e33: real^3) = &0` THEN
\r
3356 UNDISCH_TAC` norm ( e33: real^3) = &1 ` THEN
\r
3357 UNDISCH_TAC` norm ( e11: real^3) = &1 ` THEN
\r
3359 NHANH TWO_UNIT_ORTH_VECTORS_IMP_ORTHONORMAL THEN
\r
3360 EXPAND_TAC "e33" THEN
\r
3361 REWRITE_TAC[GSYM NOT_VEC0_UNITABLE] THEN
\r
3362 REWRITE_TAC[GSYM NOT_VEC0_UNITABLE; GSYM NORM_POS_LT] THEN
\r
3363 NHANH REAL_LT_IMP_NZ THEN
\r
3364 NHANH NOT_EQ0_IMP_NEITHER_INVERT THEN
\r
3365 ASM_REWRITE_TAC[] THEN
\r
3367 UNDISCH_TAC ` &1 / norm w % w = (e33:real^3)` THEN
\r
3368 UNDISCH_TAC ` ~(&1 / norm (w:real^3) = &0)` THEN
\r
3369 PHA THEN NHANH VECTOR_MUL_R_TO_L THEN
\r
3370 REWRITE_TAC[REAL_FIELD` &1 / ( &1 / a ) = a `; GSYM DIST_0] THEN
\r
3371 SUBST_ALL_TAC (MESON[NORM_POS_LT]` &0 < norm (w:real^3) <=> ~(w = vec 0)`) THEN
\r
3372 SIMP_TAC[DIST_SYM] THEN
\r
3373 REWRITE_TAC[VECTOR_ARITH` a = b % x <=> b % x = a - vec 0 `] THEN
\r
3375 UNDISCH_TAC `~((w:real^3) = vec 0)` THEN
\r
3376 FIRST_X_ASSUM MP_TAC THEN
\r
3377 UNDISCH_TAC ` orthonormal e11 e2 e33 ` THEN
\r
3378 PHA THEN FIRST_X_ASSUM NHANH THEN
\r
3380 UNDISCH_TAC ` ~(v1 IN aff {vec 0, (w:real^3)})` THEN
\r
3381 UNDISCH_TAC ` ~((w:real^3) = vec 0)` THEN
\r
3382 UNDISCH_TAC `~(v2 IN aff {vec 0, (w:real^3)})` THEN
\r
3383 ONCE_REWRITE_TAC[MESON[]` ~( a = b ) <=> ~( a = b ) /\ ~( a = b )`] THEN
\r
3385 ONCE_REWRITE_TAC[TAUT` a /\ b/\ c/\ d <=> b /\ ( b /\ a ) /\c /\ d `] THEN
\r
3386 REWRITE_TAC[PROJECTOR_NOT_EQ_VEC0 ] THEN
\r
3387 REWRITE_TAC[VECTOR_ADD_RID; VECTOR_ARITH` ( a + b ) - a = (b:real^N)`] THEN
\r
3388 SIMP_TAC[NOT_EQ_IMPCOS_ARC; VECTOR_SUB_RZERO] THEN DOWN_TAC THEN
\r
3389 REWRITE_TAC[NOT_EQ_IMPCOS_ARC; VECTOR_SUB_RZERO] THEN
\r
3390 ABBREV_TAC ` azz = azim (vec 0) w v1 v2 ` THEN STRIP_TAC THEN
\r
3392 (r2 * cos (psi + azz)) % e11 + (r2 * sin (psi + azz)) % e2 + h2 % (w:real^3)` SUBST1_TAC THEN
\r
3393 USE_FIRST `v1 = (r1 * cos psi) % e11 + (r1 * sin psi) % e2 + h1 % (w:real^3)` SUBST1_TAC THEN
\r
3394 UNDISCH_TAC ` orthonormal e11 e2 e33 ` THEN
\r
3395 SIMP_TAC[DOT_LADD; DOT_LMUL; orthonormal] THEN
\r
3396 ABBREV_TAC ` ww = w dot (w:real^3)` THEN
\r
3397 EXPAND_TAC "w" THEN
\r
3398 SIMP_TAC[DOT_SYM; DOT_RMUL; REAL_MUL_RZERO; REAL_ADD_LID; VECTOR_ADD_LDISTRIB] THEN
\r
3399 SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_SYM; VECTOR_ARITH`(a + c + b ) - b = (a:real^N) + c`] THEN
\r
3400 SIMP_TAC[vector_norm; DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL; REAL_MUL_RZERO; DOT_SYM;
\r
3401 REAL_ADD_RID; REAL_MUL_RID; REAL_ADD_LID; GSYM POW_2; REAL_ARITH`( a * b * c ) pow 2 + ( a * b
\r
3402 * d ) pow 2 = ( a * b ) pow 2 * ( d pow 2 + c pow 2 ) `; SIN_CIRCLE] THEN
\r
3403 STRIP_TAC THEN UNDISCH_TAC `~(ww % (v2: real^3) - (v2 dot w) % w = vec 0)` THEN
\r
3404 UNDISCH_TAC `~(ww % (v1: real^3) - (v1 dot w) % w = vec 0)` THEN
\r
3405 EXPAND_TAC "ww" THEN REWRITE_TAC[GSYM PROJECTOR_NOT_EQ_VEC0] THEN
\r
3406 NHANH (MATCH_MP (MESON[]` (a ==> ( b <=> c )) ==> (a /\ ~ b ==> ~ c) `) (SPEC_ALL NOT_EQ_VEC0_IMP_EQU_AFF_COLL)) THEN
\r
3407 FIRST_X_ASSUM NHANH THEN FIRST_X_ASSUM NHANH THEN
\r
3408 REWRITE_TAC[GSYM DOT_POS_LT] THEN STRIP_TAC THEN STRIP_TAC THEN
\r
3409 ASSUME_TAC2 (SPECL [`(w:real^3) dot w `;` r1: real `] REAL_LT_MUL) THEN
\r
3410 ASSUME_TAC2 (SPECL [`(w:real^3) dot w `;` r2: real `] REAL_LT_MUL) THEN
\r
3411 REPLICATE_TAC 2 (FIRST_X_ASSUM MP_TAC) THEN
\r
3412 NHANH REAL_LT_IMP_LE THEN PHA THEN SIMP_TAC[POW_2_SQRT] THEN
\r
3413 REWRITE_TAC[REAL_ARITH` ((w dot w) * r1 * a) * (w dot w) * r2 * b +
\r
3414 ((w dot w) * r1 * c) * (w dot w) * r2 * d =
\r
3415 (((w dot w) * r1) * (w dot w) * r2) * (b * a + d * c) `] THEN
\r
3416 SIMP_TAC[REAL_FIELD` &0 < a /\ &0 < b ==> (( a * b ) * c ) / ( a * b ) = c `] THEN
\r
3417 REWRITE_TAC[GSYM COS_SUB; REAL_ARITH` (a + b ) - a = b`]);;
\r
3421 ("SIMPLIZE_COS_IF_OTHOR ",
\r
3425 p - v0 = k % (v1 - v0) /\
\r
3426 (w - p) dot (v1 - v0) = &0
\r
3427 ==> cos (arcV v0 v1 w) = k * norm (v1 - v0) / norm (w - v0))]
\r
3429 (* Lemma $100 promised with John *)
\r
3430 (* ============================= *)
\r
3431 (* ============================= *)
\r
3433 let real_itv = new_definition ` real_itv a b = { x | a <= x /\ x < b } `;;
\r
3434 let tri_itv = new_definition ` tri_itv x <=> ( x IN real_itv ( &0 ) ( &2 * pi )) `;;
\r
3437 parse_as_infix("regular_lt",(12,"right"));;
\r
3439 let regular_lt = new_definition
\r
3440 ` (a:real) regular_lt (b:real) <=> a < b /\ a = &0 `;;
\r
3444 parse_as_infix("polar_lt",(12,"right"));;
\r
3447 let polar_lt = new_definition
\r
3448 `(a: real^2) polar_lt (b: real^2) <=>
\r
3452 a = vector [ra * cos aa; ra * sin aa] /\
\r
3453 b = vector [rb * cos ab; rb * sin ab] /\
\r
3456 ==> aa < ab \/ aa = ab /\ ra < rb) `;;
\r
3459 parse_as_infix("polar_le",(12,"right"));;
\r
3461 let polar_le = new_definition
\r
3462 ` a polar_le b <=> a polar_lt b \/ a = b `;;
\r
3465 parse_as_infix("polar_cycle_on",(12,"right"));;
\r
3467 let polar_cycle_on = new_definition
\r
3468 ` f polar_cycle_on (W: real^2 -> bool ) <=>
\r
3469 (!x. x IN W ==> f x IN W) /\
\r
3471 ==> x polar_lt f x /\
\r
3472 (!y. y IN W ==> ~(x polar_lt y /\ y polar_lt f x)) \/
\r
3473 (!y. y IN W ==> f x polar_le y /\ y polar_le x)) `;;
\r
3475 let pl_angle = new_definition` pl_angle (x: real^2) =
\r
3476 (@ u. tri_itv u /\ ( ?t. &0 < t /\ x =
\r
3477 vector [ t * cos u; t * sin u ])) `;;
\r
3479 let arg_diff = new_definition ` arg_diff a b =
\r
3480 let dd = pl_angle b - pl_angle a in
\r
3481 if a polar_le b then dd else dd + &2 * pi `;;
\r
3483 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
3484 ( x$2 / ( sqrt (x$1 * x$1 + x$2 * x$2))) pow 2 = &1 `,
\r
3485 REWRITE_TAC[DIV_POW2; GSYM POW_2] THEN
\r
3486 SIMP_TAC[GSYM NORM_EQ_0; vector_norm; DOT_2;GSYM POW_2; SUM_TWO_POW2S; SQRT_EQ_0; SQRT_POW_2]
\r
3487 THEN GEN_TAC THEN CONV_TAC REAL_FIELD);;
\r
3490 let PRE_TRIG_FORM_VEC2 = prove(`!(x: real^2). ~(x = vec 0)
\r
3491 ==> (?u. tri_itv u /\ x = vector [( norm x ) * cos u ; ( norm x ) * sin u])`,
\r
3492 NHANH VEC2_PRE_TRIG_FORM THEN
\r
3493 REWRITE_TAC[GSYM NORM_POS_LT; vector_norm; DOT_2] THEN
\r
3494 NHANH SUM_POW2_EQ1_UNIQUE_TRIG THEN
\r
3495 REWRITE_TAC[EXISTS_UNIQUE] THEN
\r
3496 GEN_TAC THEN STRIP_TAC THEN
\r
3497 EXISTS_TAC `x': real` THEN
\r
3498 SIMP_TAC[vector_norm; DOT_2;GSYM POW_2] THEN
\r
3499 ASM_REWRITE_TAC[] THEN
\r
3500 UNDISCH_TAC ` &0 < sqrt ((x:real^2)$1 * x$1 + x$2 * x$2)` THEN
\r
3501 NHANH REAL_LT_IMP_NZ THEN
\r
3502 SIMP_TAC[REAL_DIV_LMUL; POW_2] THEN
\r
3503 REWRITE_TAC[CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_2; tri_itv; real_itv; IN_ELIM_THM] THEN
\r
3504 ASM_REWRITE_TAC[]);;
\r
3507 let PL_ANGLE_PROPERTY = prove(`!(x: real^2). ~(x = vec 0)
\r
3508 ==> tri_itv (pl_angle x) /\
\r
3509 (? t. &0 < t /\ x = vector [ t * cos (pl_angle x); t * sin ( pl_angle x )])`,
\r
3510 NHANH PRE_TRIG_FORM_VEC2 THEN
\r
3511 PAT_REWRITE_TAC `\x. !y. x ==> _ ` [GSYM NORM_POS_LT; RIGHT_AND_EXISTS_THM] THEN
\r
3512 NHANH (MESON[]`(?u. &0 < norm x /\ L u /\ P u ( norm x )) ==> (?u.
\r
3513 L u /\ (?t. &0 < t /\ P u t ))`) THEN
\r
3514 REWRITE_TAC[pl_angle] THEN MESON_TAC[EXISTS_THM]);;
\r
3516 let POLAR_LT_IMP_NOT_EQ =
\r
3517 prove(` ~( x = vec 0 ) /\ ~((y:real^2) = vec 0 ) ==>
\r
3518 x polar_lt y ==> ~( x = y ) `,
\r
3519 STRIP_TAC THEN REWRITE_TAC[polar_lt] THEN
\r
3520 ONCE_REWRITE_TAC[TAUT` a ==> ~ b <=> b ==> ~ a `] THEN
\r
3521 SIMP_TAC[ NOT_FORALL_THM] THEN
\r
3522 ASSUME_TAC2 (SPEC `y: real^2 ` PRE_TRIG_FORM_VEC2) THEN
\r
3523 FIRST_X_ASSUM CHOOSE_TAC THEN STRIP_TAC THEN
\r
3524 REWRITE_TAC[TAUT` ~ ( a ==> b ) <=> a /\ ~ b `] THEN
\r
3525 EXISTS_TAC `norm (y:real^2)` THEN EXISTS_TAC `u: real` THEN
\r
3526 EXISTS_TAC `norm (y:real^2)` THEN EXISTS_TAC `u:real` THEN
\r
3527 ASM_SIMP_TAC[NORM_POS_LT] THEN DOWN_TAC THEN STRIP_TAC THEN
\r
3528 ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [FIRST_X_ASSUM ACCEPT_TAC;
\r
3529 REWRITE_TAC[REAL_LT_REFL]]);;
\r
3531 let CART2_EQ = prove(` vector [a1; a2] = (vector [b1; b2]): real^2
\r
3532 <=> a1 = b1 /\ a2 = b2 `,
\r
3533 REWRITE_TAC[CART_EQ; DIMINDEX_2; ARITH_RULE` 1 <= x /\ x <= 2 <=>
\r
3534 x = 1 \/ x = 2 `; MESON[]`(! x. x = a \/ x = b ==> P x ) <=>
\r
3535 P a /\ P b `; VECTOR_2]);;
\r
3538 let SE_ASM_TAC = FIRST_X_ASSUM (CONJUNCTS_THEN ASSUME_TAC);;
\r
3539 let SE_ALL_TAC = REPEAT SE_ASM_TAC;;
\r
3542 let POLAR_LT_TRANS = prove(`~( x = vec 0 ) /\
\r
3543 ~ ((y:real^2) = vec 0 ) /\ ~ ( z = vec 0 ) /\
\r
3544 x polar_lt y /\ y polar_lt z ==> x polar_lt z `,
\r
3545 REWRITE_TAC[polar_lt] THEN NHANH PL_ANGLE_PROPERTY THEN
\r
3546 STRIP_TAC THEN DOWN_TAC THEN REWRITE_TAC[polar_lt] THEN
\r
3547 REPEAT STRIP_TAC THEN UNDISCH_TAC` tri_itv ab ` THEN
\r
3548 UNDISCH_TAC` tri_itv ( pl_angle y ) ` THEN
\r
3549 UNDISCH_TAC`(z:real^2) = vector [rb * cos ab; rb * sin ab]` THEN
\r
3550 UNDISCH_TAC`(y:real^2) = vector [t' * cos (pl_angle y); t' * sin (pl_angle y)]` THEN
\r
3551 UNDISCH_TAC` &0 < rb ` THEN UNDISCH_TAC` &0 < t' ` THEN
\r
3552 PHA THEN FIRST_X_ASSUM NHANH THEN DISCH_TAC THEN
\r
3553 REPEAT (FIRST_X_ASSUM (CONJUNCTS_THEN ASSUME_TAC)) THEN
\r
3554 UNDISCH_TAC` tri_itv ( pl_angle y ) ` THEN
\r
3555 UNDISCH_TAC `tri_itv aa ` THEN
\r
3556 UNDISCH_TAC`(y:real^2) = vector [t' * cos (pl_angle y); t' * sin (pl_angle y)]` THEN
\r
3557 UNDISCH_TAC`(x:real^2) = vector [ra * cos aa; ra * sin aa]` THEN
\r
3558 UNDISCH_TAC` &0 < t' ` THEN UNDISCH_TAC` &0 < ra ` THEN
\r
3559 PHA THEN FIRST_X_ASSUM NHANH THEN DISCH_TAC THEN SE_ALL_TAC
\r
3560 THEN ASSUME_TAC2 (
\r
3561 REAL_ARITH `(pl_angle y < ab \/ pl_angle y = ab /\ t' < rb ) /\
\r
3562 ( aa < pl_angle y \/ aa = pl_angle y /\ ra < t' ) ==>
\r
3563 aa < ab \/ aa = ab /\ ra < rb `) THEN FIRST_ASSUM ACCEPT_TAC);;
\r
3567 let EXISTS_MAX_ELEMENT = prove
\r
3568 (`!S (lt:A->A->bool).
\r
3569 FINITE S /\ ~(S = {}) /\
\r
3570 (!x y z. lt x y /\ lt y z ==> lt x z) /\
\r
3571 (!x. ~(lt x x)) /\
\r
3572 (!x y. S x /\ S y /\ ~( x = y ) ==> lt x y \/ lt y x )
\r
3573 ==> ?m:A. S m /\ ( ! x. S x ==> lt x m \/ x = m )`,
\r
3574 REPEAT STRIP_TAC THEN
\r
3575 MP_TAC(ISPEC `\x:A y:A. x IN S /\ y IN S /\ lt y x` WF_FINITE) THEN
\r
3576 ASM_SIMP_TAC[FINITE_RESTRICT] THEN
\r
3577 ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
\r
3578 REWRITE_TAC[WF] THEN DISCH_THEN(MP_TAC o SPEC `S:A->bool`) THEN
\r
3582 let NO_V0_IMP_NOT_SELF_POLLAR = MESON[POLAR_LT_IMP_NOT_EQ]
\r
3583 ` ~ ( x = vec 0 ) ==> ~ ( x polar_lt x ) `;;
\r
3585 let SET_TAC = let basicthms =
\r
3586 [NOT_IN_EMPTY; IN_UNIV; IN_UNION; IN_INTER; IN_DIFF; IN_INSERT;
\r
3587 IN_DELETE; IN_REST; IN_INTERS; IN_UNIONS; IN_IMAGE] in
\r
3588 let allthms = basicthms @ map (REWRITE_RULE[IN]) basicthms @
\r
3589 [IN_ELIM_THM; IN] in
\r
3591 TRY(POP_ASSUM_LIST(MP_TAC o end_itlist CONJ)) THEN
\r
3592 REPEAT COND_CASES_TAC THEN
\r
3593 REWRITE_TAC[EXTENSION; SUBSET; PSUBSET; DISJOINT; SING] THEN
\r
3594 REWRITE_TAC allthms in
\r
3597 (if ths = [] then ALL_TAC else MP_TAC(end_itlist CONJ ths)) THEN
\r
3600 (* =========== improved SET_RULE ============= *)
\r
3601 let SET_RULE a = fun x -> prove(x, SET_TAC a );;
\r
3603 let POLAR_CYCLIC_FUN_IMP_ALL_BELONG =
\r
3604 prove(` W p /\ f polar_cycle_on W ==> ! n. ITER n f p IN W `,
\r
3605 REWRITE_TAC[polar_cycle_on] THEN STRIP_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[ITER] THEN
\r
3606 ASM SET_TAC[]; REWRITE_TAC[ITER] THEN ASM SET_TAC[]]);;
\r
3608 let EXISTS_MIN_IN_ORDERED_FINITE_SET =
\r
3609 prove(`!(S: A -> bool) lt.
\r
3611 ~(S = {}) /\ (! x. lt x x ) /\
\r
3612 (!x y z. lt x y /\ lt y z ==> lt x z) /\
\r
3613 (! x y. lt x y /\ lt y x ==> x = y ) /\
\r
3614 (!x y. lt x y \/ lt y x)
\r
3615 ==> (?m. S m /\ (!x. S x ==> lt m x ))`,
\r
3616 REPEAT STRIP_TAC THEN MP_TAC (ISPEC`\(x : A ) ( y: A).
\r
3617 S x /\ S y /\ lt x y /\ ~ ( x = y )` WF_FINITE) THEN
\r
3618 ASM_SIMP_TAC[REWRITE_RULE[IN] FINITE_RESTRICT] THEN
\r
3619 ANTS_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[WF]] THEN
\r
3620 DISCH_THEN (MP_TAC o SPEC `S: A -> bool `) THEN
\r
3621 ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN
\r
3622 EXISTS_TAC `x: A` THEN ASM REWRITE_TAC[] THEN ASM_MESON_TAC[]);;
\r
3625 let EXISTS_MA_OR_FI_SET = BETA_RULE (SPECL[` S : A -> bool `;
\r
3626 `(\x y. (lt: A -> A -> bool) y x ) `] EXISTS_MIN_IN_ORDERED_FINITE_SET);;
\r
3627 (* EXISTS_MA_OR_FI_SET
\r
3631 (!x y z. lt y x /\ lt z y ==> lt z x) /\
\r
3632 (!x y. lt y x /\ lt x y ==> x = y) /\
\r
3633 (!x y. lt y x \/ lt x y)
\r
3634 ==> (?m. S m /\ (!x. S x ==> lt x m)) *)
\r
3637 let tri_itv = let t1 = CONJ tri_itv real_itv in CONJ t1 IN_ELIM_THM;;
\r
3639 let DOWN = FIRST_X_ASSUM MP_TAC;;
\r
3641 let WHILE_POLAR_LT_IMP_ST = prove(` p0 polar_lt p ==>
\r
3642 ~ ( {y | ?N. y = ITER N f p0 /\
\r
3643 (!n. 0 <= n /\ n < N ==> ITER n f p0 polar_lt y) /\
\r
3644 y polar_lt p } = {} )`,
\r
3645 REWRITE_TAC[SET_RULE[]`~( x = {} ) <=> ? y. y IN x `; IN_ELIM_THM] THEN
\r
3646 STRIP_TAC THEN EXISTS_TAC` p0: real^2` THEN EXISTS_TAC `0 ` THEN
\r
3647 ASM_SIMP_TAC[ITER; ARITH_RULE`~( 0 <= a /\ a < 0 )`]);;
\r
3650 let DOT_ITSELF_2 = prove( ` (x:real^2) = vector[ a; b ]
\r
3651 ==> x dot x = a pow 2 + b pow 2 `,
\r
3652 SIMP_TAC[dot; DIMINDEX_2; SUM_2; VECTOR_2] THEN
\r
3653 DISCH_TAC THEN REAL_ARITH_TAC);;
\r
3656 let NORM_VECTOR2_TRIG =
\r
3657 prove(` (x:real^2) = vector [a * cos t ; a * sin t ]
\r
3658 /\ &0 <= a ==> norm x = a `, STRIP_TAC THEN UNDISCH_TAC ` &0 <= a `
\r
3659 THEN SIMP_TAC[NORM_POS_LE; EQ_POW2_COND; NORM_POW_2] THEN
\r
3660 DOWN_TAC THEN NHANH DOT_ITSELF_2 THEN STRIP_TAC THEN
\r
3661 DOWN THEN DOWN THEN PHA THEN SIMP_TAC[] THEN
\r
3662 DISCH_TAC THEN REWRITE_TAC[R_SIN_CIRCLE]);;
\r
3665 let NOT_EQ_IMP_TOTAL_ORDER = prove(
\r
3666 ` ! x y. ~( x = y ) ==> x polar_lt y \/ y polar_lt
\r
3667 x `, REWRITE_TAC[polar_lt] THEN REPEAT STRIP_TAC THEN
\r
3668 ASM_CASES_TAC `(x:real^2) = vec 0 \/ (y:real^2)
\r
3669 = vec 0 ` THENL [ DISJ1_TAC THEN REPEAT GEN_TAC THEN
\r
3670 NHANH REAL_LT_IMP_LE THEN NHANH (
\r
3671 MESON[NORM_VECTOR2_TRIG]`(aaa /\ &0 <= ra) /\
\r
3672 (ac/\ &0 <= rb) /\
\r
3673 (x:real^2) = vector [ra * cos aa; ra * sin aa] /\
\r
3674 (y:real^2) = vector [rb * cos ab; rb * sin ab]/\ gg
\r
3675 ==> norm x = ra /\ norm y = rb `) THEN DOWN THEN
\r
3676 REWRITE_TAC[GSYM NORM_EQ_0] THEN SIMP_TAC[] THEN
\r
3677 MESON_TAC[REAL_ARITH`~( a = &0 /\ &0 < a ) `]; ALL_TAC]
\r
3678 THEN DOWN THEN REWRITE_TAC[DE_MORGAN_THM] THEN
\r
3679 NHANH PRE_TRIG_FORM_VEC2 THEN STRIP_TAC THEN
\r
3680 DOWN_TAC THEN REWRITE_TAC[GSYM polar_lt] THEN
\r
3681 MP_TAC (REAL_ARITH` u < u' \/ u = u' \/ u' < u `) THEN
\r
3682 SPEC_TAC (`u:real`,`u:real`) THEN
\r
3683 SPEC_TAC (`u':real`,`u':real`) THEN
\r
3684 SPEC_TAC (`x:real^2`,`x:real^2`) THEN
\r
3685 SPEC_TAC (`y:real^2`,`y:real^2`) THEN
\r
3687 MESON[]`(! y x u' u. P1 u u' /\ M x y u u' ==>
\r
3688 Q x y ) /\ ((! y x u' u. P1 u u' /\ M x y u u' ==>
\r
3689 Q x y ) ==> (! y x u' u. P1 u' u /\ M x y u u' ==>
\r
3690 Q y x )) /\ (! y x u' u. u = u' /\ M x y u u' ==>
\r
3691 Q x y \/ Q y x) ==> (! y x u' u.
\r
3692 P1 u u' \/ u = u' \/ P1 u' u ==>
\r
3693 M x y u u' ==> Q x y \/ Q y x ) `) THEN CONJ_TAC
\r
3694 THENL [REPEAT STRIP_TAC THEN UNDISCH_TAC ` u < (u':real)`
\r
3695 THEN DISCH_TAC THEN REWRITE_TAC[polar_lt] THEN REPEAT STRIP_TAC THEN DISJ1_TAC THEN
\r
3696 UNDISCH_TAC`(x:real^2) = vector [norm x * cos u; norm x * sin u]` THEN
\r
3697 UNDISCH_TAC` (y:real^2) = vector [norm y * cos u'
\r
3698 ; norm y * sin u' ]` THEN
\r
3699 EVERY_ASSUM (fun x -> PAT_REWRITE_TAC `\v. v = h ==> v = h ==> gg `
\r
3700 [x ]) THEN REWRITE_TAC[CART2_EQ] THEN
\r
3701 REPEAT DISCH_TAC THEN
\r
3702 ASSUME_TAC2 (REAL_ARITH` &0 < ra /\ &0 < rb ==>
\r
3703 &0 <= ra /\ &0 <= rb `) THEN SE_ALL_TAC THEN
\r
3704 UNDISCH_TAC ` &0 <= ra ` THEN UNDISCH_TAC `(x:real^2) = vector
\r
3705 [ra * cos aa; ra * sin aa]` THEN
\r
3706 PHA THEN NHANH NORM_VECTOR2_TRIG THEN STRIP_TAC THEN
\r
3707 FIRST_X_ASSUM SUBST_ALL_TAC THEN UNDISCH_TAC ` &0 <= rb `
\r
3708 THEN UNDISCH_TAC `(y:real^2) = vector
\r
3709 [rb * cos ab; rb * sin ab]` THEN PHA THEN
\r
3710 NHANH NORM_VECTOR2_TRIG THEN STRIP_TAC THEN
\r
3711 FIRST_X_ASSUM SUBST_ALL_TAC THEN
\r
3712 REPLICATE_TAC 8 DOWN THEN PHA THEN
\r
3713 ASM_SIMP_TAC[MESON[REAL_ARITH` &0 < a ==> ~( a = &0 )`; REAL_EQ_MUL_LCANCEL]`
\r
3714 &0 < a ==> ( a * x = a * y <=> x = y ) `] THEN
\r
3715 UNDISCH_TAC` tri_itv aa ` THEN UNDISCH_TAC ` tri_itv u ` THEN
\r
3716 UNDISCH_TAC`tri_itv u'` THEN UNDISCH_TAC` tri_itv ab` THEN
\r
3717 REWRITE_TAC[tri_itv; real_itv; IN_ELIM_THM] THEN
\r
3718 REPEAT STRIP_TAC THEN SUBGOAL_THEN` aa = (u: real) /\ ab = (u': real)` ASSUME_TAC
\r
3719 THENL [ASM_MESON_TAC[IDENT_WHEN_IDENT_SIN_COS];
\r
3720 ASM_REWRITE_TAC[]];
\r
3721 CONJ_TAC THENL [MESON_TAC[]; REPEAT GEN_TAC]] THEN
\r
3722 IMP_TAC THEN DISCH_THEN ( fun x -> REWRITE_TAC[ SYM x ]) THEN
\r
3723 ASM_CASES_TAC ` norm (x:real^2) = norm (y:real^2)`
\r
3724 THENL [ASM_REWRITE_TAC[] THEN MESON_TAC[]; DOWN] THEN
\r
3725 REWRITE_TAC[REAL_ARITH` ~( a = b ) <=> a < b \/
\r
3726 b < a `] THEN SPEC_TAC (`x:real^2`,`x:real^2`) THEN
\r
3727 SPEC_TAC (`y:real^2`,`y:real^2`) THEN
\r
3728 MATCH_MP_TAC (MESON[]`(! x y. P x y /\ R x y ==> Q x y ) /\
\r
3729 ((! x y. P x y /\ R x y ==> Q x y ) ==>
\r
3730 (! x y. P y x /\ R x y ==> Q y x ) ) ==>
\r
3731 (! x y. P x y \/ P y x ==> R x y ==> Q x y \/ Q y x)`) THEN
\r
3733 REPEAT STRIP_TAC THEN REWRITE_TAC[polar_lt] THEN
\r
3734 REPEAT GEN_TAC THEN NHANH_PAT `\x. x ==> h ` REAL_LT_IMP_LE THEN
\r
3735 DISCH_TAC THEN SUBGOAL_THEN `norm (y':real^2) = ra /\
\r
3736 norm (y:real^2) = rb ` ASSUME_TAC THENL [
\r
3737 FIRST_X_ASSUM ( fun x -> MESON_TAC[x; NORM_VECTOR2_TRIG])
\r
3738 ; REPEAT STRIP_TAC] THEN DISJ2_TAC THEN
\r
3739 UNDISCH_TAC `(y': real^2) =
\r
3740 vector [norm y' * cos u; norm y' * sin u]` THEN
\r
3741 UNDISCH_TAC `(y: real^2) =
\r
3742 vector [norm y * cos u; norm y * sin u]` THEN
\r
3743 EVERY_ASSUM (fun x -> PAT_REWRITE_TAC `\x.
\r
3744 x = y ==> x = z ==> l ` [x]) THEN
\r
3745 REWRITE_TAC[CART2_EQ] THEN DOWN_TAC THEN
\r
3746 SIMP_TAC[GSYM NORM_POS_LT] THEN STRIP_TAC THEN
\r
3747 SUBGOAL_THEN ` ab = (u:real) /\ aa = u ` ASSUME_TAC
\r
3748 THENL [REPLICATE_TAC 4 DOWN THEN PHA THEN ASM_REWRITE_TAC[] THEN
\r
3749 ASM_SIMP_TAC[MESON[REAL_EQ_MUL_LCANCEL; REAL_ARITH` &0 < a ==>
\r
3750 ~ ( a = &0 )`]` &0 < a ==> ( a * x = a * y <=> x = y ) `] THEN
\r
3751 UNDISCH_TAC` tri_itv aa ` THEN UNDISCH_TAC ` tri_itv ab ` THEN
\r
3752 UNDISCH_TAC `tri_itv u ` THEN PHA THEN REWRITE_TAC[tri_itv] THEN
\r
3753 MESON_TAC[IDENT_WHEN_IDENT_SIN_COS];
\r
3754 ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]];
\r
3760 let PROVE_XISTS_MAX_ELEMENT_LT_P = prove(
\r
3761 ` ! W:real^2 -> bool. (! x. W x ==> ~ ( x = vec 0 )) /\
\r
3764 f polar_cycle_on W /\
\r
3766 SS = { y | ? N. y = ITER N f p0 /\
\r
3767 ( ! n . 0 <= n /\ n < N ==> ITER n f p0 polar_lt y ) /\
\r
3769 ==> (? mx. mx IN SS /\ ( ! x. SS x ==> x polar_lt mx \/ x = mx)) `,
\r
3770 ONCE_REWRITE_TAC[TAUT`aa /\ a /\ b /\ c /\ d <=> aa /\
\r
3771 a /\ (b /\ c ) /\ d `] THEN
\r
3772 NHANH POLAR_CYCLIC_FUN_IMP_ALL_BELONG THEN REPEAT STRIP_TAC THEN
\r
3773 FIRST_X_ASSUM MP_TAC THEN
\r
3774 SUBGOAL_THEN `(! y n. y = ITER n f p0 ==> W (y:real^2))` ASSUME_TAC
\r
3775 THENL [ASM SET_TAC[]; FIRST_ASSUM NHANH] THEN
\r
3776 REWRITE_TAC[TAUT`( a /\ b) /\ c <=> b /\ a /\ c`; RIGHT_EXISTS_AND_THM] THEN
\r
3777 DOWN_TAC THEN NHANH (REWRITE_RULE[IN; RIGHT_FORALL_IMP_THM] FINITE_RESTRICT) THEN
\r
3778 STRIP_TAC THEN SUBGOAL_THEN ` FINITE (SS: real^2 -> bool) ` ASSUME_TAC THENL
\r
3779 [ASM_MESON_TAC[]; ALL_TAC] THEN
\r
3780 DOWN_TAC THEN REWRITE_TAC[GSYM RIGHT_EXISTS_AND_THM] THEN
\r
3781 PAT_REWRITE_TAC `\x. y /\ x ==> h ` [TAUT` a ==> b <=> a <=>
\r
3783 NHANH (SET_RULE[]` S = {y | ? N. P y /\ Q N y } ==> S SUBSET P `) THEN
\r
3784 ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
\r
3785 REPLICATE_TAC 8 (IMP_TAC THEN STRIP_TAC) THEN NGOAC THEN
\r
3786 ASM_REWRITE_TAC[] THEN PHA THEN
\r
3787 DOWN THEN REWRITE_TAC[TAUT`(b /\ a <=> a) <=> a ==> b `] THEN
\r
3788 ASSUME_TAC2 WHILE_POLAR_LT_IMP_ST THEN
\r
3789 ABBREV_TAC ` lt x y = ( ( W x /\ W y ) /\ x polar_lt (y:real^2)) `
\r
3790 THEN SUBGOAL_THEN `(! x. ~ lt x (x:real^2) )` ASSUME_TAC THENL
\r
3791 [FIRST_X_ASSUM ( fun x -> REWRITE_TAC [ GSYM x;
\r
3792 NO_V0_IMP_NOT_SELF_POLLAR]) THEN REWRITE_TAC[DE_MORGAN_THM]
\r
3793 THEN GEN_TAC THEN ASM_CASES_TAC` (W: real^2 -> bool ) x ` THENL
\r
3794 [DISJ2_TAC THEN ASM MESON_TAC[NO_V0_IMP_NOT_SELF_POLLAR];
\r
3795 ASM_REWRITE_TAC[]];
\r
3796 SUBGOAL_THEN `(!x y z. lt (x:real^2) (y: real^2) /\ lt y z ==> lt x z)` ASSUME_TAC
\r
3797 THEN DOWN] THENL [
\r
3798 FIRST_X_ASSUM (fun x -> REWRITE_TAC[GSYM x ]) THEN
\r
3799 REPLICATE_TAC 5 STRIP_TAC THEN ASM_REWRITE_TAC[POLAR_LT_TRANS]
\r
3800 THEN DOWN_TAC THEN MESON_TAC[POLAR_LT_TRANS];
\r
3801 REWRITE_TAC[TAUT`(a <=> b /\ a ) <=> a ==> b`] THEN
\r
3802 REPEAT STRIP_TAC THEN
\r
3803 UNDISCH_TAC ` ~({y | ?N. y = ITER N f p0 /\
\r
3804 (!n. 0 <= n ==> n < N ==> ITER n f p0 polar_lt y) /\
\r
3806 {})`] THEN REWRITE_TAC[IMP_IMP] THEN DOWN THEN DOWN THEN
\r
3807 FIRST_ASSUM SUBST1_TAC THEN REPEAT STRIP_TAC THEN
\r
3808 SUBGOAL_THEN `(!x y. (SS:real ^2 -> bool) x /\ SS y /\ ~(x = y) ==>
\r
3809 lt x y \/ lt y x)` ASSUME_TAC THENL [
\r
3810 USE_FIRST `!x y. ((W:real^2 -> bool) x /\ W y)
\r
3811 /\ x polar_lt y <=> lt x y` (fun x -> REWRITE_TAC[
\r
3812 GSYM x ]) THEN UNDISCH_TAC` SS SUBSET (W: real^2 -> bool)` THEN
\r
3813 SET_TAC[NOT_EQ_IMP_TOTAL_ORDER];
\r
3814 SUBGOAL_THEN `(?m. (SS:real^2 -> bool) m /\
\r
3815 (!x. SS x ==> lt x m \/ x = m)) ` ASSUME_TAC THENL
\r
3816 [FIRST_X_ASSUM MP_TAC THEN
\r
3817 UNDISCH_TAC` ! (x:real^2). ~ lt x x ` THEN
\r
3818 UNDISCH_TAC ` (!(x:real^2) y z. lt x y /\
\r
3819 lt y z ==> lt x z) ` THEN
\r
3820 UNDISCH_TAC `~ ( (SS: real^2 -> bool ) = {})` THEN
\r
3821 UNDISCH_TAC `FINITE (SS: real^2 -> bool)` THEN
\r
3822 PHA THEN REWRITE_TAC[EXISTS_MAX_ELEMENT];
\r
3823 REWRITE_TAC[IN] THEN FIRST_X_ASSUM CHOOSE_TAC THEN
\r
3824 EXISTS_TAC `m: real^2` THEN ASM SET_TAC[]]]);;
\r
3828 let VEC0_BOTH_LT_GT = prove(`
\r
3829 y = vec 0 ==> x polar_lt y /\ y polar_lt z `,
\r
3830 REWRITE_TAC[polar_lt] THEN DISCH_TAC THEN
\r
3831 SUBGOAL_THEN `(! ry ay. ~ (&0 < ry /\ (y:real^2) =
\r
3832 vector[ ry * cos ay ; ry * sin ay ]))` ( fun x ->
\r
3833 ASM_MESON_TAC[x]) THEN NHANH REAL_LT_IMP_LE THEN
\r
3834 REPEAT STRIP_TAC THEN ASSUME_TAC2 (SPECL [` ay: real `
\r
3835 ;` y: real^2`;` ry: real`] (GEN_ALL NORM_VECTOR2_TRIG))
\r
3836 THEN DOWN_TAC THEN REWRITE_TAC[GSYM NORM_EQ_0] THEN
\r
3837 MESON_TAC[REAL_ARITH` ~( &0 < y /\ y = &0 )`]);;
\r
3841 let POLAR_LT_TRANS = prove(` ~( y = vec 0 ) ==>
\r
3842 x polar_lt y /\ y polar_lt z ==> x polar_lt z `,
\r
3843 MESON_TAC[POLAR_LT_TRANS; VEC0_BOTH_LT_GT]);;
\r
3847 let PROVE_EXISTING_MAX_IN_CYCLIC_FINITE_SET =
\r
3848 prove(` ! (W: real^2 -> bool). FINITE W /\ ~( W = {} ) /\
\r
3849 (! x. W x ==> ~( x = vec 0 )) ==>
\r
3850 ? m. W m /\ (! x. W x ==> x polar_lt m \/ x = m ) `,
\r
3851 REPEAT STRIP_TAC THEN
\r
3852 ABBREV_TAC ` lt x y = ( W x /\ W y /\ x polar_lt y ) ` THEN
\r
3853 SUBGOAL_THEN `! x. ~ lt x (x:real^2) ` ASSUME_TAC THENL [
\r
3854 FIRST_X_ASSUM (fun s -> REWRITE_TAC[GSYM s]) THEN
\r
3855 GEN_TAC THEN REWRITE_TAC[DE_MORGAN_THM] THEN
\r
3856 ASM_CASES_TAC ` (W: real^2 -> bool) (x:real^2)` THENL [
\r
3857 DISJ2_TAC THEN DISJ2_TAC THEN
\r
3858 ASM_MESON_TAC[NO_V0_IMP_NOT_SELF_POLLAR]; ASM_SIMP_TAC[]];
\r
3859 SUBGOAL_THEN `(! x y z. ( lt: real^2 -> real^2 -> bool) x y
\r
3860 /\ lt y z ==> lt x z) /\ (! x y. W x /\ W y /\ ~ ( x = y )
\r
3861 ==> lt x y \/ lt y x ) ` ASSUME_TAC] THENL [
\r
3862 DOWN THEN FIRST_X_ASSUM ( fun x -> REWRITE_TAC[GSYM x])
\r
3863 THEN SIMP_TAC[] THEN
\r
3864 DISCH_TAC THEN CONJ_TAC THENL [FIRST_X_ASSUM NHANH THEN
\r
3865 REPEAT STRIP_TAC THEN ASM_MESON_TAC[POLAR_LT_TRANS];
\r
3866 SIMP_TAC[NOT_EQ_IMP_TOTAL_ORDER]];
\r
3867 MP_TAC (ISPECL[`W:real^2 -> bool `;` lt: real^2 ->
\r
3868 real^2 -> bool `] EXISTS_MAX_ELEMENT) THEN ANTS_TAC THENL
\r
3869 [ASM_REWRITE_TAC[]; USE_FIRST `!x y. (W:real^2 -> bool) x /\ W y /\
\r
3870 x polar_lt y <=> lt x y` (fun x -> REWRITE_TAC[ GSYM x]) THEN
\r
3875 let PROVE_MIN_ELEMENT_IN_FINITE_CYCLIC_SET =
\r
3876 prove(` ! (W: real^2 -> bool). FINITE W /\ ~( W = {}) /\
\r
3877 (! x. W x ==> ~ ( x = vec 0)) ==>
\r
3878 ? n. W n /\ (! x. W x ==> n polar_lt x \/ n = x ) `,
\r
3879 REPEAT STRIP_TAC THEN
\r
3880 MP_TAC (BETA_RULE (ISPECL [`W:real^2 -> bool `;` (\x y. W x /\
\r
3881 W y /\ y polar_lt x ) `] EXISTS_MAX_ELEMENT)) THEN ANTS_TAC
\r
3882 THENL [ASM_MESON_TAC[POLAR_LT_TRANS; NO_V0_IMP_NOT_SELF_POLLAR
\r
3883 ; NOT_EQ_IMP_TOTAL_ORDER]; MESON_TAC[]]);;
\r
3891 let TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT =
\r
3892 prove(` ~((x:real^2) = vec 0 ) /\ ~( y = vec 0 ) ==>
\r
3893 ~( x polar_lt y /\ y polar_lt x ) `,
\r
3894 MESON_TAC[NO_V0_IMP_NOT_SELF_POLLAR; POLAR_LT_TRANS]);;
\r
3899 let EXISTS_STEPS_FOR_FOLLOWING_POINTS = prove(
\r
3900 ` ! W:real^2 -> bool. (! x. W x ==> ~ ( x = vec 0 )) /\
\r
3903 f polar_cycle_on W /\
\r
3904 p0 polar_lt p /\ W p
\r
3905 ==> ? n. ITER n f p0 = p /\ (! nn. nn < n ==> ITER nn f p0
\r
3906 polar_lt p ) `, REPEAT STRIP_TAC THEN
\r
3907 ABBREV_TAC ` SS = { y| ?N. (y:real^2) = ITER N f p0 /\
\r
3908 (! n. 0 <= n /\ n < N ==> ITER n f p0 polar_lt y ) /\
\r
3909 y polar_lt p} ` THEN MP_TAC (SPEC_ALL PROVE_XISTS_MAX_ELEMENT_LT_P)
\r
3910 THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; STRIP_TAC] THEN
\r
3911 UNDISCH_TAC `mx IN (SS: real^2 -> bool)` THEN
\r
3912 EXPAND_TAC "SS" THEN REWRITE_TAC[IN_ELIM_THM] THEN
\r
3913 STRIP_TAC THEN EXISTS_TAC ` N + 1` THEN
\r
3914 REWRITE_TAC[ARITH_RULE` n < b + 1 <=> n < b \/ n = b `;
\r
3915 MESON[]`(! x. P x \/ x = a ==> Q x ) <=> Q a /\ (! x.
\r
3916 P x ==> Q x )`] THEN REPLICATE_TAC 3 DOWN THEN PHA THEN
\r
3917 SIMP_TAC[ARITH_RULE` 0 <= n`] THEN
\r
3918 ASSUME_TAC2 ( SPEC `p0: real^2 ` ( GEN `p: real ^2 `
\r
3919 POLAR_CYCLIC_FUN_IMP_ALL_BELONG)) THEN
\r
3920 ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN SIMP_TAC[] THEN DISCH_TAC
\r
3921 THEN SUBGOAL_THEN `~ (mx:real^2 = vec 0) ` ASSUME_TAC
\r
3922 THENL [ASM SET_TAC[]; CONJ_TAC] THENL [ALL_TAC ;
\r
3923 ASM_MESON_TAC[POLAR_LT_TRANS]] THEN
\r
3924 ASM_CASES_TAC ` p polar_lt ( ITER ( N + 1) f p0 ) \/
\r
3925 p = ITER (N + 1) (f:real^2 -> real^2) p0` THEN
\r
3926 UNDISCH_TAC `f polar_cycle_on W ` THEN REWRITE_TAC[polar_cycle_on]
\r
3927 THEN STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC ` mx:real^2`)
\r
3928 THEN SUBGOAL_THEN ` mx IN (W: real^2 -> bool)` ASSUME_TAC
\r
3929 THENL [ASM_MESON_TAC[];
\r
3930 ANTS_TAC THENL [FIRST_X_ASSUM ACCEPT_TAC; STRIP_TAC] THENL
\r
3931 [FIRST_X_ASSUM DISJ_CASES_TAC THEN DOWN_TAC THEN
\r
3932 REWRITE_TAC[GSYM ADD1; ITER] THEN SET_TAC[];
\r
3933 DOWN_TAC THEN REWRITE_TAC[GSYM ADD1; ITER] THEN
\r
3934 STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN
\r
3935 SUBGOAL_THEN ` ~((p:real^2) = vec 0 ) ` ASSUME_TAC THENL
\r
3936 [ASM_MESON_TAC[]; SUBGOAL_THEN ` mx polar_lt f mx ` ASSUME_TAC]
\r
3937 THENL [ASM_MESON_TAC[POLAR_LT_TRANS];
\r
3938 DOWN_TAC THEN REWRITE_TAC[polar_le] THEN
\r
3939 SET_TAC[TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT;
\r
3940 POLAR_LT_TRANS]]]; ASM_MESON_TAC[];
\r
3941 ANTS_TAC] THENL [FIRST_X_ASSUM ACCEPT_TAC;
\r
3942 DISCH_TAC THEN SE_ALL_TAC THEN
\r
3943 SUBGOAL_THEN ` ITER (N + 1) (f:real^2 -> real^2) p0
\r
3944 polar_lt p ` ASSUME_TAC THENL [
\r
3945 SET_TAC[TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT;
\r
3946 NOT_EQ_IMP_TOTAL_ORDER; IN];
\r
3947 SUBGOAL_THEN ` ITER (N + 1) (f:real^2 -> real^2) p0
\r
3948 IN SS` ASSUME_TAC]] THENL [
\r
3949 SUBGOAL_THEN ` mx polar_lt (f:real^2 -> real^2) mx `
\r
3950 ASSUME_TAC THENL [
\r
3951 FIRST_X_ASSUM DISJ_CASES_TAC THENL [ASM_SIMP_TAC[];
\r
3952 DOWN_TAC] THEN REWRITE_TAC[GSYM ADD1; ITER; polar_le] THEN
\r
3953 SET_TAC[TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT];
\r
3954 EXPAND_TAC "SS" THEN REWRITE_TAC[IN_ELIM_THM] THEN
\r
3955 EXISTS_TAC `N + 1 ` THEN DOWN_TAC THEN REWRITE_TAC[GSYM ADD1; ITER]
\r
3956 THEN STRIP_TAC THEN ASM_REWRITE_TAC[LE_0; LT]] THENL [
\r
3957 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
\r
3958 ASM SET_TAC[POLAR_LT_TRANS]; ASM SET_TAC[POLAR_LT_TRANS]];
\r
3959 SUBGOAL_THEN ` mx polar_lt (f:real^2 -> real^2) mx `
\r
3960 ASSUME_TAC THENL [FIRST_X_ASSUM DISJ_CASES_TAC THENL [ASM_SIMP_TAC[];
\r
3961 DOWN_TAC] THEN REWRITE_TAC[GSYM ADD1; ITER; polar_le] THEN
\r
3962 SET_TAC[TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT];
\r
3963 DOWN_TAC THEN REWRITE_TAC[GSYM ADD1; ITER] THEN
\r
3964 SET_TAC[TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT]]]);;
\r
3968 let CARD_SING = prove(`! (x:A). CARD {x} = 1 `,
\r
3969 MP_TAC CARD_CLAUSES THEN STRIP_TAC THEN
\r
3970 GEN_TAC THEN FIRST_X_ASSUM (ASSUME_TAC o SPECL [` x: A `; ` {} : A -> bool `])
\r
3971 THEN SUBGOAL_THEN `FINITE ({} : A -> bool ) ` MP_TAC THENL
\r
3972 [ REWRITE_TAC[FINITE_EMPTY]; FIRST_X_ASSUM NHANH] THEN
\r
3973 ASM_SIMP_TAC[NOT_IN_EMPTY; ADD1; ADD_CLAUSES]);;
\r
3979 let POLAR_LE_REFL_EQ = prove(` a polar_le b /\ b polar_le a
\r
3980 <=> a = b \/ a = vec 0 \/ b = vec 0 `,
\r
3981 REWRITE_TAC[polar_le] THEN
\r
3982 MESON_TAC[VEC0_BOTH_LT_GT; POLAR_LT_TRANS;
\r
3983 TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT]);;
\r
3986 let CHANGE ne ol = fun x -> SPEC ne ( GEN ol x);;
\r
3989 let POLAR_MONOPOLY_IN_FIRST_ITERVAL =
\r
3990 prove(` (!x. W x ==> ~(x = vec 0)) /\
\r
3993 f polar_cycle_on W /\
\r
3994 (!x. W x ==> p0 polar_le x ) /\
\r
3995 i < CARD W - 1 ==>
\r
3996 ITER i f p0 polar_lt f (ITER i f p0) `,
\r
3997 ABBREV_TAC ` xx = ITER i f (p0: real^2) ` THEN STRIP_TAC
\r
3998 THEN SUBGOAL_THEN ` (xx: real^2) IN W ` ASSUME_TAC THENL [
\r
3999 ASM_MESON_TAC[POLAR_CYCLIC_FUN_IMP_ALL_BELONG];
\r
4000 DOWN THEN USE_FIRST ` f polar_cycle_on W ` MP_TAC] THEN
\r
4001 REWRITE_TAC[polar_cycle_on] THEN STRIP_TAC THEN
\r
4002 FIRST_X_ASSUM NHANH THEN STRIP_TAC THEN
\r
4003 SUBGOAL_THEN ` FINITE {y | ? ii. ii <= i /\ y = ITER ii
\r
4004 f (p0: real^2)} ` ASSUME_TAC THENL [
\r
4005 SPEC_TAC (`i: num`,`i: num `) THEN INDUCT_TAC THENL [
\r
4006 REWRITE_TAC[LE; MESON[]`(?a. a = b /\ P a) <=> P b`; ITER
\r
4007 ; SET_RULE[]` {x| x = a} = {a} `] THEN SIMP_TAC[FINITE_RULES];
\r
4008 REWRITE_TAC[ADD1; ARITH_RULE` a <= c + 1 <=> a <= c \/
\r
4009 a = c + 1 `; SET_RULE[]` {y| ? x. ( P x \/ x = a ) /\ y = Q x } =
\r
4010 Q a INSERT {y | ? x. P x /\ y = Q x } `] THEN
\r
4011 ASM_SIMP_TAC[FINITE_RULES]];
\r
4012 ABBREV_TAC ` SS = {y | ?ii. ii <= i /\ y = ITER ii f (p0:real^2)}
\r
4013 `] THEN SUBGOAL_THEN ` W SUBSET (SS:real^2 -> bool)` ASSUME_TAC
\r
4014 THENL [REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN
\r
4015 ASM_CASES_TAC ` p0 = (x:real^2)` THENL [
\r
4016 EXPAND_TAC "x" THEN EXPAND_TAC "SS" THEN REWRITE_TAC[IN_ELIM_THM]
\r
4017 THEN EXISTS_TAC `0` THEN REWRITE_TAC[LE_0; ITER];
\r
4019 SUBGOAL_THEN`p0 polar_lt x ` ASSUME_TAC THENL [DOWN_TAC
\r
4020 THEN REWRITE_TAC[polar_le] THEN SET_TAC[]; ALL_TAC] THEN
\r
4021 MP_TAC (SPEC_ALL (CHANGE `x: real^2 ` `p:real^2 `
\r
4022 EXISTS_STEPS_FOR_FOLLOWING_POINTS)) THEN ANTS_TAC THENL [
\r
4023 ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM IN] THEN
\r
4024 ASM_SIMP_TAC[]; STRIP_TAC] THEN
\r
4025 ASM_CASES_TAC ` n <= (i:num) ` THENL [EXPAND_TAC "SS"
\r
4026 THEN EXPAND_TAC "x" THEN REWRITE_TAC[IN_ELIM_THM] THEN
\r
4027 EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[]; DOWN] THEN
\r
4028 REWRITE_TAC[ARITH_RULE` ~( s <= h ) <=> (h:num) < s `] THEN
\r
4029 FIRST_ASSUM NHANH THEN
\r
4030 SUBGOAL_THEN ` x polar_le xx ` ASSUME_TAC THENL [
\r
4031 ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN DOWN THEN
\r
4032 REWRITE_TAC[polar_le] THEN
\r
4033 ASM SET_TAC[NO_V0_IMP_NOT_SELF_POLLAR;
\r
4034 TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT]; SUBGOAL_THEN ` CARD (W:real^2 -> bool) <= CARD (SS: real^2
\r
4035 -> bool)` ASSUME_TAC THENL [ASM_MESON_TAC[CARD_SUBSET];
\r
4036 SUBGOAL_THEN ` CARD (SS: real^2 -> bool) <= i + 1 `
\r
4037 ASSUME_TAC]] THENL [UNDISCH_TAC `FINITE (SS:real^2 -> bool)` THEN
\r
4038 EXPAND_TAC "SS" THEN SPEC_TAC (`i:num`,`i:num`) THEN
\r
4039 INDUCT_TAC THENL [REWRITE_TAC[LE; SET_RULE[]` {y| ?x. x = 0 /\ y = P x }
\r
4040 = {P 0}`; ITER; CARD_SING; ADD; LE_REFL];
\r
4041 PAT_REWRITE_TAC `\a. b ==> a <= c ` [ADD1; ARITH_RULE ` a <= b + 1
\r
4042 <=> a <= b \/ a = b + 1 `] THEN PAT_REWRITE_TAC `\x. x ==> h ` [ADD1;
\r
4043 ARITH_RULE ` a <= b + 1 <=> a <= b \/ a = b + 1 `] THEN
\r
4044 REWRITE_TAC[ADD1; SET_RULE[]` {y| ? x. (P x \/ x = a ) /\ y = Q x } =
\r
4045 Q a INSERT {y| ?x. P x /\ y = Q x } `; FINITE_INSERT] THEN
\r
4046 FIRST_X_ASSUM NHANH THEN
\r
4047 NHANH (let [a;b] = CONJUNCTS CARD_CLAUSES in
\r
4048 ISPEC ` ITER (i' + 1) f (p0: real^2) ` b) THEN
\r
4049 COND_CASES_TAC THENL [STRIP_TAC THEN ASM_REWRITE_TAC[]
\r
4050 THEN DOWN THEN CONV_TAC ARITH_RULE; STRIP_TAC THEN
\r
4051 ASM_REWRITE_TAC[] THEN DOWN THEN ARITH_TAC THEN ASM_MESON_TAC[
\r
4052 ARITH_RULE` i < CW - 1 /\ CW <= CS ==> ~( CS <= i + 1) `
\r
4053 ]]]; ASM_MESON_TAC[
\r
4054 ARITH_RULE` i < CW - 1 /\ CW <= CS ==> ~( CS <= i + 1) `]]);;
\r
4059 let TRANS_SUC_IMP_INCREASE = prove(`! f. (! x y z. f x y /\ f y z ==> f x z ) /\
\r
4060 (! i. f i ( i + 1 )) ==>
\r
4061 (! i j. i < j ==> f i j ) `,
\r
4062 GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN INDUCT_TAC
\r
4063 THENL [REWRITE_TAC[LT; ARITH_RULE` i < SUC j <=> i < j \/ j = i `];
\r
4064 REWRITE_TAC[ARITH_RULE` i < SUC j <=> i < j \/ i = j `] THEN
\r
4065 ASM_MESON_TAC[ADD1]]);;
\r
4070 let MONOPOLY_IN_FIRST_PERIOD = prove(
\r
4071 ` (!x. W x ==> ~(x = vec 0)) /\
\r
4074 f polar_cycle_on W /\
\r
4075 (!x. W x ==> p0 polar_le x )
\r
4076 ==> (! i j. i < j /\ j < CARD W ==>
\r
4077 ITER i f p0 polar_lt ITER j f p0 ) `,
\r
4078 STRIP_TAC THEN GEN_TAC THEN INDUCT_TAC THENL [
\r
4079 REWRITE_TAC[LT]; REWRITE_TAC[LT]] THEN STRIP_TAC THENL
\r
4080 [ASM_REWRITE_TAC[ITER] THEN
\r
4081 MATCH_MP_TAC POLAR_MONOPOLY_IN_FIRST_ITERVAL THEN
\r
4082 ASM_REWRITE_TAC[ARITH_RULE` a < b - 1 <=> a + 1 < b `;
\r
4084 UNDISCH_TAC `i < j /\ j < CARD (W:real^2 -> bool) ==>
\r
4085 ITER i f p0 polar_lt ITER j f p0` THEN ANTS_TAC THENL [
\r
4086 ASM_ARITH_TAC; DISCH_TAC]] THEN MP_TAC (
\r
4087 CHANGE `j:num ` `i:num` POLAR_MONOPOLY_IN_FIRST_ITERVAL)
\r
4088 THEN ANTS_TAC THENL [
\r
4089 ASM_REWRITE_TAC[ARITH_RULE` a < b - 1 <=> SUC a < b`];
\r
4090 REWRITE_TAC[GSYM ITER]] THEN
\r
4091 SUBGOAL_THEN ` ~(ITER j f (p0: real^2) = vec 0 )` ASSUME_TAC
\r
4092 THENL [ASM SET_TAC[IN; POLAR_CYCLIC_FUN_IMP_ALL_BELONG];
\r
4093 ASM_MESON_TAC[POLAR_LT_TRANS]]);;
\r
4097 let FINITE_SEUBSET_OF_NATURAL = prove(`! n. FINITE { f i | i < (n:num) } `,
\r
4098 INDUCT_TAC THENL [REWRITE_TAC[LT; SET_RULE[]` { f i | i | F } = {} `;
\r
4100 ASM_REWRITE_TAC[ARITH_RULE` i < SUC j <=> i < j \/ i = j `;
\r
4101 SET_RULE[]` {f i| P i \/ i = a } = f a INSERT {f i| P i }`;
\r
4102 FINITE_INSERT]]);;
\r
4105 let STRICTLY_INCREASE_PRESERVING_CARD =
\r
4106 prove(` ! lt f. (! (x:A) y. lt x y ==> ~( x = y )) /\
\r
4107 (! i (j: num). i < j ==> lt (f i ) ( f j )) ==>
\r
4108 (! n. CARD ({ f i | i < n }) = n ) `,
\r
4109 REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THENL [
\r
4110 REWRITE_TAC[LT; SET_RULE[]` { f i | i | F } = {} `;
\r
4112 ASM_SIMP_TAC[ARITH_RULE` i < SUC j <=> i < j \/ i = j `;
\r
4113 SET_RULE[]` {f i| P i \/ i = a } = f a INSERT {f i| P i }`;
\r
4114 CARD_CLAUSES; FINITE_SEUBSET_OF_NATURAL] THEN
\r
4115 SUBGOAL_THEN `~ ((f: num -> A) n IN {f i| i < n }) `
\r
4116 ( fun x -> SIMP_TAC[x]) THEN REWRITE_TAC[IN_ELIM_THM] THEN
\r
4117 ASM_MESON_TAC[]]);;
\r
4127 let XXXXX = prove(`!lt (f: num -> A).
\r
4128 (!x y. lt x y ==> ~(x = y)) /\
\r
4129 (!i j. i < j /\ j < N ==> lt (f i) (f j))
\r
4130 ==> (!n. n < N ==> CARD {f i | i < n} = n)`,
\r
4131 REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THENL [
\r
4132 REWRITE_TAC[LT; EMPTY_GSPEC; SET_RULE[]` { f i| i | F }
\r
4133 = {} `; CARD_CLAUSES]; REWRITE_TAC[ARITH_RULE` i < SUC v <=> i < v \/ i = v `]]
\r
4134 THEN DISCH_TAC THEN REWRITE_TAC[
\r
4135 SET_RULE[]`{(f:num -> A) i| i < n \/ i = n } =
\r
4136 f n INSERT {f i | i < n } `] THEN
\r
4137 SIMP_TAC[FINITE_SEUBSET_OF_NATURAL; CARD_CLAUSES] THEN
\r
4138 SUBGOAL_THEN ` ~((f:num -> A) n IN { f i | i < n }) `
\r
4139 ASSUME_TAC THENL [REWRITE_TAC[IN_ELIM_THM] THEN
\r
4140 ASM_MESON_TAC[ARITH_RULE` SUC v < g ==> v < g `];
\r
4141 ASM_REWRITE_TAC[] THEN
\r
4142 ASM_MESON_TAC[ARITH_RULE` SUC x < y ==> x < y `]]);;
\r
4147 let TDHUFHCYVHYBCC = prove(` (!x. W x ==> ~(x = vec 0)) /\
\r
4150 f polar_cycle_on W /\
\r
4151 (!x. W x ==> p0 polar_le x)
\r
4152 ==> (! n. n < CARD W ==>
\r
4153 CARD { y | ? i. i < n /\ y = ITER i f p0 } = n ) `,
\r
4155 REWRITE_TAC[SET_RULE[]` {y | ? i. i < n /\ y = ITER i f p0
\r
4156 } = {ITER i f p0 | i < n } `] THEN
\r
4157 MATCH_MP_TAC (BETA_RULE (ISPECL [`CARD (W: real^2 -> bool) `
\r
4158 ;`\x y. W x /\ W y /\ x polar_lt y `; `\i. ITER i f (p0:real^2) `]
\r
4159 (GEN_ALL XXXXX))) THEN
\r
4161 ASM_MESON_TAC[POLAR_LT_IMP_NOT_EQ]; REPEAT STRIP_TAC]
\r
4164 ASM_REWRITE_TAC[SET_RULE[]` A ( p x ) <=> p x IN A `] THEN
\r
4165 ASM_MESON_TAC [POLAR_CYCLIC_FUN_IMP_ALL_BELONG];
\r
4167 ASM_REWRITE_TAC[SET_RULE[]` A ( p x ) <=> p x IN A `] THEN
\r
4168 ASM_MESON_TAC [POLAR_CYCLIC_FUN_IMP_ALL_BELONG];
\r
4170 MP_TAC MONOPOLY_IN_FIRST_PERIOD THEN
\r
4171 ANTS_TAC THENL [ASM_REWRITE_TAC[]; ASM_MESON_TAC[]]]);;
\r
4175 let POLAR_CYCLIC_FUN_IMP_ALL_BELONG =
\r
4176 REWRITE_RULE[IN] POLAR_CYCLIC_FUN_IMP_ALL_BELONG;;
\r
4178 let CARD_W_AS_ALL_LESS_THAN_PERIODIC = prove(
\r
4179 ` (!x. W x ==> ~(x = vec 0)) /\
\r
4182 f polar_cycle_on W /\
\r
4183 (!x. W x ==> p0 polar_le x)
\r
4184 ==> (! n. n = CARD W ==> CARD { y | ? i. i < n /\ y = ITER i f p0 } = n ) `,
\r
4185 SIMP_TAC[] THEN ASM_CASES_TAC ` CARD (W:real^2 -> bool) = 0 `
\r
4186 THENL [ASM_REWRITE_TAC[LT; EMPTY_GSPEC; CARD_CLAUSES];
\r
4187 ASM_SIMP_TAC[ARITH_RULE` ~( a = 0 ) ==> ( b < a <=> b <
\r
4188 a - 1 \/ b = a - 1 )`] THEN REPEAT STRIP_TAC THEN
\r
4189 REWRITE_TAC[SET_RULE[]` {y | ?i. (P i \/ i = a ) /\ y = Q i}
\r
4190 = Q a INSERT {y | ? i. P i /\ y = Q i }`]] THEN
\r
4191 SUBGOAL_THEN `FINITE {y | ?i. i < CARD (W:real^2 -> bool)
\r
4192 - 1 /\ y = ITER i f (p0:real^2)} ` ASSUME_TAC THENL [
\r
4193 REWRITE_TAC[SET_RULE[]` {y | ?i . P i /\ y = Q i } =
\r
4194 { Q i | P i } `] THEN
\r
4195 REWRITE_TAC[FINITE_SEUBSET_OF_NATURAL];
\r
4196 ASM_SIMP_TAC[CARD_CLAUSES] THEN COND_CASES_TAC THENL [
\r
4197 DOWN THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
\r
4199 NHANH (ARITH_RULE `~( CARD W = 0 ) ==> CARD (W:real^2 -> bool) - 1
\r
4200 < CARD W `) THEN STRIP_TAC THEN
\r
4201 SUBGOAL_THEN` ITER i f (p0:real^2) polar_lt ITER (CARD (W:
\r
4202 real^2 -> bool) - 1 ) f p0 ` ASSUME_TAC THENL [
\r
4203 ASM_MESON_TAC [MONOPOLY_IN_FIRST_PERIOD];
\r
4204 ASM_MESON_TAC[POLAR_LT_IMP_NOT_EQ;
\r
4205 MONOPOLY_IN_FIRST_PERIOD;
\r
4206 POLAR_CYCLIC_FUN_IMP_ALL_BELONG]]; DOWN_TAC] THEN
\r
4207 NHANH (ARITH_RULE` ~(x = 0 ) ==> x - 1 < x `) THEN
\r
4208 STRIP_TAC THEN MP_TAC TDHUFHCYVHYBCC THEN
\r
4209 ANTS_TAC THENL [ASM_REWRITE_TAC[];
\r
4210 DISCH_THEN (MP_TAC o (SPEC ` CARD (W:real^2 -> bool)
\r
4212 ANTS_TAC THENL [ASM_REWRITE_TAC[]; SIMP_TAC[] THEN
\r
4213 DISCH_TAC THEN UNDISCH_TAC `~( CARD (W:real^2 -> bool ) = 0)`
\r
4214 THEN ARITH_TAC]]]);;
\r
4218 let AUTOMAP_IMP_ALL_ITER_IN =
\r
4219 prove(`W (p: A) /\ (! x. W x ==> f x IN W )
\r
4220 ==> (! N. ITER N f p IN W ) `,
\r
4221 STRIP_TAC THEN INDUCT_TAC THENL [
\r
4222 ASM_REWRITE_TAC[ITER; IN];
\r
4223 REWRITE_TAC[ITER] THEN ASM SET_TAC[]]);;
\r
4227 let AUTOMAP_IMP_ITER_SET_IS_A_SUBSET =
\r
4228 prove(`W p /\ (! x. W x ==> f x IN W ) ==>
\r
4229 {y | ?n. y = ITER n f p } SUBSET W `,
\r
4230 STRIP_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
\r
4231 ASM_MESON_TAC[AUTOMAP_IMP_ALL_ITER_IN]);;
\r
4237 let TOW_NON_VEC0_POLAR_LE_IMP_NOT_LT =
\r
4238 prove(`~( x = vec 0 ) /\ ~( y = vec 0 ) /\ x polar_le y ==>
\r
4239 ~( y polar_lt x ) `, REWRITE_TAC[polar_le] THEN
\r
4240 MESON_TAC[TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT;
\r
4241 NOT_EQ_IMP_TOTAL_ORDER;
\r
4242 NO_V0_IMP_NOT_SELF_POLLAR]);;
\r
4245 let CARD_W_IS_THE_PERIODIC = prove(` (!x. W x ==> ~(x = vec 0)) /\
\r
4248 f polar_cycle_on W /\
\r
4249 (!x. W x ==> p0 polar_le x)
\r
4250 ==> ITER (CARD W) f p0 = p0 `,
\r
4251 STRIP_TAC THEN MP_TAC CARD_W_AS_ALL_LESS_THAN_PERIODIC
\r
4252 THEN ANTS_TAC THENL [ASM_SIMP_TAC[];
\r
4253 DISCH_THEN (MP_TAC o SPEC `CARD (W:real^2 -> bool)`)] THEN
\r
4254 REWRITE_TAC[] THEN
\r
4257 REWRITE_TAC[SET_RULE[]`{y | ?i. i < CARD W /\ y = ITER i f p0} =
\r
4258 {ITER i f p0 | i < CARD W }`] THEN SUBGOAL_THEN ` FINITE {ITER i f (p0:real^2) |
\r
4259 i < CARD (W:real^2 -> bool)}` ASSUME_TAC THENL [
\r
4260 REWRITE_TAC[FINITE_SEUBSET_OF_NATURAL];
\r
4261 ABBREV_TAC ` WW = {ITER i f (p0:real^2) | i <
\r
4262 CARD (W:real^2 -> bool ) }`] THEN
\r
4263 SUBGOAL_THEN ` WW SUBSET (W:real^2 -> bool) ` ASSUME_TAC
\r
4264 THENL [EXPAND_TAC "WW" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN]
\r
4265 THEN ASM_MESON_TAC[POLAR_CYCLIC_FUN_IMP_ALL_BELONG];
\r
4266 DISCH_TAC] THEN SUBGOAL_THEN `WW = (W:real^2 -> bool) ` ASSUME_TAC THENL
\r
4267 [ASM_MESON_TAC[CARD_SUBSET_EQ]; ALL_TAC] THEN
\r
4268 SUBGOAL_THEN `! (x:real^2). W x ==> x polar_le ITER (CARD
\r
4269 W - 1 ) f p0 ` ASSUME_TAC THENL [
\r
4272 EXPAND_TAC "W" THEN EXPAND_TAC "WW" THEN
\r
4273 REWRITE_TAC[IN_ELIM_THM] THEN
\r
4274 ASSUME_TAC2 (ISPEC` W: real^2 -> bool` CARD_EQ_0) THEN
\r
4275 ASM_CASES_TAC ` ~((W:real^2 -> bool) = {})` THENL [
\r
4279 FIRST_X_ASSUM (SUBST_ALL_TAC o SYM) THEN GEN_TAC THEN
\r
4280 ASM_REWRITE_TAC[] THEN DOWN THEN
\r
4281 SIMP_TAC[ARITH_RULE` ~( x = 0 ) ==> ( c < x <=> c < x - 1
\r
4282 \/ c = x - 1) `] THEN PHA THEN STRIP_TAC THENL [
\r
4285 ASM_REWRITE_TAC[] THEN
\r
4286 ASSUME_TAC2 (ARITH_RULE` ~(CARD W = 0) ==>
\r
4287 CARD (W:real^2 -> bool) - 1 < CARD W `) THEN
\r
4288 ASSUME_TAC2 MONOPOLY_IN_FIRST_PERIOD THEN
\r
4289 ASM_MESON_TAC[polar_le];
\r
4293 ASM_REWRITE_TAC[polar_le]];
\r
4297 DOWN THEN DOWN THEN MESON_TAC[LT]];
\r
4304 ASSUME_TAC2 (ISPEC` W: real^2 -> bool` CARD_EQ_0) THEN
\r
4305 ASSUME_TAC2 (SET_RULE[]`W p0 ==>
\r
4306 ~((W:real^2 -> bool) = {})`) THEN
\r
4307 FIRST_X_ASSUM (SUBST_ALL_TAC o SYM) THEN DOWN THEN
\r
4308 SUBGOAL_THEN `W (ITER (CARD W - 1) f (p0:real^2))` ASSUME_TAC
\r
4309 THENL [ASM_MESON_TAC[POLAR_CYCLIC_FUN_IMP_ALL_BELONG];
\r
4310 NHANH (ARITH_RULE` ~( a = 0 ) ==> a = a - 1 + 1 `)] THEN
\r
4311 STRIP_TAC THEN SUBGOAL_THEN `ITER (CARD (W:real^2 -> bool)) f (p0:real^2)
\r
4312 = f (ITER ( CARD W - 1 ) f p0 )` ASSUME_TAC THENL [
\r
4313 REWRITE_TAC[GSYM ITER; ADD1] THEN DOWN THEN MESON_TAC[];
\r
4314 ALL_TAC]] THEN DOWN_TAC THEN REWRITE_TAC[polar_cycle_on]
\r
4315 THEN STRIP_TAC THEN
\r
4316 ABBREV_TAC ` AD = ITER (CARD (W:real^2 -> bool ) - 1)
\r
4317 f (p0:real^2)` THEN
\r
4320 SUBGOAL_THEN ` f (AD: real^2) polar_le AD ` ASSUME_TAC
\r
4321 THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[];
\r
4323 SUBGOAL_THEN `~( AD polar_lt f AD ) ` ASSUME_TAC THENL [
\r
4324 ASM SET_TAC[TOW_NON_VEC0_POLAR_LE_IMP_NOT_LT];
\r
4325 DOWN_TAC THEN REWRITE_TAC[IN] THEN STRIP_TAC]] THEN
\r
4326 UNDISCH_TAC `(W:real^2 -> bool) (AD:real^2 )` THEN
\r
4327 USE_FIRST ` !x. W (x:real^2 )
\r
4328 ==> x polar_lt f x /\
\r
4329 (!y. W y ==> ~(x polar_lt y /\ y polar_lt f x)) \/
\r
4330 (!y. W y ==> f x polar_le y /\ y polar_le x)`
\r
4331 NHANH THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
\r
4332 UNDISCH_TAC `(W:real^2 -> bool) p0 ` THEN
\r
4333 FIRST_X_ASSUM NHANH THEN ASM_MESON_TAC[POLAR_LE_REFL_EQ]);;
\r
4340 let ITER_CARD_W_IDENTIFICATION = prove(`
\r
4341 (!x. W x ==> ~(x = vec 0)) /\
\r
4344 f polar_cycle_on W /\
\r
4345 (!x. W x ==> p0 polar_le x)
\r
4346 ==> (! x. W x ==> ITER (CARD W) f x = x) `,
\r
4347 STRIP_TAC THEN STRIP_TAC THEN FIRST_ASSUM NHANH THEN
\r
4348 REWRITE_TAC[polar_le] THEN STRIP_TAC THENL [
\r
4349 MP_TAC (CHANGE `x:real^2 ` `p:real^2 ` (SPEC_ALL
\r
4350 EXISTS_STEPS_FOR_FOLLOWING_POINTS)) THEN
\r
4351 ANTS_TAC THENL [ASM_REWRITE_TAC[]; STRIP_TAC] THEN
\r
4352 EXPAND_TAC "x" THEN REWRITE_TAC[ITER_ADD] THEN
\r
4353 ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM ITER_ADD]
\r
4354 THEN MATCH_MP_TAC (MESON[]` a = b ==> P a = P b `) THEN
\r
4355 MATCH_MP_TAC CARD_W_IS_THE_PERIODIC THEN ASM_REWRITE_TAC[];
\r
4356 EXPAND_TAC "x" THEN MATCH_MP_TAC
\r
4357 CARD_W_IS_THE_PERIODIC THEN ASM_REWRITE_TAC[]]);;
\r
4362 let EXISTS_STEPS_FOR_FOLLOWING_POINTS =
\r
4363 prove(` (!x. W x ==> ~(x = vec 0)) /\
\r
4366 f polar_cycle_on W /\
\r
4369 ==> (?n. ITER n f p0 = p /\
\r
4370 (!nn. nn < n ==> ITER nn f p0 polar_lt p))`,
\r
4371 REWRITE_TAC[polar_le] THEN STRIP_TAC THENL [
\r
4372 MP_TAC (SPEC_ALL EXISTS_STEPS_FOR_FOLLOWING_POINTS) THEN
\r
4373 ANTS_TAC THENL [ASM_REWRITE_TAC[]; REWRITE_TAC[]];
\r
4374 EXISTS_TAC `0` THEN EXPAND_TAC "p" THEN REWRITE_TAC[ITER; LT]]);;
\r
4381 let EXISTS_STEPS_FOR_FOLLOWING_POINTS =
\r
4382 prove(` (!x. W x ==> ~(x = vec 0)) /\
\r
4385 f polar_cycle_on W /\
\r
4388 ==> (?n. n < CARD W /\
\r
4389 ITER n f p0 = p /\
\r
4390 (!nn. nn < n ==> ITER nn f p0 polar_lt p))`,
\r
4391 NHANH EXISTS_STEPS_FOR_FOLLOWING_POINTS THEN
\r
4392 STRIP_TAC THEN ASM_CASES_TAC ` n < CARD (W:real^2 -> bool) ` THENL
\r
4393 [EXISTS_TAC `n: num ` THEN ASM_REWRITE_TAC[];
\r
4394 UNDISCH_TAC `(W:real^2 -> bool) p ` THEN
\r
4395 NHANH_PAT `\x. x ==> s ` (SET_RULE[]` S c ==> ~( S = {})`) THEN
\r
4396 ASSUME_TAC2 (ISPEC `W:real^2 -> bool ` CARD_EQ_0) THEN
\r
4397 FIRST_X_ASSUM (SUBST1_TAC o SYM) THEN DOWN THEN
\r
4398 NHANH (ARITH_RULE` ~( a < (b:num)) ==> a = a - b + b `) THEN
\r
4399 STRIP_TAC THEN STRIP_TAC THEN
\r
4400 ASSUME_TAC2 (ARITH_RULE` ~( n < CARD (W:real^2 -> bool))
\r
4401 ==> ~( CARD W = 0 ) ==> n - CARD W < n `) THEN
\r
4402 DOWN THEN FIRST_X_ASSUM NHANH THEN
\r
4403 SUBGOAL_THEN `ITER (n - CARD (W: real^2 -> bool)) f p0
\r
4404 = ITER ( n - CARD W + CARD W ) f (p0:real^2) ` ASSUME_TAC]
\r
4405 THENL [ REWRITE_TAC[GSYM ITER_ADD] THEN MP_TAC
\r
4406 (SPEC_ALL PROVE_MIN_ELEMENT_IN_FINITE_CYCLIC_SET) THEN
\r
4408 ASSUME_TAC2 (SET_RULE[]` (W:real^2 -> bool) p ==>
\r
4409 ~( W = {} ) `) THEN ASM_REWRITE_TAC[];
\r
4410 STRIP_TAC] THEN MP_TAC (CHANGE `n': real^2 ` `p0:real^2 `
\r
4411 ITER_CARD_W_IDENTIFICATION) THEN
\r
4412 ANTS_TAC THENL [ASM_REWRITE_TAC[polar_le]; DISCH_TAC] THEN
\r
4413 UNDISCH_TAC ` (W:real^2 -> bool) p0 ` THEN
\r
4414 FIRST_X_ASSUM NHANH THEN SIMP_TAC[];
\r
4415 DOWN THEN FIRST_X_ASSUM (SUBST1_TAC o SYM) THEN
\r
4416 ASM_MESON_TAC[POLAR_CYCLIC_FUN_IMP_ALL_BELONG;
\r
4417 NO_V0_IMP_NOT_SELF_POLLAR]]);;
\r
4422 let MONO_LE_IN_FIRST_PERIOD = prove(
\r
4423 `(!x. W x ==> ~(x = vec 0)) /\
\r
4426 f polar_cycle_on W /\
\r
4427 (!x. W x ==> p0 polar_le x)
\r
4428 ==> (!i j. i <= j /\ j < CARD W
\r
4429 ==> ITER i f p0 polar_le ITER j f p0) `,
\r
4430 REWRITE_TAC[LE_LT; polar_le] THEN REPEAT STRIP_TAC THENL
\r
4431 [DISJ1_TAC THEN DOWN_TAC THEN REWRITE_TAC[GSYM polar_le]
\r
4432 THEN MESON_TAC[MONOPOLY_IN_FIRST_PERIOD; polar_le];
\r
4433 DISJ2_TAC THEN ASM_REWRITE_TAC[]]);;
\r
4440 let POLAR_LE_NOT_VEC0_IMP_PL_ANG_LE =
\r
4441 prove(` x polar_le y /\ ~( x = vec 0 ) /\
\r
4442 ~( y = vec 0 ) ==> pl_angle x <= pl_angle y `,
\r
4443 NHANH PL_ANGLE_PROPERTY THEN REWRITE_TAC[polar_le] THEN
\r
4444 STRIP_TAC THENL [UNDISCH_TAC ` x polar_lt y ` THEN
\r
4445 REWRITE_TAC[polar_lt; REAL_LE_LT] THEN
\r
4446 ASM_MESON_TAC[]; ASM_REWRITE_TAC[REAL_LE_REFL]]);;
\r
4451 let TWO_NOT_EQ_VECS_SUM_ARG_DIFF_TWO_PI = prove(
\r
4452 ` ~( x = vec 0 ) /\ ~ (y = vec 0 ) /\ ~( x = y )==>
\r
4453 arg_diff x y + arg_diff y x = &2 * pi `,
\r
4454 NHANH_PAT `\x. a /\ b /\ x ==> kk ` NOT_EQ_IMP_TOTAL_ORDER THEN
\r
4455 NGOAC THEN REWRITE_TAC[arg_diff; polar_le]
\r
4456 THEN (let ttc = ASM_REWRITE_TAC[] THEN
\r
4457 ASSUME_TAC2 TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT THEN DOWN
\r
4458 THEN ASM_SIMP_TAC[DE_MORGAN_THM] THEN DISCH_TAC THEN
\r
4459 CONV_TAC (DEPTH_CONV let_CONV) THEN REAL_ARITH_TAC in
\r
4460 STRIP_TAC THENL [ttc ;ttc]));;
\r
4464 let ARG_DIFF_SUCCESSIBLE_IN_FIRST_PERIOD =
\r
4465 prove(`!(W: real^2 -> bool ) xicm. FINITE W /\
\r
4467 (!x. W x ==> ~(x = vec 0)) /\
\r
4468 xicm polar_cycle_on W
\r
4470 W p /\ 0 <= i /\ i <= j /\ j < n
\r
4471 ==> arg_diff p (ITER i xicm p) +
\r
4472 arg_diff (ITER i xicm p) (ITER j xicm p) =
\r
4473 arg_diff p (ITER j xicm p))`,
\r
4474 REPEAT STRIP_TAC THEN
\r
4475 MP_TAC (SPEC_ALL PROVE_MIN_ELEMENT_IN_FINITE_CYCLIC_SET) THEN
\r
4477 ASM_MESON_TAC[SET_RULE[]` A x ==> ~( A = {} ) `];
\r
4478 STRIP_TAC] THEN UNDISCH_TAC ` (W:real^2 -> bool) p ` THEN
\r
4479 FIRST_ASSUM NHANH THEN REWRITE_TAC[GSYM polar_le] THEN STRIP_TAC
\r
4480 THEN MP_TAC (CHANGE `n': real^2 ` `p0: real^2 `
\r
4481 (CHANGE `xicm: real^2 -> real^2 ` `f:real^2 -> real^2 `
\r
4482 (SPEC_ALL EXISTS_STEPS_FOR_FOLLOWING_POINTS))) THEN ANTS_TAC
\r
4483 THENL [ASM_REWRITE_TAC[]; STRIP_TAC] THEN
\r
4484 ASM_CASES_TAC ` j + n'' < CARD (W:real^2 -> bool) `
\r
4487 UNDISCH_TAC ` i <= (j:num) ` THEN
\r
4488 NHANH (ARITH_RULE` (i:num) <= j ==> i + n'' <= j + n'' `) THEN
\r
4489 MP_TAC (CHANGE `xicm: real^2 -> real^2 ` `f:real^2 -> real^2 `
\r
4490 (CHANGE `n': real^2 ` `p0: real^2 ` MONO_LE_IN_FIRST_PERIOD)) THEN
\r
4491 ANTS_TAC THENL [ASM_REWRITE_TAC[polar_le];
\r
4492 STRIP_TAC THEN STRIP_TAC] THEN
\r
4493 UNDISCH_TAC` j + n'' < CARD (W:real^2 -> bool) ` THEN
\r
4496 FIRST_ASSUM NHANH THEN
\r
4497 NHANH (ARITH_RULE` a <= b /\ b < c ==> a < (c:num) `) THEN
\r
4499 UNDISCH_TAC ` j + n'' < CARD (W:real^2 -> bool) ` THEN
\r
4500 MP_TAC (ARITH_RULE` n'' <= j + (n'':num) `) THEN
\r
4501 PHA THEN FIRST_ASSUM NHANH THEN
\r
4503 UNDISCH_TAC ` i + n'' < CARD (W:real^2 -> bool) ` THEN
\r
4504 MP_TAC (ARITH_RULE` n'' <= i + (n'':num) `) THEN
\r
4505 PHA THEN FIRST_ASSUM NHANH THEN
\r
4507 REWRITE_TAC[GSYM ITER_ADD] THEN
\r
4509 FIRST_X_ASSUM SUBST_ALL_TAC THEN
\r
4510 SUBGOAL_THEN ` pl_angle p <= pl_angle (ITER i xicm p) /\
\r
4511 pl_angle p <= pl_angle (ITER j xicm p ) /\
\r
4512 pl_angle (ITER i xicm p) <= pl_angle (ITER j xicm p) `
\r
4513 ASSUME_TAC THENL [ASM_MESON_TAC[POLAR_CYCLIC_FUN_IMP_ALL_BELONG;
\r
4514 POLAR_LE_NOT_VEC0_IMP_PL_ANG_LE]; REWRITE_TAC[arg_diff] THEN
\r
4515 ASM_SIMP_TAC[] THEN CONV_TAC (DEPTH_CONV let_CONV) THEN
\r
4522 ASM_CASES_TAC` i + n'' < CARD (W:real^2 -> bool) `] THENL [
\r
4523 ASSUME_TAC2 (ARITH_RULE` ~( j + n'' < CARD (W: real^2 -> bool))
\r
4524 /\ j < n ==> CARD W = n ==> (j + n'') - CARD W < n''`) THEN
\r
4525 EXPAND_TAC "p" THEN
\r
4526 REWRITE_TAC[ITER_ADD] THEN
\r
4528 NHANH (ARITH_RULE` ~ (a < b ) ==> a - b + b = (a:num)`) THEN
\r
4529 ABBREV_TAC ` aa = j + (n'': num) ` THEN
\r
4531 EXPAND_TAC "aa" THEN
\r
4532 REWRITE_TAC[GSYM ITER_ADD] THEN
\r
4533 SUBGOAL_THEN `! x. W x ==> ITER (CARD (W:real^2 -> bool)) xicm x = x ` ASSUME_TAC
\r
4535 MATCH_MP_TAC (CHANGE `n':real^2` `p0:real^2 ` ITER_CARD_W_IDENTIFICATION) THEN
\r
4536 ASM_REWRITE_TAC[polar_le];
\r
4539 UNDISCH_TAC ` (W:real^2 -> bool) n' `] THEN
\r
4540 FIRST_ASSUM NHANH THEN
\r
4542 REWRITE_TAC[ITER_ADD] THEN
\r
4544 ASSUME_TAC2 (ARITH_RULE` i <= j /\ j < n /\ CARD (W:real^2
\r
4545 -> bool) = n ==> i < CARD W `) THEN
\r
4546 ASSUME_TAC (ARITH_RULE` n'' <= i + (n'':num) `) THEN
\r
4547 ASSUME_TAC2 (ARITH_RULE` aa - CARD (W:real^2 -> bool) <
\r
4548 n'' ==> aa - CARD W < i + n'' `) THEN
\r
4551 POLAR_LE_NOT_VEC0_IMP_PL_ANG_LE;;
\r
4553 |- x polar_le y /\ ~(x = vec 0) /\ ~(y = vec 0)
\r
4554 ==> pl_angle x <= pl_angle y
\r
4557 POLAR_CYCLIC_FUN_IMP_ALL_BELONG;;
\r
4559 it : thm = |- W p /\ f polar_cycle_on W ==> (!n. W (ITER n f p))
\r
4562 MONO_LE_IN_FIRST_PERIOD;;
\r
4565 SUBGOAL_THEN` (ITER ( aa - CARD (W:real^2 -> bool)) xicm
\r
4566 (n':real^2) ) polar_lt (ITER n'' xicm n')/\
\r
4567 ITER ( aa - CARD W ) xicm n' polar_lt ITER (i + n'') xicm n'
\r
4568 ` ASSUME_TAC THENL [
\r
4569 DOWN_TAC THEN REWRITE_TAC[IN; GSYM polar_le] THEN
\r
4570 ASM_MESON_TAC[MONOPOLY_IN_FIRST_PERIOD]; ALL_TAC] THEN
\r
4576 SUBGOAL_THEN ` ITER n'' xicm n' polar_le ITER (i + n'')
\r
4577 xicm n'` ASSUME_TAC THENL
\r
4578 [DOWN_TAC THEN REWRITE_TAC[GSYM polar_le] THEN
\r
4579 ASM_MESON_TAC[MONO_LE_IN_FIRST_PERIOD]; ALL_TAC] THEN
\r
4585 SUBGOAL_THEN ` ~(ITER (aa - CARD (W:real^2 -> bool)) xicm
\r
4586 (n':real^2) = vec 0 ) /\
\r
4587 ~( ITER n'' xicm n' = vec 0 ) /\
\r
4588 ~( ITER (i + n'') xicm n' = vec 0 )` ASSUME_TAC THENL [
\r
4589 ASM_MESON_TAC[POLAR_CYCLIC_FUN_IMP_ALL_BELONG]; ALL_TAC] THEN
\r
4591 SUBGOAL_THEN ` ~(ITER n'' xicm n' polar_le ITER (aa - CARD (W:real^2 -> bool)) xicm n') /\
\r
4592 ~( ITER (i + n'') xicm n' polar_le ITER ( aa - CARD W) xicm n')`
\r
4593 ASSUME_TAC THENL [ASM_MESON_TAC[
\r
4594 TOW_NON_VEC0_POLAR_LE_IMP_NOT_LT]; ALL_TAC] THEN
\r
4596 ASM_REWRITE_TAC[arg_diff] THEN CONV_TAC (DEPTH_CONV let_CONV)
\r
4597 THEN REAL_ARITH_TAC; ALL_TAC] THEN DOWN THEN DOWN THEN
\r
4598 NHANH (ARITH_RULE` ~( a < (b:num)) ==> a = a - b + b `) THEN
\r
4601 SUBGOAL_THEN `(! (x:real^2). W x ==> ITER (CARD W) xicm x
\r
4602 = x) ` ASSUME_TAC THENL [
\r
4604 MATCH_MP_TAC (CHANGE `n':real^2 ` `p0: real^2 ` (REWRITE_RULE[polar_le]
\r
4605 ITER_CARD_W_IDENTIFICATION)) THEN ASM_REWRITE_TAC[];
\r
4607 ABBREV_TAC ` wi = (i + n'') - CARD (W:real^2 -> bool) `] THEN
\r
4608 ABBREV_TAC ` wj = (j + n'') - CARD (W:real^2 -> bool) ` THEN
\r
4609 EXPAND_TAC "p" THEN SIMP_TAC[ITER_ADD] THEN
\r
4610 REWRITE_TAC[GSYM ITER_ADD] THEN ASM_SIMP_TAC[] THEN
\r
4611 STRIP_TAC THEN STRIP_TAC THEN
\r
4612 SUBGOAL_THEN ` wi < (n'': num) /\ wj < n'' /\ wi <= wj
\r
4613 /\ wj < CARD (W:real^2 -> bool)` ASSUME_TAC THENL [
\r
4614 ASM_ARITH_TAC; ALL_TAC] THEN
\r
4617 SUBGOAL_THEN ` (ITER wi xicm n') polar_le (ITER wj xicm n')
\r
4618 /\ ITER wi xicm n' polar_lt ITER n'' xicm n' /\
\r
4619 ITER wj xicm n' polar_lt ITER n'' xicm n' ` ASSUME_TAC THENL [
\r
4620 DOWN_TAC THEN REWRITE_TAC[GSYM polar_le] THEN
\r
4621 MESON_TAC [MONOPOLY_IN_FIRST_PERIOD;
\r
4622 MONO_LE_IN_FIRST_PERIOD]; ALL_TAC] THEN
\r
4624 SUBGOAL_THEN ` ~( ITER wi xicm (n':real^2) = vec 0 ) /\
\r
4625 ~( ITER wj xicm n' = vec 0 ) /\ ~( ITER n'' xicm n' = vec 0) `
\r
4626 ASSUME_TAC THENL [
\r
4627 ASM_MESON_TAC[POLAR_CYCLIC_FUN_IMP_ALL_BELONG]; ALL_TAC] THEN
\r
4629 SUBGOAL_THEN ` ~(ITER n'' xicm n' polar_le ITER wi xicm n') /\
\r
4630 ~( ITER n'' xicm n' polar_le ITER wj xicm n')` ASSUME_TAC
\r
4631 THENL [DOWN THEN DOWN THEN MESON_TAC [
\r
4632 TOW_NON_VEC0_POLAR_LE_IMP_NOT_LT]; ALL_TAC] THEN
\r
4635 EXPAND_TAC "p" THEN REWRITE_TAC[arg_diff] THEN
\r
4636 ASM_REWRITE_TAC[] THEN CONV_TAC (DEPTH_CONV let_CONV) THEN
\r
4641 let TWO_NON_ZERO_VECS_NOT_EQ_EQ_PLT =
\r
4642 prove(` ~(x = vec 0) /\ ~(y = vec 0) ==>
\r
4643 ( ~(x = y) <=> x polar_lt y \/ y polar_lt x ) `,
\r
4644 MESON_TAC[POLAR_LT_IMP_NOT_EQ;NOT_EQ_IMP_TOTAL_ORDER]);;
\r
4648 let SUM_OVER_W_EQUAL_AT_ANY_POINT =
\r
4649 prove(` FINITE W /\
\r
4651 (!x. W x ==> ~(x = vec 0)) /\
\r
4652 xicm polar_cycle_on W /\ W p0 /\
\r
4653 (! x. W x ==> p0 polar_le x )
\r
4655 sum (0.. n - 1 ) (\i. arg_diff ( ITER i xicm p ) (ITER ( i + 1 )
\r
4657 sum (0.. n - 1 ) (\i. arg_diff ( ITER i xicm p0 ) (ITER ( i + 1 )
\r
4659 REPEAT STRIP_TAC THEN DOWN THEN FIRST_ASSUM NHANH THEN
\r
4660 STRIP_TAC THEN ASSUME_TAC2 (
\r
4661 CHANGE `xicm: real^2 -> real^2 ` `f:real^2 -> real^2 `
\r
4662 EXISTS_STEPS_FOR_FOLLOWING_POINTS) THEN DOWN THEN STRIP_TAC
\r
4663 THEN ASM_CASES_TAC ` n' = 0 ` THENL [
\r
4664 FIRST_X_ASSUM SUBST_ALL_TAC THEN EXPAND_TAC "p" THEN
\r
4665 REWRITE_TAC[ITER_ADD; ADD_CLAUSES]; EXPAND_TAC "p"] THEN
\r
4666 REWRITE_TAC[ITER_ADD; ARITH_RULE` (i + 1) + n' =
\r
4667 (i + n' ) + 1 `] THEN ABBREV_TAC ` ff i =
\r
4668 arg_diff (ITER i xicm (p0:real^2)) (ITER (i + 1) xicm p0) `
\r
4669 THEN REWRITE_TAC[GSYM SUM_OFFSET] THEN
\r
4670 ASSUME_TAC2 (ARITH_RULE` CARD (W:real^2 -> bool) = n /\
\r
4671 n' < CARD W ==> n' <= n - 1 + 1 `) THEN
\r
4672 ASM_SIMP_TAC[ADD; SUM_ADD_SPLIT] THEN
\r
4673 ASSUME_TAC2 (ISPEC `W:real^2 -> bool ` CARD_EQ_0) THEN (* 000 *)
\r
4674 ASSUME_TAC2 (SET_RULE[]` (W:real^2 -> bool) p ==>
\r
4675 ~( W = {} ) `) THEN FIRST_X_ASSUM (SUBST_ALL_TAC o SYM) THEN
\r
4676 EXPAND_TAC "n" THEN DOWN THEN UNDISCH_TAC ` ~( n' = 0)` THEN
\r
4677 PHA THEN NHANH (ARITH_RULE` ~(a = 0) /\ ~( b = 0 ) ==>
\r
4678 b - 1 + 1 = 0 + b /\ b - 1 + a = a - 1 + b `) THEN
\r
4679 SIMP_TAC[] THEN STRIP_TAC THEN
\r
4680 REWRITE_TAC[SUM_OFFSET] THEN
\r
4681 SUBGOAL_THEN `! i. (ff: num -> real) (i + CARD (W:real^2
\r
4682 -> bool)) = ff i ` ASSUME_TAC THENL [
\r
4683 DOWN_TAC THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
\r
4684 SIMP_TAC[] THEN STRIP_TAC THEN
\r
4685 REWRITE_TAC[ARITH_RULE` (a + b ) + 1 = (a + 1 ) + b `] THEN
\r
4686 REWRITE_TAC[GSYM ITER_ADD] THEN
\r
4687 MP_TAC (CHANGE ` xicm: real^2 -> real^2 ` `f: real^2 -> real^2 `
\r
4688 ITER_CARD_W_IDENTIFICATION) THEN
\r
4689 ANTS_TAC THENL [ASM_SIMP_TAC[]; DISCH_TAC] THEN
\r
4690 UNDISCH_TAC `(W:real^2 -> bool) p0 ` THEN
\r
4691 FIRST_X_ASSUM NHANH THEN SIMP_TAC[];
\r
4692 ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
\r
4693 MP_TAC (ISPECL[`ff: num -> real `;`0`;`n': num`;` n - 1 `]
\r
4694 SUM_COMBINE_L) THEN
\r
4695 ANTS_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[ETA_AX]]]);;
\r
4698 let SUM_INCREASE_ARG_DIFF = prove(
\r
4699 ` !(W: real^2 -> bool ) xicm. FINITE W /\
\r
4701 (!x. W x ==> ~(x = vec 0)) /\
\r
4702 xicm polar_cycle_on W
\r
4704 W p /\ 0 <= i /\ i < j /\ j < n
\r
4705 ==> sum (i .. (j - 1 )) (\i. arg_diff (ITER i xicm p) (ITER (i + 1) xicm p) )
\r
4706 = arg_diff (ITER i xicm p) (ITER j xicm p)) `,
\r
4707 REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN GEN_TAC THEN
\r
4708 INDUCT_TAC THENL [REWRITE_TAC[LT]; REWRITE_TAC[LT]] THEN STRIP_TAC
\r
4709 THENL [ASM_REWRITE_TAC[SUC_SUB1; SUM_SING_NUMSEG; ADD1];
\r
4710 DOWN THEN NHANH (ARITH_RULE` SUC c < k ==> c < k `)] THEN
\r
4711 STRIP_TAC THEN UNDISCH_TAC` j < (n:num) ` THEN
\r
4712 UNDISCH_TAC` i < (j:num)` THEN
\r
4713 UNDISCH_TAC` 0 <= i ` THEN
\r
4714 UNDISCH_TAC`(W:real^2 -> bool) p ` THEN
\r
4716 FIRST_ASSUM NHANH THEN
\r
4717 NHANH (ARITH_RULE`0 <= i /\ i < j /\ j < n ==>
\r
4718 SUC j - 1 = (j - 1) + 1 `) THEN
\r
4720 NHANH (ARITH_RULE` i < j ==> i <= j - 1 + 1`) THEN
\r
4721 SIMP_TAC[SUM_ADD_SPLIT] THEN
\r
4722 NHANH (ARITH_RULE` i < j ==> j - 1 + 1 = j `) THEN
\r
4724 ASM_REWRITE_TAC[SUM_SING_NUMSEG; ADD1] THEN
\r
4725 MP_TAC (SPEC_ALL ARG_DIFF_SUCCESSIBLE_IN_FIRST_PERIOD) THEN
\r
4726 ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN
\r
4727 DISCH_THEN (MP_TAC o (SPECL [`ITER i xicm (p:real^2)`; ` j - (i: num) `;
\r
4728 ` j - i + 1 `])) THEN ANTS_TAC THENL [
\r
4729 CONJ_TAC THENL [ASM_MESON_TAC[POLAR_CYCLIC_FUN_IMP_ALL_BELONG];
\r
4730 ASM_ARITH_TAC]; REWRITE_TAC[ITER_ADD]] THEN
\r
4731 ASSUME_TAC2 (ARITH_RULE` (i:num) < j ==> j - i + i = j `) THEN
\r
4732 ASSUME_TAC2 (ARITH_RULE` i < j ==> (j - i + 1) + i = j + 1 `) THEN
\r
4733 DOWN THEN DOWN THEN SIMP_TAC[]);;
\r
4738 let LEMMA_SUM_ALL_OVER_CYCLIC_SET = prove(`!(W: real^2 -> bool ) xicm. FINITE W /\
\r
4740 (!x. W x ==> ~(x = vec 0)) /\
\r
4741 xicm polar_cycle_on W /\ W p
\r
4742 ==> ((?p q. W p /\ W q /\ ~(p = q))
\r
4743 ==> sum (0..n - 1)
\r
4744 (\i. arg_diff (ITER i xicm p) (ITER (i + 1) xicm p)) =
\r
4746 REPEAT GEN_TAC THEN STRIP_TAC THEN
\r
4747 FIRST_ASSUM NHANH THEN
\r
4750 ASM_SIMP_TAC[TWO_NON_ZERO_VECS_NOT_EQ_EQ_PLT] THEN
\r
4751 REPLICATE_TAC 4 DOWN THEN
\r
4757 SPEC_TAC (`q:real^2`, `q:real^2 `) THEN
\r
4758 SPEC_TAC (`p':real^2`, `p':real^2 `) THEN
\r
4759 REWRITE_TAC[MESON[]`(!x. P x ==> Q ) <=> (?x. P x ) ==> Q `;
\r
4760 MESON[]` (? x y. W x /\ ~( x = i ) /\ W y /\
\r
4761 ~( y = i ) /\ (x polar_lt y \/ y polar_lt x) ) <=>
\r
4762 (? x y. W x /\ ~( x = i )/\ W y /\ ~( y = i ) /\ x polar_lt y ) `] THEN
\r
4764 MP_TAC (SPEC_ALL PROVE_MIN_ELEMENT_IN_FINITE_CYCLIC_SET) THEN
\r
4766 ASM_MESON_TAC[SET_RULE[]` A s ==> ~(A = {})`];
\r
4772 MP_TAC (CHANGE `n':real^2 ` `p0:real^2 `
\r
4773 SUM_OVER_W_EQUAL_AT_ANY_POINT) THEN ANTS_TAC THENL [
\r
4774 ASM_REWRITE_TAC[polar_le]; DISCH_TAC] THEN
\r
4777 UNDISCH_TAC ` (W:real^2 -> bool) p ` THEN
\r
4778 FIRST_ASSUM NHANH THEN
\r
4781 ASM_CASES_TAC ` n' = (q:real^2) ` THENL [
\r
4784 ASM_MESON_TAC[TOW_NON_VEC0_IMP_NOT_REFL_POLAR_LT;
\r
4785 POLAR_LT_IMP_NOT_EQ];
\r
4788 CHANGE `q: real^2 ` `p:real^2 ` (
\r
4789 CHANGE `xicm: real^2 -> real^2 ` `f: real^2 -> real^ 2 ` (
\r
4790 CHANGE `n': real^2 ` `p0:real^2 ` EXISTS_STEPS_FOR_FOLLOWING_POINTS)))
\r
4794 REWRITE_TAC[polar_le] THEN
\r
4795 ASM_MESON_TAC[]; STRIP_TAC] THEN
\r
4798 ASM_CASES_TAC `n'' = 0 ` THENL [
\r
4799 REPLICATE_TAC 5 DOWN THEN PHA THEN
\r
4802 ASSUME_TAC2 (ARITH_RULE`~( n'' = 0) ==> 0 <= n'' - 1 + 1 `)]
\r
4808 ASSUME_TAC2 (ARITH_RULE` CARD (W:real^2 -> bool) = n /\
\r
4809 n'' < CARD W /\ ~(n'' = 0 ) ==> n'' - 1 <= n - 1 `) THEN
\r
4810 DOWN THEN DOWN THEN PHA THEN
\r
4813 SPEC `(\i. arg_diff (ITER i xicm n')
\r
4814 (ITER (i + 1) xicm n'))` (GSYM SUM_COMBINE_R)) THEN
\r
4817 MP_TAC (SPEC_ALL SUM_INCREASE_ARG_DIFF) THEN
\r
4819 ASM_REWRITE_TAC[];
\r
4823 UNDISCH_TAC `n'' < CARD (W:real^2 -> bool) ` THEN
\r
4824 UNDISCH_TAC `~( n'' = 0 ) ` THEN
\r
4825 REWRITE_TAC[ ARITH_RULE`~(a = 0) <=> 0 < a `] THEN
\r
4826 MP_TAC (ARITH_RULE` 0 <= 0 `) THEN
\r
4827 UNDISCH_TAC `(W:real^2 -> bool) n'` THEN
\r
4829 ASM_REWRITE_TAC[] THEN
\r
4830 FIRST_ASSUM NHANH THEN
\r
4834 ARITH_RULE`0 < n'' /\ n'' < n ==> n - 1 = n - 1 - 1 + 1 `) THEN
\r
4835 FIRST_X_ASSUM (fun x -> ONCE_REWRITE_TAC[x]) THEN
\r
4836 ONCE_REWRITE_TAC[SUM_OFFSET] THEN
\r
4838 REWRITE_TAC[BETA_THM; GSYM ITER_ADD] THEN
\r
4839 SUBGOAL_THEN ` (W:real^2 -> bool) (ITER 1 xicm (n':real^2)) ` MP_TAC
\r
4841 ASM_SIMP_TAC[POLAR_CYCLIC_FUN_IMP_ALL_BELONG];
\r
4843 ASSUME_TAC2 (ARITH_RULE` n'' < n ==> n - 1 < n `) THEN
\r
4845 ASSUME_TAC2 (ARITH_RULE`0 < n'' /\ n'' < n ==>
\r
4846 n'' - 1 < n - 1 `) THEN
\r
4851 UNDISCH_TAC `n'' - 1 < n - 1 ` THEN
\r
4852 ASSUME_TAC2 (ARITH_RULE` 0 < n'' ==> 0 <= n'' - 1 `) THEN
\r
4856 FIRST_ASSUM NHANH THEN
\r
4857 SIMP_TAC[ITER_ADD] THEN
\r
4859 ASSUME_TAC2 (ARITH_RULE` 0 < n'' ==> n'' - 1 + 1 = n''`) THEN
\r
4860 ASSUME_TAC2 (ARITH_RULE` n'' < n ==> n - 1 + 1 = n `) THEN
\r
4861 ASM_REWRITE_TAC[ITER] THEN
\r
4862 UNDISCH_TAC` CARD (W:real^2 -> bool) = n ` THEN
\r
4863 DISCH_TAC THEN EXPAND_TAC "n" THEN
\r
4865 CHANGE `xicm: real^2 -> real^2 ` `f:real^2 -> real^2 ` (
\r
4866 CHANGE `n': real^2 ` `p0:real^2 `ITER_CARD_W_IDENTIFICATION)
\r
4872 ASM_REWRITE_TAC[polar_le];
\r
4875 UNDISCH_TAC` (W:real^2 -> bool) n' ` THEN
\r
4876 FIRST_ASSUM NHANH THEN
\r
4877 EXPAND_TAC "n" THEN
\r
4879 ASM_MESON_TAC[TWO_NOT_EQ_VECS_SUM_ARG_DIFF_TWO_PI]);;
\r
4882 parse_as_infix("re_eqvl",(12,"right"));;
\r
4884 let re_eqvl = new_definition ` a re_eqvl (b:real)
\r
4885 <=> (? t. &0 < t /\ a = t * b )`;;
\r
4888 let VEC_DIV_MOV = prove(
\r
4889 ` ~( a = &0 ) ==> (( b / a ) % x = y <=>
\r
4890 b % x = a % y ) `,
\r
4891 SIMP_TAC[MESON[VECTOR_MUL_LCANCEL]` ~( a = &0 ) ==>
\r
4892 (( b / a ) % x = y <=> a % ( b / a) % x = a % y ) `;
\r
4893 VECTOR_MUL_ASSOC; REAL_DIV_LMUL]);;
\r
4897 (* ======================================================== *)
\r
4898 (* ----------------------------- *)
\r
4899 let JBDNJJB = prove(
\r
4900 `! u v w. sin ( azim ( vec 0 ) u v w ) re_eqvl (u cross v ) dot w `,
\r
4902 REPEAT GEN_TAC THEN ASM_CASES_TAC `(u:real^3) = vec 0 ` THENL [
\r
4903 ASM_SIMP_TAC[AZIM_DEGENERATE; CROSS_0; DOT_LZERO;
\r
4904 SIN_0; re_eqvl] THEN EXISTS_TAC `&1` THEN REAL_ARITH_TAC;
\r
4907 ASM_CASES_TAC` collinear {vec 0, u, (v:real^3)}`]
\r
4912 FIRST_X_ASSUM MP_TAC THEN ASM_SIMP_TAC[GSYM CROSS_EQ_0] THEN
\r
4913 REWRITE_TAC[CROSS_EQ_0] THEN
\r
4914 ASM_SIMP_TAC[AZIM_DEGENERATE; CROSS_0; DOT_LZERO;
\r
4915 SIN_0; re_eqvl] THEN
\r
4917 EXISTS_TAC `&1 ` THEN
\r
4920 ASM_CASES_TAC` collinear {vec 0, u, (w:real^3)}`] THENL [
\r
4922 FIRST_X_ASSUM MP_TAC THEN ASM_SIMP_TAC[GSYM CROSS_EQ_0] THEN
\r
4923 REWRITE_TAC[CROSS_EQ_0] THEN
\r
4924 ONCE_REWRITE_TAC[GSYM CROSS_TRIPLE] THEN
\r
4925 ONCE_REWRITE_TAC[SET_RULE[]` {a,b} = {b,a}`] THEN
\r
4926 ASM_SIMP_TAC[AZIM_DEGENERATE;GSYM CROSS_EQ_0] THEN
\r
4927 ASM_SIMP_TAC[CROSS_EQ_0] THEN
\r
4928 ASM_SIMP_TAC[AZIM_DEGENERATE; CROSS_0; DOT_LZERO;
\r
4929 SIN_0; re_eqvl; SET_RULE[]` {a,b} = {b,a}`] THEN
\r
4931 EXISTS_TAC `&1 ` THEN
\r
4933 ABBREV_TAC ` e3 = &1 / norm (u:real^3) % u ` THEN
\r
4934 ABBREV_TAC `v' = v - (e3 dot v) % (e3:real^3) ` THEN
\r
4935 ABBREV_TAC `(e1:real^3) = &1 / norm (v') % v' ` THEN
\r
4936 ABBREV_TAC ` e2 = e3 cross e1 ` THEN
\r
4937 SUBGOAL_THEN `orthonormal e1 e2 e3 ` ASSUME_TAC]
\r
4940 REWRITE_TAC[orthonormal] THEN
\r
4941 EXPAND_TAC "e2" THEN
\r
4942 REWRITE_TAC[DOT_CROSS_SELF; DOT_CROSS] THEN
\r
4943 SUBGOAL_THEN `~((v':real^3) = vec 0)` ASSUME_TAC THENL [
\r
4946 EXPAND_TAC "v'" THEN
\r
4947 EXPAND_TAC "e3" THEN
\r
4948 REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
\r
4949 ASSUME_TAC2 (ISPECL [`u:real^3 `;` v:real^3 `]
\r
4950 NOT_EQ_VEC0_IMP_EQU_AFF_COLL) THEN
\r
4951 UNDISCH_TAC `~ collinear {vec 0, u, (v:real^3)}` THEN
\r
4952 FIRST_X_ASSUM MP_TAC THEN
\r
4953 ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
\r
4956 REWRITE_TAC[AFF2_VEC0; IN_ELIM_THM; VECTOR_ARITH` vec 0 =
\r
4957 x - y <=> x = y `] THEN
\r
4961 SUBGOAL_THEN `e3 dot (e3:real^3) = &1 /\ e1 dot (e1:real^3)
\r
4962 = &1 ` ASSUME_TAC] THENL [
\r
4964 EXPAND_TAC "e3" THEN
\r
4965 EXPAND_TAC "e1" THEN
\r
4966 REWRITE_TAC[DOT_LMUL; DOT_RMUL; GSYM NORM_POW_2] THEN
\r
4967 UNDISCH_TAC `~((u:real^3) = vec 0 ) ` THEN
\r
4968 UNDISCH_TAC `~((v':real^3) = vec 0) ` THEN
\r
4969 REWRITE_TAC[GSYM NORM_EQ_0] THEN
\r
4970 PHA THEN CONV_TAC REAL_FIELD;
\r
4974 SUBGOAL_THEN `e1 dot (e3: real^3) = &0 ` ASSUME_TAC] THENL [
\r
4977 EXPAND_TAC "e1" THEN
\r
4978 EXPAND_TAC "v'" THEN
\r
4979 REWRITE_TAC[DOT_LSUB; DOT_LMUL; REAL_MUL_RID] THEN
\r
4980 ASM_SIMP_TAC[REAL_MUL_RID; DOT_SYM; REAL_SUB_REFL;
\r
4985 ASM_SIMP_TAC[DOT_SYM] THEN
\r
4986 ONCE_REWRITE_TAC[DOT_SYM] THEN
\r
4987 ONCE_REWRITE_TAC[GSYM CROSS_TRIPLE] THEN
\r
4988 EXPAND_TAC "e2" THEN
\r
4989 REWRITE_TAC[DOT_CROSS] THEN
\r
4990 ASM_SIMP_TAC[DOT_SYM] THEN
\r
4993 MP_TAC (let ddd = (let dd = SPEC_ALL (SPECL [`v: real^3 `;` vec 0 : real^3 `;`u:real^3 `;
\r
4994 `w:real^3 `] SPHERICAL_COORDINATES) in SPEC `dist(vec 0, w:real^3 )`
\r
4995 (GEN `r:real` dd)) in
\r
4996 SPEC ` azim ( vec 0 ) u v w ` (GEN `theta: real`
\r
4997 (SPEC `arcV ( vec 0) w (u:real^3) ` (GEN `phi: real` ddd)))) THEN
\r
5000 (* one new goal *)
\r
5001 (* ============ *)
\r
5004 ASM_REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN
\r
5005 EXPAND_TAC "e3" THEN
\r
5006 REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
\r
5007 UNDISCH_TAC `~((u:real^3) = vec 0 ) ` THEN
\r
5008 SIMP_TAC[GSYM NORM_EQ_0; REAL_FIELD` ~( x = &0) ==>
\r
5009 x * &1 / x = &1 `; VECTOR_MUL_LID] THEN
\r
5010 SUBGOAL_THEN `DISJOINT {vec 0, u} {v:real^3 }` ASSUME_TAC
\r
5017 REWRITE_TAC[DISJOINT; SET_RULE[]` {a,b} INTER {c} = {}
\r
5018 <=> ~( c = a ) /\ ~( c = b ) `] THEN
\r
5019 (let drt = STRIP_TAC THEN
\r
5020 UNDISCH_TAC `~ collinear { vec 0, u, (v:real^3)} ` THEN
\r
5021 ASM_SIMP_TAC[INSERT_AC; COLLINEAR_2] in CONJ_TAC THENL [drt;
\r
5025 FIRST_X_ASSUM MP_TAC THEN
\r
5026 NHANH AFF_GT_2_1 THEN
\r
5027 PHA THEN SIMP_TAC[] THEN
\r
5029 REWRITE_TAC[IN_ELIM_THM] THEN
\r
5030 EXPAND_TAC "e1" THEN
\r
5031 EXPAND_TAC "v'" THEN
\r
5032 SIMP_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID;
\r
5033 VECTOR_SUB_LDISTRIB] THEN
\r
5034 SUBGOAL_THEN `~( v - (e3 dot v) % (e3:real^3)
\r
5035 = vec 0) ` ASSUME_TAC] THENL [
\r
5039 EXPAND_TAC "e3" THEN
\r
5040 REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
\r
5041 UNDISCH_TAC `~ collinear {vec 0, u, (v:real^3)}` THEN
\r
5042 FIRST_X_ASSUM MP_TAC THEN
\r
5043 REWRITE_TAC[NORM_EQ_0] THEN
\r
5044 PAT_ONCE_REWRITE_TAC `\x. x ==> _ ` [EQ_SYM_EQ] THEN
\r
5045 NHANH (GSYM (ISPECL [`u:real^3 `;` v:real^3 `] NOT_EQ_VEC0_IMP_EQU_AFF_COLL)) THEN
\r
5046 SIMP_TAC[] THEN DISCH_TAC THEN
\r
5047 REWRITE_TAC[AFF2_VEC0; IN_ELIM_THM; VECTOR_SUB_EQ] THEN
\r
5051 ABBREV_TAC `r3 = e3 dot (v:real^3 ) ` THEN
\r
5052 REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
\r
5053 ABBREV_TAC `e33 = r3 % (e3: real^3) ` THEN
\r
5054 EXPAND_TAC "e3" THEN
\r
5055 REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
\r
5056 EXISTS_TAC ` &1 - &1 / norm ((v:real^3 ) -
\r
5057 e33) + (&1 / norm ((v:real^3) - e33) * r3) * &1 / norm (u:real^3) ` THEN
\r
5058 EXISTS_TAC `-- (&1 / norm ((v:real^3) - e33) * r3) * &1 / norm (u:real^3)` THEN
\r
5059 EXISTS_TAC `&1 / norm ((v:real^3) - e33)` THEN
\r
5063 MATCH_MP_TAC REAL_LT_DIV THEN
\r
5064 UNDISCH_TAC `~((v:real^3) - e33 = vec 0) ` THEN
\r
5065 REWRITE_TAC[GSYM NORM_POS_LT] THEN
\r
5066 SIMP_TAC[] THEN REAL_ARITH_TAC;
\r
5067 CONJ_TAC THENL [REAL_ARITH_TAC;
\r
5068 CONV_TAC VECTOR_ARITH]]];
\r
5071 SUBGOAL_THEN `~( v - (e3 dot v) % (e3:real^3)
\r
5072 = vec 0) ` ASSUME_TAC THENL [
\r
5075 EXPAND_TAC "e3" THEN
\r
5076 REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
\r
5077 UNDISCH_TAC `~ collinear {vec 0, u, (v:real^3)}` THEN
\r
5078 UNDISCH_TAC ` ~( (u:real^3) = vec 0) ` THEN
\r
5079 REWRITE_TAC[NORM_EQ_0] THEN
\r
5080 PAT_ONCE_REWRITE_TAC `\x. x ==> _ ` [EQ_SYM_EQ] THEN
\r
5081 NHANH (GSYM (ISPECL [`u:real^3 `;` v:real^3 `] NOT_EQ_VEC0_IMP_EQU_AFF_COLL)) THEN
\r
5082 SIMP_TAC[] THEN DISCH_TAC THEN
\r
5083 REWRITE_TAC[AFF2_VEC0; IN_ELIM_THM; VECTOR_SUB_EQ] THEN
\r
5088 SUBST_ALL_TAC (SYM (ISPEC `u:real^3 ` NORM_EQ_0))]] THEN
\r
5092 ASSUME_TAC2 (ISPECL [`&1 `;` u: real^3 `; ` norm (u:real^3)`
\r
5093 ; `e3: real^3`] (GEN_ALL VEC_DIV_MOV)) THEN
\r
5094 SUBST_ALL_TAC (ISPEC `u:real^3 ` VECTOR_MUL_LID) THEN
\r
5095 FIRST_X_ASSUM SUBST_ALL_TAC THEN
\r
5096 ABBREV_TAC ` azzz = azim (vec 0) u v w ` THEN
\r
5097 ABBREV_TAC `arrr = arcV (vec 0) w (u:real^3)` THEN
\r
5098 ABBREV_TAC ` diii = dist( vec 0, (w:real^3))` THEN
\r
5100 SIMP_TAC[VECTOR_ADD_LID] THEN
\r
5102 ABBREV_TAC `no_u = norm (u:real^3)` THEN
\r
5103 ASM_REWRITE_TAC[] THEN
\r
5104 UNDISCH_TAC ` (v:real^3) - (e3 dot v ) %e3
\r
5106 ABBREV_TAC ` era = e3 dot (v:real^3) ` THEN
\r
5107 REWRITE_TAC[VECTOR_ARITH` a - b = (x:real^N) <=>
\r
5108 a = x + b `] THEN
\r
5109 SIMP_TAC[CROSS_RADD; CROSS_RMUL; CROSS_LMUL;
\r
5110 CROSS_REFL; VECTOR_MUL_RZERO; VECTOR_ADD_RID] THEN
\r
5111 REWRITE_TAC[VECTOR_ARITH` a = b + (c:real^N) <=>
\r
5112 a - c = b `] THEN
\r
5113 DISCH_THEN SUBST_ALL_TAC THEN
\r
5114 UNDISCH_TAC ` &1 / norm v' % (v':real^3) = e1 ` THEN
\r
5115 UNDISCH_TAC `~((v':real^3) = vec 0 ) ` THEN
\r
5116 SIMP_TAC[GSYM NORM_EQ_0; VEC_DIV_MOV; VECTOR_MUL_LID] THEN
\r
5117 ABBREV_TAC `nov' = norm (v':real^3) ` THEN
\r
5118 SIMP_TAC[CROSS_RMUL] THEN
\r
5121 ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; DOT_RADD; DOT_RMUL;
\r
5123 UNDISCH_TAC `orthonormal e1 e2 e3 ` THEN
\r
5124 REWRITE_TAC[orthonormal] THEN
\r
5125 SIMP_TAC[DOT_SYM; REAL_MUL_RZERO; REAL_ADD_LID; REAL_ADD_RID] THEN
\r
5127 REWRITE_TAC[REAL_ARITH`(a * b * c ) * (d * e ) * &1
\r
5128 = (a * c * d * e ) * b `; re_eqvl] THEN
\r
5129 EXISTS_TAC ` &1 / ( diii * sin arrr * no_u * nov') ` THEN
\r
5131 SUBGOAL_THEN ` &0 < diii * sin arrr * no_u * nov' `
\r
5132 ASSUME_TAC THENL [
\r
5136 MESON[REAL_LT_MUL]` &0 < a /\ &0 < b /\ &0 < c /\ &0 < d
\r
5137 ==> &0 < b * a * c * d `) THEN
\r
5138 CONJ_TAC THENL [EXPAND_TAC "arrr" THEN
\r
5139 UNDISCH_TAC `~ collinear {vec 0, u, (w:real^3)}` THEN
\r
5140 SIMP_TAC[ARC_SYM; NOT_COLL_IM_SIN_LT];
\r
5141 UNDISCH_TAC `~(no_u = &0) `] THEN
\r
5142 UNDISCH_TAC ` ~(nov' = &0)` THEN
\r
5143 UNDISCH_TAC `~ collinear {vec 0, u, (w:real^3)}` THEN
\r
5144 NHANH NOT_COLLINEAR_IMP_2_UNEQUAL THEN STRIP_TAC THEN
\r
5145 FIRST_X_ASSUM MP_TAC THEN SIMP_TAC[DIST_NZ] THEN
\r
5146 EXPAND_TAC "diii" THEN EXPAND_TAC "no_u" THEN EXPAND_TAC "nov'" THEN
\r
5147 PHA THEN CONV_TAC NORM_ARITH; CONJ_TAC] THENL [
\r
5149 MATCH_MP_TAC REAL_LT_DIV THEN
\r
5150 FIRST_X_ASSUM MP_TAC THEN REAL_ARITH_TAC;
\r
5152 FIRST_X_ASSUM MP_TAC THEN NHANH REAL_POS_NZ THEN SIMP_TAC[REAL_MUL_RID] THEN
\r
5153 ONCE_REWRITE_TAC[REAL_RING`a * no * nv * di * az * z = az * a * (di * z * no * nv) `] THEN
\r
5154 SIMP_TAC[NOT_0_INVERTABLE; REAL_MUL_RID]]);;
\r
5159 [NOT_IN_EMPTY; IN_UNIV; IN_UNION; IN_INTER; IN_DIFF; IN_INSERT;
\r
5160 IN_DELETE; IN_REST; IN_INTERS; IN_UNIONS; IN_IMAGE] in
\r
5161 let allthms = basicthms @ map (REWRITE_RULE[IN]) basicthms @
\r
5162 [IN_ELIM_THM; IN] in
\r
5164 TRY(POP_ASSUM_LIST(MP_TAC o end_itlist CONJ)) THEN
\r
5165 REPEAT COND_CASES_TAC THEN
\r
5166 REWRITE_TAC[EXTENSION; SUBSET; PSUBSET; DISJOINT; SING] THEN
\r
5167 REWRITE_TAC allthms in
\r
5170 (if ths = [] then ALL_TAC else MP_TAC(end_itlist CONJ ths)) THEN
\r
5172 let SET_RULE tm = prove(tm,SET_TAC[]);;
\r
5177 let ISRTTNZ = prove(` FINITE W /\
\r
5179 (!x. W x ==> ~(x = vec 0)) /\
\r
5180 xicm polar_cycle_on W /\
\r
5181 W p /\ (?p q. W p /\ W q /\ ~(p = q))
\r
5182 ==> sum (0..n - 1)
\r
5183 (\i. arg_diff (ITER i xicm p) (ITER (i + 1) xicm p)) =
\r
5186 W p /\ 0 <= i /\ i <= j /\ j < n
\r
5187 ==> arg_diff p (ITER i xicm p) +
\r
5188 arg_diff (ITER i xicm p) (ITER j xicm p) =
\r
5189 arg_diff p (ITER j xicm p)) `, STRIP_TAC THEN
\r
5190 MP_TAC (SPEC_ALL ARG_DIFF_SUCCESSIBLE_IN_FIRST_PERIOD) THEN
\r
5191 ANTS_TAC THENL [ASM_REWRITE_TAC[]; SIMP_TAC[]] THEN DISCH_TAC
\r
5192 THEN MP_TAC (SPEC_ALL LEMMA_SUM_ALL_OVER_CYCLIC_SET) THEN PHA THEN
\r
5193 ANTS_TAC THENL [ ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[];
\r