1(*===========================================================================*) 2(* Definitions of the transcendental functions etc. *) 3(*===========================================================================*) 4 5(* 6app load ["hol88Lib", 7 "numLib", 8 "reduceLib", 9 "pairTheory", 10 "jrhUtils", 11 "powserTheory", 12 "Diff", 13 "mesonLib", 14 "RealArith"]; 15 16*) 17 18open HolKernel Parse boolLib; 19 20open hol88Lib 21 reduceLib 22 pairTheory 23 numTheory 24 prim_recTheory 25 arithmeticTheory 26 realTheory 27 metricTheory 28 netsTheory 29 seqTheory 30 limTheory 31 powserTheory 32 numLib 33 PairedLambda 34 jrhUtils 35 Diff 36 mesonLib 37 RealArith; 38 39val _ = new_theory "transc"; 40val _ = ParseExtras.temp_loose_equality() 41 42 43val _ = Parse.reveal "B"; 44 45(*---------------------------------------------------------------------------*) 46(* Some miscellaneous lemmas *) 47(*---------------------------------------------------------------------------*) 48 49val MULT_DIV_2 = prove 50 (���!n. (2 * n) DIV 2 = n���, 51 GEN_TAC THEN ONCE_REWRITE_TAC[MULT_SYM] THEN 52 MP_TAC(SPECL [���2:num���, ���0:num���] DIV_MULT) THEN REDUCE_TAC THEN 53 REWRITE_TAC[ADD_CLAUSES] THEN DISCH_THEN MATCH_ACCEPT_TAC); 54 55val EVEN_DIV2 = prove 56 (���!n. ~(EVEN n) ==> ((SUC n) DIV 2 = SUC((n - 1) DIV 2))���, 57 GEN_TAC THEN REWRITE_TAC[EVEN_ODD, ODD_EXISTS] THEN 58 DISCH_THEN(X_CHOOSE_THEN ���m:num��� SUBST1_TAC) THEN 59 REWRITE_TAC[SUC_SUB1] THEN REWRITE_TAC[ADD1, GSYM ADD_ASSOC] THEN 60 SUBST1_TAC(EQT_ELIM(REDUCE_CONV ���1 + 1:num = 2 * 1���)) THEN 61 REWRITE_TAC[GSYM LEFT_ADD_DISTRIB, MULT_DIV_2]); 62 63 64(*---------------------------------------------------------------------------*) 65(* The three functions we define by series are exp, sin, cos *) 66(*---------------------------------------------------------------------------*) 67 68val sin_ser = 69 ���\n. if EVEN n then &0 70 else ((~(&1)) pow ((n - 1) DIV 2)) / &(FACT n)���; 71 72val cos_ser = 73 ���\n. if EVEN n then ((~(&1)) pow (n DIV 2)) / &(FACT n) else &0���; 74 75val exp_ser = ���\n. inv(&(FACT n))���; 76 77val exp = new_definition("exp", 78 ���exp(x) = suminf(\n. (^exp_ser) n * (x pow n))���); 79 80val cos = new_definition("cos", 81 ���cos(x) = suminf(\n. (^cos_ser) n * (x pow n))���); 82 83val sin = new_definition("sin", 84 ���sin(x) = suminf(\n. (^sin_ser) n * (x pow n))���); 85 86(*---------------------------------------------------------------------------*) 87(* Show the series for exp converges, using the ratio test *) 88(*---------------------------------------------------------------------------*) 89 90val EXP_CONVERGES = store_thm("EXP_CONVERGES", 91 ���!x. (\n. (^exp_ser) n * (x pow n)) sums exp(x)���, 92 let fun fnz tm = 93 (GSYM o MATCH_MP REAL_LT_IMP_NE o 94 REWRITE_RULE[GSYM REAL_LT] o C SPEC FACT_LESS) tm in 95 GEN_TAC THEN REWRITE_TAC[exp] THEN MATCH_MP_TAC SUMMABLE_SUM THEN 96 MATCH_MP_TAC SER_RATIO THEN 97 MP_TAC (SPEC ���&1��� REAL_DOWN) THEN REWRITE_TAC[REAL_LT_01] THEN 98 DISCH_THEN(X_CHOOSE_THEN ���c:real��� STRIP_ASSUME_TAC) THEN 99 EXISTS_TAC ���c:real��� THEN ASM_REWRITE_TAC[] THEN 100 MP_TAC(SPEC ���c:real��� REAL_ARCH) THEN ASM_REWRITE_TAC[] THEN 101 DISCH_THEN(MP_TAC o SPEC ���abs(x)���) THEN 102 DISCH_THEN(X_CHOOSE_TAC ���N:num���) THEN EXISTS_TAC ���N:num��� THEN 103 X_GEN_TAC ���n:num��� THEN REWRITE_TAC[GREATER_EQ] THEN DISCH_TAC THEN BETA_TAC THEN 104 REWRITE_TAC[ADD1, POW_ADD, ABS_MUL, REAL_MUL_ASSOC, POW_1] THEN 105 GEN_REWR_TAC LAND_CONV [REAL_MUL_SYM] THEN 106 REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL_IMP THEN 107 REWRITE_TAC[ABS_POS] THEN REWRITE_TAC[GSYM ADD1, FACT] THEN 108 REWRITE_TAC[GSYM REAL_MUL, MATCH_MP REAL_INV_MUL (CONJ 109 (REWRITE_RULE[GSYM REAL_INJ] (SPEC ���n:num��� NOT_SUC)) (fnz ���n:num���))] THEN 110 REWRITE_TAC[ABS_MUL, REAL_MUL_ASSOC] THEN 111 MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN 112 MP_TAC(SPEC ���n:num��� LESS_0) THEN REWRITE_TAC[GSYM REAL_LT] THEN 113 DISCH_THEN(ASSUME_TAC o GSYM o MATCH_MP REAL_LT_IMP_NE) THEN 114 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP ABS_INV th]) THEN 115 REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LE_LDIV THEN 116 ASM_REWRITE_TAC[GSYM ABS_NZ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN 117 REWRITE_TAC[REWRITE_RULE[GSYM ABS_REFL, GSYM REAL_LE] ZERO_LESS_EQ] THEN 118 MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ���&N * c��� THEN CONJ_TAC THENL 119 [MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM ACCEPT_TAC, 120 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_LE_RMUL th]) THEN 121 REWRITE_TAC[REAL_LE] THEN MATCH_MP_TAC LESS_EQ_TRANS THEN 122 EXISTS_TAC ���n:num��� THEN ASM_REWRITE_TAC[LESS_EQ_SUC_REFL]] end); 123 124(*---------------------------------------------------------------------------*) 125(* Show by the comparison test that sin and cos converge *) 126(*---------------------------------------------------------------------------*) 127 128val SIN_CONVERGES = store_thm("SIN_CONVERGES", 129 ���!x. (\n. (^sin_ser) n * (x pow n)) sums sin(x)���, 130 GEN_TAC THEN REWRITE_TAC[sin] THEN MATCH_MP_TAC SUMMABLE_SUM THEN 131 MATCH_MP_TAC SER_COMPAR THEN 132 EXISTS_TAC ���\n. ^exp_ser n * (abs(x) pow n)��� THEN 133 REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL EXP_CONVERGES)] THEN 134 EXISTS_TAC ���0:num��� THEN X_GEN_TAC ���n:num��� THEN 135 DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN COND_CASES_TAC THEN 136 REWRITE_TAC[ABS_MUL, POW_ABS] THENL 137 [REWRITE_TAC[ABS_0, REAL_MUL_LZERO] THEN MATCH_MP_TAC REAL_LE_MUL THEN 138 REWRITE_TAC[ABS_POS], 139 REWRITE_TAC[real_div, ABS_MUL, POW_M1, REAL_MUL_LID] THEN 140 MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN 141 MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[ABS_REFL]] THEN 142 MAP_EVERY MATCH_MP_TAC [REAL_LT_IMP_LE, REAL_INV_POS] THEN 143 REWRITE_TAC[REAL_LT, FACT_LESS]); 144 145val COS_CONVERGES = store_thm("COS_CONVERGES", 146 ���!x. (\n. (^cos_ser) n * (x pow n)) sums cos(x)���, 147 GEN_TAC THEN REWRITE_TAC[cos] THEN MATCH_MP_TAC SUMMABLE_SUM THEN 148 MATCH_MP_TAC SER_COMPAR THEN 149 EXISTS_TAC ���\n. (^exp_ser) n * (abs(x) pow n)��� THEN 150 REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL EXP_CONVERGES)] THEN 151 EXISTS_TAC ���0:num��� THEN X_GEN_TAC ���n:num��� THEN 152 DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN COND_CASES_TAC THEN 153 REWRITE_TAC[ABS_MUL, POW_ABS] THENL 154 [REWRITE_TAC[real_div, ABS_MUL, POW_M1, REAL_MUL_LID] THEN 155 MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN 156 MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[ABS_REFL], 157 REWRITE_TAC[ABS_0, REAL_MUL_LZERO] THEN MATCH_MP_TAC REAL_LE_MUL THEN 158 REWRITE_TAC[ABS_POS]] THEN 159 MAP_EVERY MATCH_MP_TAC [REAL_LT_IMP_LE, REAL_INV_POS] THEN 160 REWRITE_TAC[REAL_LT, FACT_LESS]); 161 162(*---------------------------------------------------------------------------*) 163(* Show what the formal derivatives of these series are *) 164(*---------------------------------------------------------------------------*) 165 166val EXP_FDIFF = store_thm("EXP_FDIFF", 167 ���diffs ^exp_ser = ^exp_ser���, 168 REWRITE_TAC[diffs] THEN BETA_TAC THEN 169 CONV_TAC(X_FUN_EQ_CONV ���n:num���) THEN GEN_TAC THEN BETA_TAC THEN 170 REWRITE_TAC[FACT, GSYM REAL_MUL] THEN 171 SUBGOAL_THEN ���~(&(SUC n) = &0) /\ ~(&(FACT n) = &0)��� ASSUME_TAC THENL 172 [CONJ_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN 173 MATCH_MP_TAC REAL_LT_IMP_NE THEN 174 REWRITE_TAC[REAL_LT, LESS_0, FACT_LESS], 175 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_INV_MUL th]) THEN 176 GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN 177 REWRITE_TAC[REAL_MUL_ASSOC, REAL_EQ_RMUL] THEN DISJ2_TAC THEN 178 MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[]]); 179 180val SIN_FDIFF = store_thm("SIN_FDIFF", 181 ���diffs ^sin_ser = ^cos_ser���, 182 REWRITE_TAC[diffs] THEN BETA_TAC THEN 183 CONV_TAC(X_FUN_EQ_CONV ���n:num���) THEN GEN_TAC THEN BETA_TAC THEN 184 COND_CASES_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[EVEN]) THEN 185 ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN REWRITE_TAC[SUC_SUB1] THEN 186 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN 187 REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN 188 REWRITE_TAC[FACT, GSYM REAL_MUL] THEN 189 SUBGOAL_THEN ���~(&(SUC n) = &0) /\ ~(&(FACT n) = &0)��� ASSUME_TAC THENL 190 [CONJ_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN 191 MATCH_MP_TAC REAL_LT_IMP_NE THEN 192 REWRITE_TAC[REAL_LT, LESS_0, FACT_LESS], 193 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_INV_MUL th]) THEN 194 REWRITE_TAC[REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN 195 GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN 196 REWRITE_TAC[REAL_MUL_ASSOC, REAL_EQ_RMUL] THEN DISJ2_TAC THEN 197 MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[]]); 198 199val COS_FDIFF = store_thm("COS_FDIFF", 200 ���diffs ^cos_ser = (\n. ~((^sin_ser) n))���, 201 REWRITE_TAC[diffs] THEN BETA_TAC THEN 202 CONV_TAC(X_FUN_EQ_CONV ���n:num���) THEN GEN_TAC THEN BETA_TAC THEN 203 COND_CASES_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[EVEN]) THEN 204 ASM_REWRITE_TAC[REAL_MUL_RZERO, REAL_NEG_0] THEN 205 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN 206 REWRITE_TAC[real_div, REAL_NEG_LMUL] THEN 207 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN BINOP_TAC THENL 208 [POP_ASSUM(SUBST1_TAC o MATCH_MP EVEN_DIV2) THEN 209 REWRITE_TAC[pow] THEN REWRITE_TAC[GSYM REAL_NEG_MINUS1], 210 REWRITE_TAC[FACT, GSYM REAL_MUL] THEN 211 SUBGOAL_THEN ���~(&(SUC n) = &0) /\ ~(&(FACT n) = &0)��� ASSUME_TAC THENL 212 [CONJ_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN 213 MATCH_MP_TAC REAL_LT_IMP_NE THEN 214 REWRITE_TAC[REAL_LT, LESS_0, FACT_LESS], 215 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_INV_MUL th]) THEN 216 REWRITE_TAC[REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN 217 GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN 218 REWRITE_TAC[REAL_MUL_ASSOC, REAL_EQ_RMUL] THEN DISJ2_TAC THEN 219 MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[]]]); 220 221(*---------------------------------------------------------------------------*) 222(* Now at last we can get the derivatives of exp, sin and cos *) 223(*---------------------------------------------------------------------------*) 224 225val SIN_NEGLEMMA = store_thm("SIN_NEGLEMMA", 226 ���!x. ~(sin x) = suminf (\n. ~((^sin_ser) n * (x pow n)))���, 227 GEN_TAC THEN MATCH_MP_TAC SUM_UNIQ THEN 228 MP_TAC(MATCH_MP SER_NEG (SPEC ���x:real��� SIN_CONVERGES)) THEN 229 BETA_TAC THEN DISCH_THEN ACCEPT_TAC); 230 231val DIFF_EXP = store_thm("DIFF_EXP", 232 ���!x. (exp diffl exp(x))(x)���, 233 GEN_TAC THEN REWRITE_TAC[HALF_MK_ABS exp] THEN 234 GEN_REWR_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM EXP_FDIFF] THEN 235 CONV_TAC(LAND_CONV BETA_CONV) THEN 236 MATCH_MP_TAC TERMDIFF THEN EXISTS_TAC ���abs(x) + &1��� THEN 237 REWRITE_TAC[EXP_FDIFF, MATCH_MP SUM_SUMMABLE (SPEC_ALL EXP_CONVERGES)] THEN 238 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���abs(x) + &1��� THEN 239 REWRITE_TAC[ABS_LE, REAL_LT_ADDR] THEN 240 REWRITE_TAC[REAL_LT, ONE, LESS_0]); 241 242val DIFF_SIN = store_thm("DIFF_SIN", 243 ���!x. (sin diffl cos(x))(x)���, 244 GEN_TAC THEN REWRITE_TAC[HALF_MK_ABS sin, cos] THEN 245 ONCE_REWRITE_TAC[GSYM SIN_FDIFF] THEN 246 MATCH_MP_TAC TERMDIFF THEN EXISTS_TAC ���abs(x) + &1��� THEN 247 REPEAT CONJ_TAC THENL 248 [REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL SIN_CONVERGES)], 249 REWRITE_TAC[SIN_FDIFF, MATCH_MP SUM_SUMMABLE (SPEC_ALL COS_CONVERGES)], 250 REWRITE_TAC[SIN_FDIFF, COS_FDIFF] THEN BETA_TAC THEN 251 MP_TAC(SPEC ���abs(x) + &1��� SIN_CONVERGES) THEN 252 DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN 253 DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN BETA_TAC THEN 254 REWRITE_TAC[GSYM REAL_NEG_LMUL], 255 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���abs(x) + &1��� THEN 256 REWRITE_TAC[ABS_LE, REAL_LT_ADDR] THEN 257 REWRITE_TAC[REAL_LT, ONE, LESS_0]]); 258 259val DIFF_COS = store_thm("DIFF_COS", 260 ���!x. (cos diffl ~(sin(x)))(x)���, 261 GEN_TAC THEN REWRITE_TAC[HALF_MK_ABS cos, SIN_NEGLEMMA] THEN 262 ONCE_REWRITE_TAC[REAL_NEG_LMUL] THEN 263 REWRITE_TAC[GSYM(CONV_RULE(RAND_CONV BETA_CONV) 264 (AP_THM COS_FDIFF ���n:num���))] THEN 265 MATCH_MP_TAC TERMDIFF THEN EXISTS_TAC ���abs(x) + &1��� THEN 266 REPEAT CONJ_TAC THENL 267 [REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL COS_CONVERGES)], 268 REWRITE_TAC[COS_FDIFF] THEN 269 MP_TAC(SPEC ���abs(x) + &1��� SIN_CONVERGES) THEN 270 DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN 271 DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN BETA_TAC THEN 272 REWRITE_TAC[GSYM REAL_NEG_LMUL], 273 REWRITE_TAC[COS_FDIFF, DIFFS_NEG] THEN 274 MP_TAC SIN_FDIFF THEN BETA_TAC THEN 275 DISCH_THEN(fn th => REWRITE_TAC[th]) THEN 276 MP_TAC(SPEC ���abs(x) + &1��� COS_CONVERGES) THEN 277 DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN 278 DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN BETA_TAC THEN 279 REWRITE_TAC[GSYM REAL_NEG_LMUL], 280 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���abs(x) + &1��� THEN 281 REWRITE_TAC[ABS_LE, REAL_LT_ADDR] THEN 282 REWRITE_TAC[REAL_LT, ONE, LESS_0]]); 283 284val _ = basic_diffs := !basic_diffs@[DIFF_EXP, DIFF_SIN, DIFF_COS]; 285 286 287(* ------------------------------------------------------------------------- *) 288(* Processed versions of composition theorems. *) 289(* ------------------------------------------------------------------------- *) 290 291val DIFF_COMPOSITE = store_thm("DIFF_COMPOSITE", 292 Term 293 `((f diffl l)(x) /\ ~(f(x) = &0) ==> 294 ((\x. inv(f x)) diffl ~(l / (f(x) pow 2)))(x)) /\ 295 ((f diffl l)(x) /\ (g diffl m)(x) /\ ~(g(x) = &0) ==> 296 ((\x. f(x) / g(x)) diffl (((l * g(x)) - (m * f(x))) 297 / (g(x) pow 2)))(x)) /\ 298 ((f diffl l)(x) /\ (g diffl m)(x) ==> 299 ((\x. f(x) + g(x)) diffl (l + m))(x)) /\ 300 ((f diffl l)(x) /\ (g diffl m)(x) ==> 301 ((\x. f(x) * g(x)) diffl ((l * g(x)) + (m * f(x))))(x)) /\ 302 ((f diffl l)(x) /\ (g diffl m)(x) ==> 303 ((\x. f(x) - g(x)) diffl (l - m))(x)) /\ 304 ((f diffl l)(x) ==> ((\x. ~(f x)) diffl ~l)(x)) /\ 305 ((g diffl m)(x) ==> 306 ((\x. (g x) pow n) diffl ((&n * (g x) pow (n - 1)) * m))(x)) /\ 307 ((g diffl m)(x) ==> ((\x. exp(g x)) diffl (exp(g x) * m))(x)) /\ 308 ((g diffl m)(x) ==> ((\x. sin(g x)) diffl (cos(g x) * m))(x)) /\ 309 ((g diffl m)(x) ==> ((\x. cos(g x)) diffl (~(sin(g x)) * m))(x))`, 310 REWRITE_TAC[DIFF_INV, DIFF_DIV, DIFF_ADD, DIFF_SUB, DIFF_MUL, DIFF_NEG] THEN 311 REPEAT CONJ_TAC THEN DISCH_TAC THEN 312 TRY(MATCH_MP_TAC DIFF_CHAIN THEN 313 ASM_REWRITE_TAC[DIFF_SIN, DIFF_COS, DIFF_EXP]) THEN 314 MATCH_MP_TAC(BETA_RULE (SPEC (Term`\x. x pow n`) DIFF_CHAIN)) THEN 315 ASM_REWRITE_TAC[DIFF_POW]); 316 317val _ = basic_diffs := !basic_diffs @ CONJUNCTS DIFF_COMPOSITE; 318 319 320(*---------------------------------------------------------------------------*) 321(* Properties of the exponential function *) 322(*---------------------------------------------------------------------------*) 323 324val EXP_0 = store_thm("EXP_0", 325 ���exp(&0) = &1���, 326 REWRITE_TAC[exp] THEN CONV_TAC SYM_CONV THEN 327 MATCH_MP_TAC SUM_UNIQ THEN BETA_TAC THEN 328 W(MP_TAC o C SPEC SER_0 o rand o rator o snd) THEN 329 DISCH_THEN(MP_TAC o SPEC ���1:num���) THEN 330 REWRITE_TAC[ONE, sum] THEN 331 REWRITE_TAC[ADD_CLAUSES, REAL_ADD_LID] THEN BETA_TAC THEN 332 REWRITE_TAC[FACT, pow, REAL_MUL_RID, REAL_INV1] THEN 333 REWRITE_TAC[SYM(ONE)] THEN DISCH_THEN MATCH_MP_TAC THEN 334 X_GEN_TAC ���n:num��� THEN REWRITE_TAC[ONE, GSYM LESS_EQ] THEN 335 DISCH_THEN(CHOOSE_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN 336 REWRITE_TAC[GSYM ADD1, POW_0, REAL_MUL_RZERO, ADD_CLAUSES]); 337 338val EXP_LE_X = store_thm("EXP_LE_X", 339���!x. &0 <= x ==> (&1 + x) <= exp(x)���, 340GEN_TAC THEN DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL 341 [MP_TAC(SPECL [Term`\n. ^exp_ser n * (x pow n)`,Term`2:num`] SER_POS_LE) THEN 342 REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL EXP_CONVERGES)] THEN 343 REWRITE_TAC[GSYM exp] THEN BETA_TAC THEN 344 W(C SUBGOAL_THEN (fn t => REWRITE_TAC[t]) o 345 funpow 2 (fst o dest_imp) o snd) THENL 346 [GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN 347 MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL 348 [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_INV_POS THEN 349 REWRITE_TAC[REAL_LT, FACT_LESS], 350 MATCH_MP_TAC POW_POS THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN 351 FIRST_ASSUM ACCEPT_TAC], 352 CONV_TAC(TOP_DEPTH_CONV num_CONV) THEN REWRITE_TAC[sum] THEN 353 BETA_TAC THEN REWRITE_TAC[ADD_CLAUSES, FACT, pow, REAL_ADD_LID] THEN 354 (* new term nets require change in proof; old: 355 REWRITE_TAC[MULT_CLAUSES, REAL_INV1, REAL_MUL_LID, ADD_CLAUSES] THEN 356 REWRITE_TAC[REAL_MUL_RID, SYM(ONE)] 357 *) 358 REWRITE_TAC[MULT_RIGHT_1, CONJUNCT1 MULT,REAL_INV1, 359 REAL_MUL_LID, ADD_CLAUSES,REAL_MUL_RID, SYM(ONE)]], 360 POP_ASSUM(SUBST1_TAC o SYM) THEN 361 REWRITE_TAC[EXP_0, REAL_ADD_RID, REAL_LE_REFL]]); 362 363val EXP_LT_1 = store_thm("EXP_LT_1", 364 ���!x. &0 < x ==> &1 < exp(x)���, 365 GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN 366 EXISTS_TAC ���&1 + x��� THEN ASM_REWRITE_TAC[REAL_LT_ADDR] THEN 367 MATCH_MP_TAC EXP_LE_X THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN 368 POP_ASSUM ACCEPT_TAC); 369 370val EXP_ADD_MUL = store_thm("EXP_ADD_MUL", 371 ���!x y. exp(x + y) * exp(~x) = exp(y)���, 372 REPEAT GEN_TAC THEN 373 CONV_TAC(LAND_CONV(X_BETA_CONV ���x:real���)) THEN 374 SUBGOAL_THEN ���exp(y) = (\x. exp(x + y) * exp(~x))(&0)��� SUBST1_TAC THENL 375 [BETA_TAC THEN REWRITE_TAC[REAL_ADD_LID, REAL_NEG_0] THEN 376 REWRITE_TAC[EXP_0, REAL_MUL_RID], 377 MATCH_MP_TAC DIFF_ISCONST_ALL THEN X_GEN_TAC ���x:real��� THEN 378 W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN 379 DISCH_THEN(MP_TAC o SPEC ���x:real���) THEN 380 MATCH_MP_TAC(TAUT_CONV ���(a = b) ==> a ==> b���) THEN AP_THM_TAC THEN 381 AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL, GSYM REAL_NEG_RMUL] THEN 382 REWRITE_TAC[GSYM real_sub, REAL_SUB_0, REAL_MUL_RID, REAL_ADD_RID] THEN 383 MATCH_ACCEPT_TAC REAL_MUL_SYM]); 384 385val EXP_NEG_MUL = store_thm("EXP_NEG_MUL", 386 ���!x. exp(x) * exp(~x) = &1���, 387 GEN_TAC THEN MP_TAC(SPECL [���x:real���, ���&0���] EXP_ADD_MUL) THEN 388 REWRITE_TAC[REAL_ADD_RID, EXP_0]); 389 390val EXP_NEG_MUL2 = store_thm("EXP_NEG_MUL2", 391 ���!x. exp(~x) * exp(x) = &1���, 392 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC EXP_NEG_MUL); 393 394val EXP_NEG = store_thm("EXP_NEG", 395 ���!x. exp(~x) = inv(exp(x))���, 396 GEN_TAC THEN MATCH_MP_TAC REAL_RINV_UNIQ THEN 397 MATCH_ACCEPT_TAC EXP_NEG_MUL); 398 399val EXP_ADD = store_thm("EXP_ADD", 400 ���!x y. exp(x + y) = exp(x) * exp(y)���, 401 REPEAT GEN_TAC THEN 402 MP_TAC(SPECL [���x:real���, ���y:real���] EXP_ADD_MUL) THEN 403 DISCH_THEN(MP_TAC o C AP_THM ���exp(x)��� o AP_TERM ���$*���) THEN 404 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN 405 REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] EXP_NEG_MUL, REAL_MUL_RID] THEN 406 DISCH_THEN SUBST1_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM); 407 408val EXP_POS_LE = store_thm("EXP_POS_LE", 409 ���!x. &0 <= exp(x)���, 410 GEN_TAC THEN 411 GEN_REWR_TAC (funpow 2 RAND_CONV) [GSYM REAL_HALF_DOUBLE] THEN 412 REWRITE_TAC[EXP_ADD] THEN MATCH_ACCEPT_TAC REAL_LE_SQUARE); 413 414val EXP_NZ = store_thm("EXP_NZ", 415 ���!x. ~(exp(x) = &0)���, 416 GEN_TAC THEN DISCH_TAC THEN 417 MP_TAC(SPEC ���x:real��� EXP_NEG_MUL) THEN 418 ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN 419 CONV_TAC(RAND_CONV SYM_CONV) THEN 420 MATCH_ACCEPT_TAC REAL_10); 421 422val EXP_POS_LT = store_thm("EXP_POS_LT", 423 ���!x. &0 < exp(x)���, 424 GEN_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN 425 CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN 426 REWRITE_TAC[EXP_POS_LE, EXP_NZ]); 427 428val EXP_N = store_thm("EXP_N", 429 ���!n x. exp(&n * x) = exp(x) pow n���, 430 INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO, EXP_0, pow] THEN 431 REWRITE_TAC[ADD1] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN 432 REWRITE_TAC[GSYM REAL_ADD, EXP_ADD, REAL_RDISTRIB] THEN 433 GEN_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LID]); 434 435val EXP_SUB = store_thm("EXP_SUB", 436 ���!x y. exp(x - y) = exp(x) / exp(y)���, 437 REPEAT GEN_TAC THEN 438 REWRITE_TAC[real_sub, real_div, EXP_ADD, EXP_NEG]); 439 440val EXP_MONO_IMP = store_thm("EXP_MONO_IMP", 441 ���!x y. x < y ==> exp(x) < exp(y)���, 442 REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o 443 MATCH_MP EXP_LT_1 o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN 444 REWRITE_TAC[EXP_SUB] THEN 445 SUBGOAL_THEN ���&1 < exp(y) / exp(x) = 446 (&1 * exp(x)) < ((exp(y) / exp(x)) * exp(x))��� SUBST1_TAC THENL 447 [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_LT_RMUL THEN 448 MATCH_ACCEPT_TAC EXP_POS_LT, 449 REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC, EXP_NEG_MUL2, GSYM EXP_NEG] THEN 450 REWRITE_TAC[REAL_MUL_LID, REAL_MUL_RID]]); 451 452val EXP_MONO_LT = store_thm("EXP_MONO_LT", 453 ���!x y. exp(x) < exp(y) = x < y���, 454 REPEAT GEN_TAC THEN EQ_TAC THENL 455 [CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_NOT_LT] THEN 456 REWRITE_TAC[REAL_LE_LT] THEN 457 DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC SUBST1_TAC) THEN 458 REWRITE_TAC[] THEN DISJ1_TAC THEN MATCH_MP_TAC EXP_MONO_IMP THEN 459 POP_ASSUM ACCEPT_TAC, 460 MATCH_ACCEPT_TAC EXP_MONO_IMP]); 461 462val EXP_MONO_LE = store_thm("EXP_MONO_LE", 463 ���!x y. exp(x) <= exp(y) = x <= y���, 464 REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN 465 REWRITE_TAC[EXP_MONO_LT]); 466 467val EXP_INJ = store_thm("EXP_INJ", 468 ���!x y. (exp(x) = exp(y)) = (x = y)���, 469 REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN 470 REWRITE_TAC[EXP_MONO_LE]); 471 472val EXP_TOTAL_LEMMA = store_thm("EXP_TOTAL_LEMMA", 473 ���!y. &1 <= y ==> ?x. &0 <= x /\ x <= y - &1 /\ (exp(x) = y)���, 474 GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC IVT THEN 475 ASM_REWRITE_TAC[EXP_0, REAL_LE_SUB_LADD, REAL_ADD_LID] THEN CONJ_TAC THENL 476 [RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM REAL_SUB_LE]) THEN 477 POP_ASSUM(MP_TAC o MATCH_MP EXP_LE_X) THEN REWRITE_TAC[REAL_SUB_ADD2], 478 X_GEN_TAC ���x:real��� THEN DISCH_THEN(K ALL_TAC) THEN 479 MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC ���exp(x)��� THEN 480 MATCH_ACCEPT_TAC DIFF_EXP]); 481 482val EXP_TOTAL = store_thm("EXP_TOTAL", 483 ���!y. &0 < y ==> ?x. exp(x) = y���, 484 GEN_TAC THEN DISCH_TAC THEN 485 DISJ_CASES_TAC(SPECL [���&1���, ���y:real���] REAL_LET_TOTAL) THENL 486 [FIRST_ASSUM(X_CHOOSE_TAC ���x:real��� o MATCH_MP EXP_TOTAL_LEMMA) THEN 487 EXISTS_TAC ���x:real��� THEN ASM_REWRITE_TAC[], 488 MP_TAC(SPEC ���y:real��� REAL_INV_LT1) THEN ASM_REWRITE_TAC[] THEN 489 DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN 490 DISCH_THEN(X_CHOOSE_TAC ���x:real��� o MATCH_MP EXP_TOTAL_LEMMA) THEN 491 Q.EXISTS_TAC ���~x��� THEN ASM_REWRITE_TAC[EXP_NEG] THEN 492 MATCH_MP_TAC REAL_INVINV THEN CONV_TAC(RAND_CONV SYM_CONV) THEN 493 MATCH_MP_TAC REAL_LT_IMP_NE THEN ASM_REWRITE_TAC[]]); 494 495(* new 496let REAL_EXP_BOUND_LEMMA = prove 497 (`!x. &0 <= x /\ x <= inv(&2) ==> exp(x) <= &1 + &2 * x`, 498 GEN_TAC THEN DISCH_TAC THEN 499 MATCH_MP_TAC REAL_LE_TRANS THEN 500 EXISTS_TAC `suminf (\n. x pow n)` THEN CONJ_TAC THENL 501 [REWRITE_TAC[exp; BETA_THM] THEN MATCH_MP_TAC SER_LE THEN 502 REWRITE_TAC[summable; BETA_THM] THEN REPEAT CONJ_TAC THENL 503 [GEN_TAC THEN 504 GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN 505 MATCH_MP_TAC REAL_LE_RMUL_IMP THEN CONJ_TAC THENL 506 [MATCH_MP_TAC REAL_POW_LE THEN ASM_REWRITE_TAC[]; 507 MATCH_MP_TAC REAL_INV_LE_1 THEN 508 REWRITE_TAC[REAL_OF_NUM_LE; num_CONV `1`; LE_SUC_LT] THEN 509 REWRITE_TAC[FACT_LT]]; 510 EXISTS_TAC `exp x` THEN REWRITE_TAC[BETA_RULE REAL_EXP_CONVERGES]; 511 EXISTS_TAC `inv(&1 - x)` THEN MATCH_MP_TAC GP THEN 512 ASM_REWRITE_TAC[real_abs] THEN 513 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2)` THEN 514 ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV]; 515 SUBGOAL_THEN `suminf (\n. x pow n) = inv (&1 - x)` SUBST1_TAC THENL 516 [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNIQ THEN 517 MATCH_MP_TAC GP THEN 518 ASM_REWRITE_TAC[real_abs] THEN 519 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2)` THEN 520 ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV; 521 MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN 522 EXISTS_TAC `&1 - x` THEN 523 SUBGOAL_THEN `(&1 - x) * inv (&1 - x) = &1` SUBST1_TAC THENL 524 [MATCH_MP_TAC REAL_MUL_RINV THEN 525 REWRITE_TAC[REAL_ARITH `(&1 - x = &0) = (x = &1)`] THEN 526 DISCH_THEN SUBST_ALL_TAC THEN 527 POP_ASSUM MP_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV; 528 CONJ_TAC THENL 529 [MATCH_MP_TAC REAL_LET_TRANS THEN 530 EXISTS_TAC `inv(&2) - x` THEN 531 ASM_REWRITE_TAC[REAL_ARITH `&0 <= x - y = y <= x`] THEN 532 ASM_REWRITE_TAC[REAL_ARITH `a - x < b - x = a < b`] THEN 533 CONV_TAC REAL_RAT_REDUCE_CONV; 534 REWRITE_TAC[REAL_ADD_LDISTRIB; REAL_SUB_RDISTRIB] THEN 535 REWRITE_TAC[REAL_MUL_RID; REAL_MUL_LID] THEN 536 REWRITE_TAC[REAL_ARITH `&1 <= (&1 + &2 * x) - (x + x * &2 * x) = 537 x * (&2 * x) <= x * &1`] THEN 538 MATCH_MP_TAC REAL_LE_LMUL_IMP THEN ASM_REWRITE_TAC[] THEN 539 MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `inv(&2)` THEN 540 REWRITE_TAC[REAL_MUL_ASSOC] THEN 541 CONV_TAC REAL_RAT_REDUCE_CONV THEN 542 ASM_REWRITE_TAC[REAL_MUL_LID; real_div]]]]]);; 543end new*) 544 545(*---------------------------------------------------------------------------*) 546(* Properties of the logarithmic function *) 547(*---------------------------------------------------------------------------*) 548 549val ln = new_definition("ln", 550 ���ln x = @u. exp(u) = x���); 551 552val LN_EXP = store_thm("LN_EXP", 553 ���!x. ln(exp x) = x���, 554 GEN_TAC THEN REWRITE_TAC[ln, EXP_INJ] THEN 555 CONV_TAC SYM_CONV THEN CONV_TAC(RAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN 556 CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN MATCH_MP_TAC SELECT_AX THEN 557 EXISTS_TAC ���x:real��� THEN REFL_TAC); 558 559val EXP_LN = store_thm("EXP_LN", 560 ���!x. (exp(ln x) = x) = &0 < x���, 561 GEN_TAC THEN EQ_TAC THENL 562 [DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_ACCEPT_TAC EXP_POS_LT, 563 DISCH_THEN(X_CHOOSE_THEN ���y:real��� MP_TAC o MATCH_MP EXP_TOTAL) THEN 564 DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[EXP_INJ, LN_EXP]]); 565 566val LN_MUL = store_thm("LN_MUL", 567 ���!x y. &0 < x /\ &0 < y ==> (ln(x * y) = ln(x) + ln(y))���, 568 REPEAT GEN_TAC THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM EXP_INJ] THEN 569 REWRITE_TAC[EXP_ADD] THEN SUBGOAL_THEN ���&0 < x * y��� ASSUME_TAC THENL 570 [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[], 571 EVERY_ASSUM(fn th => REWRITE_TAC[ONCE_REWRITE_RULE[GSYM EXP_LN] th])]); 572 573val LN_INJ = store_thm("LN_INJ", 574 ���!x y. &0 < x /\ &0 < y ==> ((ln(x) = ln(y)) = (x = y))���, 575 REPEAT GEN_TAC THEN STRIP_TAC THEN 576 EVERY_ASSUM(fn th => GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV) 577 [SYM(REWRITE_RULE[GSYM EXP_LN] th)]) THEN 578 CONV_TAC SYM_CONV THEN MATCH_ACCEPT_TAC EXP_INJ); 579 580val LN_1 = store_thm("LN_1", 581 ���ln(&1) = &0���, 582 ONCE_REWRITE_TAC[GSYM EXP_INJ] THEN 583 REWRITE_TAC[EXP_0, EXP_LN, REAL_LT_01]); 584 585val LN_INV = store_thm("LN_INV", 586 ���!x. &0 < x ==> (ln(inv x) = ~(ln x))���, 587 GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_RNEG_UNIQ] THEN 588 SUBGOAL_THEN ���&0 < x /\ &0 < inv(x)��� MP_TAC THENL 589 [CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_INV_POS) THEN ASM_REWRITE_TAC[], 590 DISCH_THEN(fn th => REWRITE_TAC[GSYM(MATCH_MP LN_MUL th)]) THEN 591 SUBGOAL_THEN ���x * (inv x) = &1��� SUBST1_TAC THENL 592 [MATCH_MP_TAC REAL_MUL_RINV THEN 593 POP_ASSUM(ACCEPT_TAC o MATCH_MP REAL_POS_NZ), 594 REWRITE_TAC[LN_1]]]); 595 596val LN_DIV = store_thm("LN_DIV", 597 ���!x y. &0 < x /\ &0 < y ==> (ln(x / y) = ln(x) - ln(y))���, 598 REPEAT GEN_TAC THEN STRIP_TAC THEN 599 SUBGOAL_THEN ���&0 < x /\ &0 < inv(y)��� MP_TAC THENL 600 [CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_INV_POS) THEN ASM_REWRITE_TAC[], 601 REWRITE_TAC[real_div] THEN 602 DISCH_THEN(fn th => REWRITE_TAC[MATCH_MP LN_MUL th]) THEN 603 REWRITE_TAC[MATCH_MP LN_INV (ASSUME ���&0 < y���)] THEN 604 REWRITE_TAC[real_sub]]); 605 606val LN_MONO_LT = store_thm("LN_MONO_LT", 607 ���!x y. &0 < x /\ &0 < y ==> (ln(x) < ln(y) = x < y)���, 608 REPEAT GEN_TAC THEN STRIP_TAC THEN 609 EVERY_ASSUM(fn th => GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV) 610 [SYM(REWRITE_RULE[GSYM EXP_LN] th)]) THEN 611 CONV_TAC SYM_CONV THEN MATCH_ACCEPT_TAC EXP_MONO_LT); 612 613val LN_MONO_LE = store_thm("LN_MONO_LE", 614 ���!x y. &0 < x /\ &0 < y ==> (ln(x) <= ln(y) = x <= y)���, 615 REPEAT GEN_TAC THEN STRIP_TAC THEN 616 EVERY_ASSUM(fn th => GEN_REWR_TAC (RAND_CONV o ONCE_DEPTH_CONV) 617 [SYM(REWRITE_RULE[GSYM EXP_LN] th)]) THEN 618 CONV_TAC SYM_CONV THEN MATCH_ACCEPT_TAC EXP_MONO_LE); 619 620val LN_POW = store_thm("LN_POW", 621 ���!n x. &0 < x ==> (ln(x pow n) = &n * ln(x))���, 622 REPEAT GEN_TAC THEN 623 DISCH_THEN(CHOOSE_THEN (SUBST1_TAC o SYM) o MATCH_MP EXP_TOTAL) THEN 624 REWRITE_TAC[GSYM EXP_N, LN_EXP]); 625 626 627val LN_LE = store_thm("LN_LE", 628 Term `!x. &0 <= x ==> ln(&1 + x) <= x`, 629 GEN_TAC THEN DISCH_TAC THEN 630 GEN_REWRITE_TAC RAND_CONV [] [GSYM LN_EXP] THEN 631 MP_TAC(SPECL [Term`&1 + x`, Term`exp x`] LN_MONO_LE) THEN 632 W(C SUBGOAL_THEN (fn t => REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) 633 THENL 634 [REWRITE_TAC[EXP_POS_LT] THEN MATCH_MP_TAC REAL_LET_TRANS THEN 635 EXISTS_TAC (Term`x:real`) THEN ASM_REWRITE_TAC[REAL_LT_ADDL, REAL_LT_01], 636 DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC EXP_LE_X THEN ASM_REWRITE_TAC[]]);; 637 638 639val LN_LT_X = store_thm("LN_LT_X", 640 ���!x. &0 < x ==> ln(x) < x���, 641 GEN_TAC THEN DISCH_TAC THEN 642 GEN_REWR_TAC I [TAUT_CONV ���a:bool = ~~a���] THEN 643 PURE_REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN 644 MP_TAC(SPEC ���ln(x)��� EXP_LE_X) THEN 645 SUBGOAL_THEN ���&0 <= ln(x)��� ASSUME_TAC THENL 646 [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ���x:real��� THEN 647 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE, ALL_TAC] THEN 648 ASM_REWRITE_TAC[] THEN MP_TAC(SPEC ���x:real��� EXP_LN) THEN 649 ASM_REWRITE_TAC[] THEN 650 DISCH_THEN SUBST1_TAC THEN DISCH_TAC THEN 651 SUBGOAL_THEN ���(&1 + ln(x)) <= ln(x)��� MP_TAC THENL 652 [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ���x:real���, ALL_TAC] THEN 653 ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_NOT_LE] THEN 654 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ���&0 + ln(x)��� THEN 655 REWRITE_TAC[REAL_LT_RADD, REAL_LT_01] THEN 656 REWRITE_TAC[REAL_ADD_LID, REAL_LE_REFL]); 657 658val LN_POS = store_thm("LN_POS", 659 Term `!x. &1 <= x ==> &0 <= ln(x)`, 660 GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN (Term `&0 < x`) ASSUME_TAC THENL 661 [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC (Term`&1`) THEN 662 ASM_REWRITE_TAC[REAL_LT_01], 663 UNDISCH_TAC (Term`&1 <= x`) THEN SUBST1_TAC(SYM EXP_0) THEN 664 POP_ASSUM(MP_TAC o REWRITE_RULE[GSYM EXP_LN]) THEN 665 DISCH_THEN(fn th => GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [] [SYM th]) 666 THEN REWRITE_TAC[EXP_MONO_LE]]);; 667 668 669val DIFF_LN = store_thm("DIFF_LN", 670 Term `!x. &0 < x ==> (ln diffl (inv x))(x)`, 671 GEN_TAC THEN DISCH_TAC THEN 672 FIRST_ASSUM(ASSUME_TAC o REWRITE_RULE[GSYM EXP_LN]) THEN 673 FIRST_ASSUM (fn th => GEN_REWRITE_TAC RAND_CONV [] [GSYM th]) THEN 674 MATCH_MP_TAC DIFF_INVERSE_LT THEN 675 FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_POS_NZ) THEN 676 ASM_REWRITE_TAC[MATCH_MP DIFF_CONT (SPEC_ALL DIFF_EXP)] THEN 677 MP_TAC(SPEC (Term`ln(x)`) DIFF_EXP) THEN ASM_REWRITE_TAC[] THEN 678 DISCH_TAC THEN ASM_REWRITE_TAC[LN_EXP] THEN 679 EXISTS_TAC (Term`&1`) THEN MATCH_ACCEPT_TAC REAL_LT_01);; 680 681 682(*---------------------------------------------------------------------------*) 683(* Some properties of roots (easier via logarithms) *) 684(*---------------------------------------------------------------------------*) 685 686val root = new_definition("root", 687 ���root(n) x = @u. (&0 < x ==> &0 < u) /\ (u pow n = x)���); 688 689val sqrt = new_definition("sqrt", 690 ���sqrt(x) = root(2) x���); 691 692val ROOT_LT_LEMMA = store_thm("ROOT_LT_LEMMA", 693 ���!n x. &0 < x ==> (exp(ln(x) / &(SUC n)) pow (SUC n) = x)���, 694 REPEAT GEN_TAC THEN DISCH_TAC THEN 695 REWRITE_TAC[GSYM EXP_N] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN 696 REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN 697 SUBGOAL_THEN ���inv(&(SUC n)) * &(SUC n) = &1��� SUBST1_TAC THENL 698 [MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_INJ, NOT_SUC], 699 ASM_REWRITE_TAC[REAL_MUL_RID, EXP_LN]]); 700 701val ROOT_LN = store_thm("ROOT_LN", 702 ���!n x. &0 < x ==> (root(SUC n) x = exp(ln(x) / &(SUC n)))���, 703 REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[root] THEN 704 MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC ���y:real��� THEN BETA_TAC THEN 705 ASM_REWRITE_TAC[] THEN EQ_TAC THENL 706 [DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN 707 SUBGOAL_THEN ���!z. &0 < y /\ &0 < exp(z)��� MP_TAC THENL 708 [ASM_REWRITE_TAC[EXP_POS_LT], ALL_TAC] THEN 709 DISCH_THEN(MP_TAC o GEN_ALL o SYM o MATCH_MP LN_INJ o SPEC_ALL) THEN 710 DISCH_THEN(fn th => GEN_REWR_TAC I [th]) THEN 711 REWRITE_TAC[LN_EXP] THEN 712 SUBGOAL_THEN ���ln(y) * &(SUC n) = (ln(y pow(SUC n)) / &(SUC n)) * &(SUC n)��� 713 MP_TAC THENL 714 [REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN 715 SUBGOAL_THEN ���inv(&(SUC n)) * &(SUC n) = &1��� SUBST1_TAC THENL 716 [MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_INJ, NOT_SUC], 717 REWRITE_TAC[REAL_MUL_RID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN 718 CONV_TAC SYM_CONV THEN MATCH_MP_TAC LN_POW THEN 719 ASM_REWRITE_TAC[]], 720 REWRITE_TAC[REAL_EQ_RMUL, REAL_INJ, NOT_SUC]], 721 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[EXP_POS_LT] THEN 722 MATCH_MP_TAC ROOT_LT_LEMMA THEN ASM_REWRITE_TAC[]]); 723 724val ROOT_0 = store_thm("ROOT_0", 725 ���!n. root(SUC n) (&0) = &0���, 726 GEN_TAC THEN REWRITE_TAC[root] THEN 727 MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC ���y:real��� THEN 728 BETA_TAC THEN REWRITE_TAC[REAL_LT_REFL] THEN EQ_TAC THENL 729 [SPEC_TAC(���n:num���,���n:num���) THEN INDUCT_TAC THEN ONCE_REWRITE_TAC[pow] THENL 730 [REWRITE_TAC[pow, REAL_MUL_RID], 731 REWRITE_TAC[REAL_ENTIRE] THEN DISCH_THEN DISJ_CASES_TAC THEN 732 ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN 733 ASM_REWRITE_TAC[]], 734 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[pow, REAL_MUL_LZERO]]); 735 736val ROOT_1 = store_thm("ROOT_1", 737 ���!n. root(SUC n) (&1) = &1���, 738 GEN_TAC THEN REWRITE_TAC[MATCH_MP ROOT_LN REAL_LT_01] THEN 739 REWRITE_TAC[LN_1, REAL_DIV_LZERO, EXP_0]); 740 741val ROOT_POS_LT = store_thm("ROOT_POS_LT", 742 ���!n x. &0 < x ==> &0 < root(SUC n) x���, 743 REPEAT GEN_TAC THEN 744 DISCH_THEN(fn th => REWRITE_TAC[MATCH_MP ROOT_LN th]) THEN 745 REWRITE_TAC[EXP_POS_LT]); 746 747val ROOT_POW_POS = store_thm("ROOT_POW_POS", 748 ���!n x. &0 <= x ==> ((root(SUC n) x) pow (SUC n) = x)���, 749 REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN 750 DISCH_THEN DISJ_CASES_TAC THENL 751 [FIRST_ASSUM(fn th => REWRITE_TAC 752 [MATCH_MP ROOT_LN th, MATCH_MP ROOT_LT_LEMMA th]), 753 FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[ROOT_0] THEN 754 MATCH_ACCEPT_TAC POW_0]); 755 756val POW_ROOT_POS = store_thm("POW_ROOT_POS", 757 ���!n x. &0 <= x ==> (root(SUC n)(x pow (SUC n)) = x)���, 758 REPEAT GEN_TAC THEN DISCH_TAC THEN 759 REWRITE_TAC[root] THEN MATCH_MP_TAC SELECT_UNIQUE THEN 760 X_GEN_TAC ���y:real��� THEN BETA_TAC THEN EQ_TAC THEN 761 DISCH_TAC THEN ASM_REWRITE_TAC[] THENL 762 [DISJ_CASES_THEN MP_TAC (REWRITE_RULE[REAL_LE_LT] (ASSUME ���&0 <= x���)) THENL 763 [DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o assert is_conj o concl) THEN 764 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP POW_POS_LT th]) THEN 765 DISCH_TAC THEN MATCH_MP_TAC POW_EQ THEN EXISTS_TAC ���n:num��� THEN 766 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN 767 ASM_REWRITE_TAC[], 768 DISCH_THEN(SUBST_ALL_TAC o SYM) THEN 769 FIRST_ASSUM(UNDISCH_TAC o assert is_conj o concl) THEN 770 REWRITE_TAC[POW_0, REAL_LT_REFL, POW_ZERO]], 771 ASM_REWRITE_TAC[REAL_LT_LE] THEN CONV_TAC CONTRAPOS_CONV THEN 772 REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN 773 REWRITE_TAC[POW_0]]); 774 775 776(* Known in GTT as ROOT_POS_POSITIVE *) 777val ROOT_POS = store_thm("ROOT_POS", 778 ���!n x. &0 <= x ==> &0 <= root(SUC n) x���, 779 REPEAT GEN_TAC THEN 780 DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL 781 [MAP_EVERY MATCH_MP_TAC [REAL_LT_IMP_LE, ROOT_POS_LT] THEN 782 POP_ASSUM ACCEPT_TAC, 783 POP_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[ROOT_0, REAL_LE_REFL]]); 784 785val ROOT_POS_UNIQ = store_thm("ROOT_POS_UNIQ", 786 Term`!n x y. &0 <= x /\ &0 <= y /\ (y pow (SUC n) = x) 787 ==> (root (SUC n) x = y)`, 788 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN 789 DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (SUBST1_TAC o SYM)) THEN 790 REWRITE_TAC[POW_ROOT_POS]);; 791 792val ROOT_MUL = store_thm("ROOT_MUL", 793 Term`!n x y. &0 <= x /\ &0 <= y 794 ==> (root(SUC n) (x * y) = root(SUC n) x * root(SUC n) y)`, 795 REPEAT STRIP_TAC THEN MATCH_MP_TAC ROOT_POS_UNIQ THEN 796 REWRITE_TAC [POW_MUL] THEN REPEAT CONJ_TAC THENL 797 [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[], 798 MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THEN MATCH_MP_TAC ROOT_POS 799 THEN ASM_REWRITE_TAC[], 800 IMP_RES_TAC ROOT_POW_POS THEN ASM_REWRITE_TAC[]]); 801 802 803val ROOT_INV = store_thm("ROOT_INV", 804 Term`!n x. &0 <= x ==> (root(SUC n) (inv x) = inv(root(SUC n) x))`, 805REPEAT STRIP_TAC THEN MATCH_MP_TAC ROOT_POS_UNIQ THEN REPEAT CONJ_TAC THENL 806 [IMP_RES_THEN ACCEPT_TAC REAL_LE_INV, 807 MATCH_MP_TAC REAL_LE_INV THEN IMP_RES_THEN (TRY o MATCH_ACCEPT_TAC) ROOT_POS, 808 IMP_RES_TAC ROOT_POW_POS THEN MP_TAC (SPEC_ALL ROOT_POS) 809 THEN ASM_REWRITE_TAC [] THEN REWRITE_TAC [REAL_LE_LT] 810 THEN STRIP_TAC THENL 811 [IMP_RES_TAC REAL_POS_NZ THEN IMP_RES_THEN (fn th => 812 REWRITE_TAC [GSYM th]) POW_INV THEN ASM_REWRITE_TAC[], 813 POP_ASSUM (ASSUME_TAC o SYM) THEN ASM_REWRITE_TAC[] THEN 814 PAT_X_ASSUM (Term `$! M`) (SUBST1_TAC o SYM o SPEC_ALL) 815 THEN ASM_REWRITE_TAC[REAL_INV_0,POW_0]]]) 816 817val ROOT_DIV = store_thm("ROOT_DIV", 818 Term`!n x y. &0 <= x /\ &0 <= y 819 ==> (root(SUC n) (x / y) = root(SUC n) x / root(SUC n) y)`, 820REWRITE_TAC [real_div] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC REAL_LE_INV 821 THEN MP_TAC (SPECL [Term`n:num`, Term`x:real`, Term`inv y`] ROOT_MUL) 822 THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] 823 THEN IMP_RES_TAC (SPECL [Term`n:num`, Term`y:real`] ROOT_INV) 824 THEN ASM_REWRITE_TAC[]); 825 826 827val ROOT_MONO_LE = store_thm("ROOT_MONO_LE", 828 Term`!x y. &0 <= x /\ x <= y ==> root(SUC n) x <= root(SUC n) y`, 829 REPEAT STRIP_TAC THEN SUBGOAL_THEN (Term`&0 <= y`) ASSUME_TAC THENL 830 [ASM_MESON_TAC[REAL_LE_TRANS], ALL_TAC] THEN 831 UNDISCH_TAC (Term`x <= y`) THEN CONV_TAC CONTRAPOS_CONV THEN 832 REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN 833 SUBGOAL_THEN (Term `(x = (root(SUC n) x) pow (SUC n)) /\ 834 (y = (root(SUC n) y) pow (SUC n))`) 835 (CONJUNCTS_THEN SUBST1_TAC) 836 THENL [IMP_RES_TAC (GSYM ROOT_POW_POS) THEN ASM_MESON_TAC[], ALL_TAC] THEN 837 MATCH_MP_TAC REAL_POW_LT2 THEN 838 ASM_REWRITE_TAC[NOT_SUC] THEN MATCH_MP_TAC ROOT_POS THEN ASM_REWRITE_TAC[]); 839 840val SQRT_0 = store_thm("SQRT_0", 841 ���sqrt(&0) = &0���, 842 REWRITE_TAC[sqrt, TWO, ROOT_0]); 843 844val SQRT_1 = store_thm("SQRT_1", 845 ���sqrt(&1) = &1���, 846 REWRITE_TAC[sqrt, TWO, ROOT_1]); 847 848val SQRT_POS_LT = store_thm("SQRT_POS_LT", 849 Term`!x. &0 < x ==> &0 < sqrt(x)`, 850 REWRITE_TAC [sqrt,TWO] THEN REPEAT STRIP_TAC 851 THEN IMP_RES_TAC ROOT_LN THEN ASM_REWRITE_TAC[EXP_POS_LT]); 852 853val SQRT_POS_LE = store_thm("SQRT_POS_LE", 854 Term`!x. &0 <= x ==> &0 <= sqrt(x)`, 855 REWRITE_TAC[REAL_LE_LT] THEN MESON_TAC[SQRT_POS_LT, SQRT_0]);; 856 857val SQRT_POW2 = store_thm("SQRT_POW2", 858 ���!x. (sqrt(x) pow 2 = x) = &0 <= x���, 859 GEN_TAC THEN EQ_TAC THENL 860 [DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_ACCEPT_TAC REAL_LE_POW2, 861 REWRITE_TAC[sqrt, TWO, ROOT_POW_POS]]); 862 863val SQRT_POW_2 = store_thm("SQRT_POW_2", 864 Term `!x. &0 <= x ==> (sqrt(x) pow 2 = x)`, 865 REWRITE_TAC[SQRT_POW2]);; 866 867val POW_2_SQRT = store_thm("POW_2_SQRT", 868 Term`&0 <= x ==> (sqrt(x pow 2) = x)`, 869 REWRITE_TAC [sqrt,TWO,POW_ROOT_POS]); 870 871val SQRT_POS_UNIQ = store_thm("SQRT_POS_UNIQ", 872 Term`!x y. &0 <= x /\ &0 <= y /\ (y pow 2 = x) 873 ==> (sqrt x = y)`, 874 REWRITE_TAC[sqrt, TWO, ROOT_POS_UNIQ]); 875 876val SQRT_MUL = store_thm("SQRT_MUL", 877 Term`!x y. &0 <= x /\ &0 <= y 878 ==> (sqrt(x * y) = sqrt x * sqrt y)`, 879 REWRITE_TAC[sqrt, TWO, ROOT_MUL]);; 880 881val SQRT_INV = store_thm("SQRT_INV", 882 Term`!x. &0 <= x ==> (sqrt (inv x) = inv(sqrt x))`, 883 REWRITE_TAC[sqrt, TWO, ROOT_INV]);; 884 885val SQRT_DIV = store_thm("SQRT_DIV", 886 Term`!x y. &0 <= x /\ &0 <= y 887 ==> (sqrt (x / y) = sqrt x / sqrt y)`, 888 REWRITE_TAC[sqrt, TWO, ROOT_DIV]);; 889 890val SQRT_MONO_LE = store_thm("SQRT_MONO_LE", 891 Term`!x y. &0 <= x /\ x <= y ==> sqrt(x) <= sqrt(y)`, 892 REWRITE_TAC[sqrt, TWO, ROOT_MONO_LE]);; 893 894val lem = prove(Term`0<2:num`, REWRITE_TAC[TWO,LESS_0]); 895 896val EVEN_MOD = prove 897 (Term `!n. EVEN(n) = (n MOD 2 = 0)`, 898 GEN_TAC THEN REWRITE_TAC[EVEN_EXISTS] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN 899 EQ_TAC THEN STRIP_TAC THENL 900 [ASM_REWRITE_TAC [MP (SPEC (Term`2:num`) MOD_EQ_0) lem], 901 EXISTS_TAC (Term `n DIV 2`) THEN 902 MP_TAC (CONJUNCT1 (SPEC (Term `n:num`) (MATCH_MP DIVISION lem))) THEN 903 ASM_REWRITE_TAC [ADD_CLAUSES]]); 904 905val SQRT_EVEN_POW2 = store_thm("SQRT_EVEN_POW2", 906 Term`!n. EVEN n ==> (sqrt(&2 pow n) = &2 pow (n DIV 2))`, 907 GEN_TAC THEN REWRITE_TAC[EVEN_MOD] THEN DISCH_TAC THEN 908 MATCH_MP_TAC SQRT_POS_UNIQ THEN REPEAT CONJ_TAC THENL 909 [MATCH_MP_TAC POW_POS THEN REWRITE_TAC [REAL_POS], 910 MATCH_MP_TAC POW_POS THEN REWRITE_TAC [REAL_POS], 911 REWRITE_TAC [REAL_POW_POW] THEN AP_TERM_TAC THEN 912 MP_TAC (CONJUNCT1 (SPEC (Term `n:num`) (MATCH_MP DIVISION lem))) 913 THEN ASM_REWRITE_TAC [ADD_CLAUSES] THEN DISCH_THEN (SUBST1_TAC o SYM) 914 THEN REFL_TAC]); 915 916 917val REAL_DIV_SQRT = store_thm("REAL_DIV_SQRT", 918 Term`!x. &0 <= x ==> (x / sqrt(x) = sqrt(x))`, 919 GEN_TAC THEN ASM_CASES_TAC (Term`x = &0`) THENL 920 [ASM_REWRITE_TAC[SQRT_0, real_div, REAL_MUL_LZERO], ALL_TAC] THEN 921 DISCH_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SQRT_POS_UNIQ THEN 922 ASM_REWRITE_TAC[] THEN IMP_RES_TAC SQRT_POS_LE THEN 923 MP_TAC (SPECL[Term`x:real`, Term`sqrt x`] REAL_LE_DIV) THEN ASM_REWRITE_TAC[] 924 THEN DISCH_THEN (fn th => CONJ_TAC THENL [ACCEPT_TAC th, ALL_TAC]) THEN 925 REWRITE_TAC[real_div, POW_MUL] THEN PAT_X_ASSUM (Term`_ <= sqrt _`) MP_TAC 926 THEN REWRITE_TAC [REAL_LE_LT] THEN STRIP_TAC THENL 927 [IMP_RES_TAC REAL_POS_NZ THEN IMP_RES_THEN (fn th => 928 REWRITE_TAC [GSYM th]) POW_INV THEN IMP_RES_THEN (fn th => 929 REWRITE_TAC [th]) SQRT_POW_2 THEN REWRITE_TAC[POW_2, GSYM REAL_MUL_ASSOC] 930 THEN IMP_RES_THEN (fn th => REWRITE_TAC [th]) REAL_MUL_RINV THEN 931 REWRITE_TAC [REAL_MUL_RID], 932 PAT_X_ASSUM (Term `& 0 <= x`) MP_TAC THEN 933 REWRITE_TAC [REAL_LE_LT] THEN STRIP_TAC THENL 934 [IMP_RES_TAC SQRT_POS_LT THEN 935 PAT_X_ASSUM (Term `& 0 = _`) (SUBST_ALL_TAC o SYM) THEN 936 IMP_RES_TAC REAL_LT_REFL, 937 PAT_X_ASSUM (Term `& 0 = _`) (SUBST_ALL_TAC o SYM) 938 THEN REWRITE_TAC [POW_0, TWO, REAL_MUL_LZERO]]]); 939 940val SQRT_EQ = store_thm("SQRT_EQ", 941 ���!x y. (x pow 2 = y) /\ (&0 <= x) ==> (x = (sqrt(y)))���, 942 REPEAT GEN_TAC THEN STRIP_TAC THEN 943 SUBGOAL_THEN ���&0 <= y��� ASSUME_TAC THENL 944 [FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[POW_2, REAL_LE_SQUARE], 945 ALL_TAC] THEN 946 MP_TAC(SPECL [���1:num���, ���y:real���] ROOT_POW_POS) THEN 947 ASM_REWRITE_TAC[GSYM(TWO), GSYM sqrt] THEN 948 FIRST_ASSUM(fn th => GEN_REWR_TAC (LAND_CONV o RAND_CONV) [SYM th]) THEN 949 GEN_REWR_TAC LAND_CONV [GSYM REAL_SUB_0] THEN 950 REWRITE_TAC[POW_2, GSYM REAL_DIFFSQ, REAL_ENTIRE] THEN 951 REWRITE_TAC[REAL_SUB_0] THEN 952 DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN 953 SUBGOAL_THEN ���&0 <= sqrt(y)��� ASSUME_TAC THENL 954 [REWRITE_TAC[sqrt, TWO] THEN MATCH_MP_TAC ROOT_POS THEN 955 ASM_REWRITE_TAC[], ALL_TAC] THEN 956 SUBGOAL_THEN ���x = &0��� SUBST_ALL_TAC THENL 957 [ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN 958 GEN_REWR_TAC I [TAUT_CONV ���a:bool = ~~a���] THEN 959 PURE_REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN 960 UNDISCH_TAC ���sqrt(y) + x = &0��� THEN REWRITE_TAC[] THEN 961 MATCH_MP_TAC REAL_POS_NZ THEN 962 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ���sqrt(y)��� THEN 963 ASM_REWRITE_TAC[REAL_LT_ADDR], 964 UNDISCH_TAC ���&0 pow 2 = y��� THEN REWRITE_TAC[POW_0, TWO] THEN 965 DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[SQRT_0]]); 966 967(*---------------------------------------------------------------------------*) 968(* Basic properties of the trig functions *) 969(*---------------------------------------------------------------------------*) 970 971val SIN_0 = store_thm("SIN_0", 972 ���sin(&0) = &0���, 973 REWRITE_TAC[sin] THEN CONV_TAC SYM_CONV THEN 974 MATCH_MP_TAC SUM_UNIQ THEN BETA_TAC THEN 975 W(MP_TAC o C SPEC SER_0 o rand o rator o snd) THEN 976 DISCH_THEN(MP_TAC o SPEC ���0:num���) THEN REWRITE_TAC[ZERO_LESS_EQ] THEN 977 BETA_TAC THEN 978 REWRITE_TAC[sum] THEN DISCH_THEN MATCH_MP_TAC THEN 979 X_GEN_TAC ���n:num��� THEN COND_CASES_TAC THEN 980 ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN 981 MP_TAC(SPEC ���n:num��� ODD_EXISTS) THEN ASM_REWRITE_TAC[ODD_EVEN] THEN 982 DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN 983 REWRITE_TAC[GSYM ADD1, POW_0, REAL_MUL_RZERO]); 984 985val COS_0 = store_thm("COS_0", 986 ���cos(&0) = &1���, 987 REWRITE_TAC[cos] THEN CONV_TAC SYM_CONV THEN 988 MATCH_MP_TAC SUM_UNIQ THEN BETA_TAC THEN 989 W(MP_TAC o C SPEC SER_0 o rand o rator o snd) THEN 990 DISCH_THEN(MP_TAC o SPEC ���1:num���) THEN 991 REWRITE_TAC[ONE, sum, ADD_CLAUSES] THEN BETA_TAC THEN 992 REWRITE_TAC[EVEN, pow, FACT] THEN 993 REWRITE_TAC[REAL_ADD_LID, REAL_MUL_RID] THEN 994 SUBGOAL_THEN ���0 DIV 2 = 0��� SUBST1_TAC THENL 995 [MATCH_MP_TAC DIV_UNIQUE THEN EXISTS_TAC ���0:num��� THEN 996 REWRITE_TAC[MULT_CLAUSES, ADD_CLAUSES] THEN 997 REWRITE_TAC[TWO, LESS_0], 998 REWRITE_TAC[pow]] THEN 999 SUBGOAL_THEN ���&1 / &1 = &(SUC 0)��� SUBST1_TAC THENL 1000 [REWRITE_TAC[SYM(ONE)] THEN MATCH_MP_TAC REAL_DIV_REFL THEN 1001 MATCH_ACCEPT_TAC REAL_10, 1002 DISCH_THEN MATCH_MP_TAC] THEN 1003 X_GEN_TAC ���n:num��� THEN REWRITE_TAC[GSYM LESS_EQ] THEN 1004 DISCH_THEN(CHOOSE_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN 1005 REWRITE_TAC[GSYM ADD1, POW_0, REAL_MUL_RZERO, ADD_CLAUSES]); 1006 1007val SIN_CIRCLE = store_thm("SIN_CIRCLE", 1008 ���!x. (sin(x) pow 2) + (cos(x) pow 2) = &1���, 1009 GEN_TAC THEN CONV_TAC(LAND_CONV(X_BETA_CONV ���x:real���)) THEN 1010 SUBGOAL_THEN ���&1 = (\x.(sin(x) pow 2) + (cos(x) pow 2))(&0)��� SUBST1_TAC THENL 1011 [BETA_TAC THEN REWRITE_TAC[SIN_0, COS_0] THEN 1012 REWRITE_TAC[TWO, POW_0] THEN 1013 REWRITE_TAC[pow, POW_1] THEN REWRITE_TAC[REAL_ADD_LID, REAL_MUL_LID], 1014 MATCH_MP_TAC DIFF_ISCONST_ALL THEN X_GEN_TAC ���x:real��� THEN 1015 W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN 1016 DISCH_THEN(MP_TAC o SPEC ���x:real���) THEN 1017 MATCH_MP_TAC(TAUT_CONV ���(a = b) ==> a ==> b���) THEN AP_THM_TAC THEN 1018 AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL, GSYM REAL_NEG_RMUL] THEN 1019 REWRITE_TAC[GSYM real_sub, REAL_SUB_0] THEN 1020 REWRITE_TAC[GSYM REAL_MUL_ASSOC, REAL_MUL_RID] THEN 1021 AP_TERM_TAC THEN REWRITE_TAC[TWO, SUC_SUB1] THEN 1022 REWRITE_TAC[POW_1] THEN MATCH_ACCEPT_TAC REAL_MUL_SYM]); 1023 1024val SIN_BOUND = store_thm("SIN_BOUND", 1025 ���!x. abs(sin x) <= &1���, 1026 GEN_TAC THEN GEN_REWR_TAC I [TAUT_CONV ���a:bool = ~~a���] THEN 1027 PURE_ONCE_REWRITE_TAC[REAL_NOT_LE] THEN 1028 DISCH_THEN(MP_TAC o MATCH_MP REAL_LT1_POW2) THEN 1029 REWRITE_TAC[REAL_POW2_ABS] THEN 1030 DISCH_THEN(MP_TAC o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN 1031 DISCH_THEN(MP_TAC o C CONJ(SPEC ���cos(x)��� REAL_LE_SQUARE)) THEN 1032 REWRITE_TAC[GSYM POW_2] THEN 1033 DISCH_THEN(MP_TAC o MATCH_MP REAL_LTE_ADD) THEN 1034 REWRITE_TAC[real_sub, GSYM REAL_ADD_ASSOC] THEN 1035 ONCE_REWRITE_TAC[AC(REAL_ADD_ASSOC,REAL_ADD_SYM) 1036 ���a + (b + c) = (a + c) + b���] THEN 1037 REWRITE_TAC[SIN_CIRCLE, REAL_ADD_RINV, REAL_LT_REFL]); 1038 1039val SIN_BOUNDS = store_thm("SIN_BOUNDS", 1040 ���!x. ~(&1) <= sin(x) /\ sin(x) <= &1���, 1041 GEN_TAC THEN REWRITE_TAC[GSYM ABS_BOUNDS, SIN_BOUND]); 1042 1043val COS_BOUND = store_thm("COS_BOUND", 1044 ���!x. abs(cos x) <= &1���, 1045 GEN_TAC THEN GEN_REWR_TAC I [TAUT_CONV ���a:bool = ~~a���] THEN 1046 PURE_ONCE_REWRITE_TAC[REAL_NOT_LE] THEN 1047 DISCH_THEN(MP_TAC o MATCH_MP REAL_LT1_POW2) THEN 1048 REWRITE_TAC[REAL_POW2_ABS] THEN 1049 DISCH_THEN(MP_TAC o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN 1050 DISCH_THEN(MP_TAC o CONJ(SPEC ���sin(x)��� REAL_LE_SQUARE)) THEN 1051 REWRITE_TAC[GSYM POW_2] THEN 1052 DISCH_THEN(MP_TAC o MATCH_MP REAL_LET_ADD) THEN 1053 REWRITE_TAC[real_sub, REAL_ADD_ASSOC, SIN_CIRCLE, 1054 REAL_ADD_ASSOC, SIN_CIRCLE, REAL_ADD_RINV, REAL_LT_REFL]); 1055 1056val COS_BOUNDS = store_thm("COS_BOUNDS", 1057 ���!x. ~(&1) <= cos(x) /\ cos(x) <= &1���, 1058 GEN_TAC THEN REWRITE_TAC[GSYM ABS_BOUNDS, COS_BOUND]); 1059 1060val SIN_COS_ADD = store_thm("SIN_COS_ADD", 1061 ���!x y. ((sin(x + y) - ((sin(x) * cos(y)) + (cos(x) * sin(y)))) pow 2) + 1062 ((cos(x + y) - ((cos(x) * cos(y)) - (sin(x) * sin(y)))) pow 2) = &0���, 1063 REPEAT GEN_TAC THEN 1064 CONV_TAC(LAND_CONV(X_BETA_CONV ���x:real���)) THEN 1065 W(C SUBGOAL_THEN (SUBST1_TAC o SYM) o subst[(���&0���,���x:real���)] o snd) THENL 1066 [BETA_TAC THEN REWRITE_TAC[SIN_0, COS_0] THEN 1067 REWRITE_TAC[REAL_ADD_LID, REAL_MUL_LZERO, REAL_MUL_LID] THEN 1068 REWRITE_TAC[REAL_SUB_RZERO, REAL_SUB_REFL] THEN 1069 REWRITE_TAC[TWO, POW_0, REAL_ADD_LID], 1070 MATCH_MP_TAC DIFF_ISCONST_ALL THEN GEN_TAC THEN 1071 W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN 1072 REDUCE_TAC THEN REWRITE_TAC[POW_1] THEN 1073 REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_RID, REAL_MUL_RID] THEN 1074 DISCH_THEN(MP_TAC o SPEC ���x:real���) THEN 1075 MATCH_MP_TAC(TAUT_CONV ���(a = b) ==> a ==> b���) THEN AP_THM_TAC THEN 1076 AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL] THEN 1077 ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN 1078 REWRITE_TAC[REAL_SUB_LZERO, GSYM REAL_MUL_ASSOC] THEN 1079 REWRITE_TAC[REAL_NEG_RMUL] THEN AP_TERM_TAC THEN 1080 GEN_REWR_TAC RAND_CONV [REAL_MUL_SYM] THEN BINOP_TAC THENL 1081 [REWRITE_TAC[real_sub, REAL_NEG_ADD, REAL_NEGNEG, REAL_NEG_RMUL], 1082 REWRITE_TAC[GSYM REAL_NEG_RMUL, GSYM real_sub]]]); 1083 1084val SIN_COS_NEG = store_thm("SIN_COS_NEG", 1085 ���!x. ((sin(~x) + (sin x)) pow 2) + 1086 ((cos(~x) - (cos x)) pow 2) = &0���, 1087 GEN_TAC THEN CONV_TAC(LAND_CONV(X_BETA_CONV ���x:real���)) THEN 1088 W(C SUBGOAL_THEN (SUBST1_TAC o SYM) o subst[(���&0���,���x:real���)] o snd) THENL 1089 [BETA_TAC THEN REWRITE_TAC[SIN_0, COS_0, REAL_NEG_0] THEN 1090 REWRITE_TAC[REAL_ADD_LID, REAL_SUB_REFL] THEN 1091 REWRITE_TAC[TWO, POW_0, REAL_ADD_LID], 1092 MATCH_MP_TAC DIFF_ISCONST_ALL THEN GEN_TAC THEN 1093 W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN 1094 REDUCE_TAC THEN REWRITE_TAC[POW_1] THEN 1095 DISCH_THEN(MP_TAC o SPEC ���x:real���) THEN 1096 MATCH_MP_TAC(TAUT_CONV ���(a = b) ==> a ==> b���) THEN AP_THM_TAC THEN 1097 AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_RMUL] THEN 1098 REWRITE_TAC[REAL_MUL_RID, real_sub, REAL_NEGNEG, GSYM REAL_MUL_ASSOC] THEN 1099 ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN 1100 REWRITE_TAC[REAL_SUB_LZERO, REAL_NEG_RMUL] THEN AP_TERM_TAC THEN 1101 GEN_REWR_TAC RAND_CONV [REAL_MUL_SYM] THEN 1102 REWRITE_TAC[GSYM REAL_NEG_LMUL, REAL_NEG_RMUL] THEN AP_TERM_TAC THEN 1103 REWRITE_TAC[REAL_NEG_ADD, REAL_NEGNEG]]); 1104 1105val SIN_ADD = store_thm("SIN_ADD", 1106 ���!x y. sin(x + y) = (sin(x) * cos(y)) + (cos(x) * sin(y))���, 1107 REPEAT GEN_TAC THEN MP_TAC(SPECL [���x:real���, ���y:real���] SIN_COS_ADD) THEN 1108 REWRITE_TAC[POW_2, REAL_SUMSQ] THEN REWRITE_TAC[REAL_SUB_0] THEN 1109 DISCH_THEN(fn th => REWRITE_TAC[th])); 1110 1111val COS_ADD = store_thm("COS_ADD", 1112 ���!x y. cos(x + y) = (cos(x) * cos(y)) - (sin(x) * sin(y))���, 1113 REPEAT GEN_TAC THEN MP_TAC(SPECL [���x:real���, ���y:real���] SIN_COS_ADD) THEN 1114 REWRITE_TAC[POW_2, REAL_SUMSQ] THEN REWRITE_TAC[REAL_SUB_0] THEN 1115 DISCH_THEN(fn th => REWRITE_TAC[th])); 1116 1117val SIN_NEG = store_thm("SIN_NEG", 1118 ���!x. sin(~x) = ~(sin(x))���, 1119 GEN_TAC THEN MP_TAC(SPEC ���x:real��� SIN_COS_NEG) THEN 1120 REWRITE_TAC[POW_2, REAL_SUMSQ] THEN REWRITE_TAC[REAL_LNEG_UNIQ] THEN 1121 DISCH_THEN(fn th => REWRITE_TAC[th])); 1122 1123val COS_NEG = store_thm("COS_NEG", 1124 ���!x. cos(~x) = cos(x)���, 1125 GEN_TAC THEN MP_TAC(SPEC ���x:real��� SIN_COS_NEG) THEN 1126 REWRITE_TAC[POW_2, REAL_SUMSQ] THEN REWRITE_TAC[REAL_SUB_0] THEN 1127 DISCH_THEN(fn th => REWRITE_TAC[th])); 1128 1129val SIN_DOUBLE = store_thm("SIN_DOUBLE", 1130 ���!x. sin(&2 * x) = &2 * (sin(x) * cos(x))���, 1131 GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE, SIN_ADD] THEN 1132 AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM); 1133 1134val COS_DOUBLE = store_thm("COS_DOUBLE", 1135 ���!x. cos(&2 * x) = (cos(x) pow 2) - (sin(x) pow 2)���, 1136 GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE, COS_ADD, POW_2]); 1137 1138(*---------------------------------------------------------------------------*) 1139(* Show that there's a least positive x with cos(x) = 0; hence define pi *) 1140(*---------------------------------------------------------------------------*) 1141 1142val SIN_PAIRED = store_thm("SIN_PAIRED", 1143 ���!x. (\n. (((~(&1)) pow n) / &(FACT((2 * n) + 1))) 1144 * (x pow ((2 * n) + 1))) sums (sin x)���, 1145 GEN_TAC THEN MP_TAC(SPEC ���x:real��� SIN_CONVERGES) THEN 1146 DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN 1147 DISCH_THEN(MP_TAC o MATCH_MP SER_PAIR) THEN REWRITE_TAC[GSYM sin] THEN 1148 BETA_TAC THEN REWRITE_TAC[SUM_2] THEN BETA_TAC THEN 1149 REWRITE_TAC[GSYM ADD1, EVEN_DOUBLE, REWRITE_RULE[ODD_EVEN] ODD_DOUBLE] THEN 1150 REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_LID, SUC_SUB1, MULT_DIV_2]); 1151 1152val SIN_POS = store_thm("SIN_POS", 1153 ���!x. &0 < x /\ x < &2 ==> &0 < sin(x)���, 1154 GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPEC ���x:real��� SIN_PAIRED) THEN 1155 DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN 1156 DISCH_THEN(MP_TAC o MATCH_MP SER_PAIR) THEN 1157 REWRITE_TAC[SYM(MATCH_MP SUM_UNIQ (SPEC ���x:real��� SIN_PAIRED))] THEN 1158 REWRITE_TAC[SUM_2] THEN BETA_TAC THEN REWRITE_TAC[GSYM ADD1] THEN 1159 REWRITE_TAC[pow, GSYM REAL_NEG_MINUS1, POW_MINUS1] THEN 1160 REWRITE_TAC[real_div, GSYM REAL_NEG_LMUL, GSYM real_sub] THEN 1161 REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[ADD1] THEN DISCH_TAC THEN 1162 FIRST_ASSUM(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN 1163 W(C SUBGOAL_THEN SUBST1_TAC o curry mk_eq ���&0��� o curry mk_comb ���sum(0,0)��� o 1164 funpow 2 rand o snd) THENL [REWRITE_TAC[sum], ALL_TAC] THEN 1165 MATCH_MP_TAC SER_POS_LT THEN 1166 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP SUM_SUMMABLE th]) THEN 1167 X_GEN_TAC ���n:num��� THEN DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN 1168 REWRITE_TAC[GSYM ADD1, MULT_CLAUSES] THEN 1169 REWRITE_TAC[TWO, ADD_CLAUSES, pow, FACT, GSYM REAL_MUL] THEN 1170 REWRITE_TAC[SYM(TWO)] THEN 1171 REWRITE_TAC[ONE, ADD_CLAUSES, pow, FACT, GSYM REAL_MUL] THEN 1172 REWRITE_TAC[REAL_SUB_LT] THEN ONCE_REWRITE_TAC[GSYM pow] THEN 1173 REWRITE_TAC[REAL_MUL_ASSOC] THEN 1174 MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL 1175 [ALL_TAC, MATCH_MP_TAC POW_POS_LT THEN ASM_REWRITE_TAC[]] THEN 1176 REWRITE_TAC[GSYM REAL_MUL_ASSOC, GSYM POW_2] THEN 1177 SUBGOAL_THEN ���!n. &0 < &(SUC n)��� ASSUME_TAC THENL 1178 [GEN_TAC THEN REWRITE_TAC[REAL_LT, LESS_0], ALL_TAC] THEN 1179 SUBGOAL_THEN ���!n. &0 < &(FACT n)��� ASSUME_TAC THENL 1180 [GEN_TAC THEN REWRITE_TAC[REAL_LT, FACT_LESS], ALL_TAC] THEN 1181 SUBGOAL_THEN ���!n. ~(&(SUC n) = &0)��� ASSUME_TAC THENL 1182 [GEN_TAC THEN REWRITE_TAC[REAL_INJ, NOT_SUC], ALL_TAC] THEN 1183 SUBGOAL_THEN ���!n. ~(&(FACT n) = &0)��� ASSUME_TAC THENL 1184 [GEN_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN 1185 REWRITE_TAC[REAL_LT, FACT_LESS], ALL_TAC] THEN 1186 REPEAT(IMP_SUBST_TAC REAL_INV_MUL THEN ASM_REWRITE_TAC[REAL_ENTIRE]) THEN 1187 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN 1188 ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM) 1189 ���a * (b * (c * (d * e))) = 1190 (a * (b * e)) * (c * d)���] THEN 1191 GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN 1192 MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL 1193 [ALL_TAC, MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THEN 1194 MATCH_MP_TAC REAL_INV_POS THEN ASM_REWRITE_TAC[]] THEN 1195 REWRITE_TAC[REAL_MUL_ASSOC] THEN 1196 IMP_SUBST_TAC ((CONV_RULE(RAND_CONV SYM_CONV) o SPEC_ALL) REAL_INV_MUL) THEN 1197 ASM_REWRITE_TAC[REAL_ENTIRE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN 1198 REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LT_1 THEN 1199 REWRITE_TAC[POW_2] THEN CONJ_TAC THENL 1200 [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC, 1201 MATCH_MP_TAC REAL_LT_MUL2 THEN REPEAT CONJ_TAC] THEN 1202 TRY(MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[] THEN NO_TAC) THENL 1203 [W(curry op THEN (MATCH_MP_TAC REAL_LT_TRANS) o EXISTS_TAC o 1204 curry mk_comb ���(&)��� o funpow 3 rand o snd) THEN 1205 REWRITE_TAC[REAL_LT, LESS_SUC_REFL], ALL_TAC] THEN 1206 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���&2��� THEN 1207 ASM_REWRITE_TAC[] THEN CONV_TAC(REDEPTH_CONV num_CONV) THEN 1208 REWRITE_TAC[REAL_LE, LESS_EQ_MONO, ZERO_LESS_EQ]); 1209 1210val COS_PAIRED = store_thm("COS_PAIRED", 1211 ���!x. (\n. (((~(&1)) pow n) / &(FACT(2 * n))) 1212 * (x pow (2 * n))) sums (cos x)���, 1213 GEN_TAC THEN MP_TAC(SPEC ���x:real��� COS_CONVERGES) THEN 1214 DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN 1215 DISCH_THEN(MP_TAC o MATCH_MP SER_PAIR) THEN REWRITE_TAC[GSYM cos] THEN 1216 BETA_TAC THEN REWRITE_TAC[SUM_2] THEN BETA_TAC THEN 1217 REWRITE_TAC[GSYM ADD1, EVEN_DOUBLE, REWRITE_RULE[ODD_EVEN] ODD_DOUBLE] THEN 1218 REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_RID, MULT_DIV_2]); 1219 1220val COS_2 = store_thm("COS_2", 1221 ���cos(&2) < &0���, 1222 GEN_REWR_TAC LAND_CONV [GSYM REAL_NEGNEG] THEN 1223 REWRITE_TAC[REAL_NEG_LT0] THEN MP_TAC(SPEC ���&2��� COS_PAIRED) THEN 1224 DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN BETA_TAC THEN 1225 DISCH_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN 1226 MATCH_MP_TAC REAL_LT_TRANS THEN 1227 EXISTS_TAC ���sum(0,3) (\n. ~((((~(&1)) pow n) / &(FACT(2 * n))) 1228 * (&2 pow (2 * n))))��� THEN CONJ_TAC THENL 1229 [REWRITE_TAC[num_CONV ���3:num���, sum, SUM_2] THEN BETA_TAC THEN 1230 REWRITE_TAC[MULT_CLAUSES, ADD_CLAUSES, pow, FACT] THEN 1231 REWRITE_TAC[REAL_MUL_RID, POW_1, POW_2, GSYM REAL_NEG_RMUL] THEN 1232 IMP_SUBST_TAC REAL_DIV_REFL THEN REWRITE_TAC[REAL_NEGNEG, REAL_10] THEN 1233 REDUCE_TAC THEN 1234 REWRITE_TAC[num_CONV ���4:num���, num_CONV ���3:num���, FACT, pow] THEN 1235 REWRITE_TAC[SYM(num_CONV ���4:num���), SYM(num_CONV ���3:num���)] THEN 1236 REWRITE_TAC[TWO, ONE, FACT, pow] THEN 1237 REWRITE_TAC[SYM(ONE), SYM(TWO)] THEN 1238 REWRITE_TAC[REAL_MUL] THEN REDUCE_TAC THEN 1239 REWRITE_TAC[real_div, REAL_NEG_LMUL, REAL_NEGNEG, REAL_MUL_LID] THEN 1240 REWRITE_TAC[GSYM REAL_NEG_LMUL, REAL_ADD_ASSOC] THEN 1241 REWRITE_TAC[GSYM real_sub, REAL_SUB_LT] THEN 1242 SUBGOAL_THEN ���inv(&2) * &4 = &1 + &1��� SUBST1_TAC THENL 1243 [MATCH_MP_TAC REAL_EQ_LMUL_IMP THEN EXISTS_TAC ���&2��� THEN 1244 REWRITE_TAC[REAL_INJ] THEN REDUCE_TAC THEN 1245 REWRITE_TAC[REAL_ADD, REAL_MUL] THEN REDUCE_TAC THEN 1246 REWRITE_TAC[REAL_MUL_ASSOC] THEN 1247 SUBGOAL_THEN ���&2 * inv(&2) = &1��� SUBST1_TAC THEN 1248 REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC REAL_MUL_RINV THEN 1249 REWRITE_TAC[REAL_INJ] THEN REDUCE_TAC, 1250 REWRITE_TAC[REAL_MUL_LID, REAL_ADD_ASSOC] THEN 1251 REWRITE_TAC[REAL_ADD_LINV, REAL_ADD_LID] THEN 1252 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN 1253 MATCH_MP_TAC REAL_LT_1 THEN REWRITE_TAC[REAL_LE, REAL_LT] THEN 1254 REDUCE_TAC], ALL_TAC] THEN 1255 MATCH_MP_TAC SER_POS_LT_PAIR THEN 1256 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP SUM_SUMMABLE th]) THEN 1257 X_GEN_TAC ���d:num��� THEN BETA_TAC THEN 1258 REWRITE_TAC[POW_ADD, POW_MINUS1, REAL_MUL_RID] THEN 1259 REWRITE_TAC[num_CONV ���3:num���, pow] THEN REWRITE_TAC[SYM(num_CONV ���3:num���)] THEN 1260 REWRITE_TAC[POW_2, POW_1] THEN 1261 REWRITE_TAC[GSYM REAL_NEG_MINUS1, REAL_NEGNEG] THEN 1262 REWRITE_TAC[real_div, GSYM REAL_NEG_LMUL, GSYM REAL_NEG_RMUL] THEN 1263 REWRITE_TAC[REAL_MUL_LID, REAL_NEGNEG] THEN 1264 REWRITE_TAC[GSYM real_sub, REAL_SUB_LT] THEN 1265 REWRITE_TAC[GSYM ADD1, ADD_CLAUSES, MULT_CLAUSES] THEN 1266 REWRITE_TAC[POW_ADD, REAL_MUL_ASSOC] THEN 1267 MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL 1268 [ALL_TAC, 1269 REWRITE_TAC[TWO, MULT_CLAUSES] THEN 1270 REWRITE_TAC[num_CONV ���3:num���, ADD_CLAUSES] THEN 1271 MATCH_MP_TAC POW_POS_LT THEN REWRITE_TAC[REAL_LT] THEN 1272 REDUCE_TAC] THEN 1273 REWRITE_TAC[TWO, ADD_CLAUSES, FACT] THEN 1274 REWRITE_TAC[SYM(TWO)] THEN 1275 REWRITE_TAC[ONE, ADD_CLAUSES, FACT] THEN 1276 REWRITE_TAC[SYM(ONE)] THEN 1277 SUBGOAL_THEN ���!n. &0 < &(SUC n)��� ASSUME_TAC THENL 1278 [GEN_TAC THEN REWRITE_TAC[REAL_LT, LESS_0], ALL_TAC] THEN 1279 SUBGOAL_THEN ���!n. &0 < &(FACT n)��� ASSUME_TAC THENL 1280 [GEN_TAC THEN REWRITE_TAC[REAL_LT, FACT_LESS], ALL_TAC] THEN 1281 SUBGOAL_THEN ���!n. ~(&(SUC n) = &0)��� ASSUME_TAC THENL 1282 [GEN_TAC THEN REWRITE_TAC[REAL_INJ, NOT_SUC], ALL_TAC] THEN 1283 SUBGOAL_THEN ���!n. ~(&(FACT n) = &0)��� ASSUME_TAC THENL 1284 [GEN_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN 1285 REWRITE_TAC[REAL_LT, FACT_LESS], ALL_TAC] THEN 1286 REWRITE_TAC[GSYM REAL_MUL] THEN 1287 REPEAT(IMP_SUBST_TAC REAL_INV_MUL THEN ASM_REWRITE_TAC[REAL_ENTIRE]) THEN 1288 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN 1289 ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM) 1290 ���a * (b * (c * d)) = (a * (b * d)) * c���] THEN 1291 GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN 1292 MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL 1293 [ALL_TAC, 1294 MATCH_MP_TAC REAL_INV_POS THEN REWRITE_TAC[REAL_LT, FACT_LESS]] THEN 1295 REWRITE_TAC[REAL_MUL_ASSOC] THEN 1296 IMP_SUBST_TAC ((CONV_RULE(RAND_CONV SYM_CONV) o SPEC_ALL) REAL_INV_MUL) THEN 1297 ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN 1298 REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LT_1 THEN 1299 REWRITE_TAC[POW_2, REAL_MUL, REAL_LE, REAL_LT] THEN REDUCE_TAC THEN 1300 REWRITE_TAC[num_CONV ���4:num���, num_CONV ���3:num���, 1301 MULT_CLAUSES, ADD_CLAUSES] THEN 1302 REWRITE_TAC[LESS_MONO_EQ] THEN 1303 REWRITE_TAC[TWO, ADD_CLAUSES, MULT_CLAUSES] THEN 1304 REWRITE_TAC[ONE, LESS_MONO_EQ, LESS_0]); 1305 1306val COS_ISZERO = store_thm("COS_ISZERO", 1307 ���?!x. &0 <= x /\ x <= &2 /\ (cos x = &0)���, 1308 REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN BETA_TAC THEN 1309 W(C SUBGOAL_THEN ASSUME_TAC o hd o strip_conj o snd) THENL 1310 [MATCH_MP_TAC IVT2 THEN REPEAT CONJ_TAC THENL 1311 [REWRITE_TAC[REAL_LE, ZERO_LESS_EQ], 1312 MATCH_MP_TAC REAL_LT_IMP_LE THEN ACCEPT_TAC COS_2, 1313 REWRITE_TAC[COS_0, REAL_LE_01], 1314 X_GEN_TAC ���x:real��� THEN DISCH_THEN(K ALL_TAC) THEN 1315 MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC ���~(sin x)��� THEN 1316 REWRITE_TAC[DIFF_COS]], 1317 ASM_REWRITE_TAC[] THEN BETA_TAC THEN 1318 MAP_EVERY X_GEN_TAC [���x1:real���, ���x2:real���] THEN 1319 GEN_REWR_TAC I [TAUT_CONV ���a:bool = ~~a���] THEN 1320 PURE_REWRITE_TAC[NOT_IMP] THEN REWRITE_TAC[] THEN STRIP_TAC THEN 1321 MP_TAC(SPECL [���x1:real���, ���x2:real���] REAL_LT_TOTAL) THEN 1322 SUBGOAL_THEN ���(!x. cos differentiable x) /\ (!x. cos contl x)��� 1323 STRIP_ASSUME_TAC THENL 1324 [CONJ_TAC THEN GEN_TAC THENL 1325 [REWRITE_TAC[differentiable], MATCH_MP_TAC DIFF_CONT] THEN 1326 EXISTS_TAC ���~(sin x)��� THEN REWRITE_TAC[DIFF_COS], ALL_TAC] THEN 1327 ASM_REWRITE_TAC[] THEN DISCH_THEN DISJ_CASES_TAC THENL 1328 [MP_TAC(SPECL [���cos���, ���x1:real���, ���x2:real���] ROLLE), 1329 MP_TAC(SPECL [���cos���, ���x2:real���, ���x1:real���] ROLLE)] THEN 1330 ASM_REWRITE_TAC[] THEN 1331 DISCH_THEN(X_CHOOSE_THEN ���x:real��� MP_TAC) THEN REWRITE_TAC[CONJ_ASSOC] THEN 1332 DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN 1333 DISCH_THEN(MP_TAC o CONJ(SPEC ���x:real��� DIFF_COS)) THEN 1334 DISCH_THEN(MP_TAC o MATCH_MP DIFF_UNIQ) THEN 1335 REWRITE_TAC[REAL_NEG_EQ0] THEN MATCH_MP_TAC REAL_POS_NZ THEN 1336 MATCH_MP_TAC SIN_POS THENL 1337 [CONJ_TAC THENL 1338 [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ���x1:real��� THEN 1339 ASM_REWRITE_TAC[], 1340 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���x2:real��� THEN 1341 ASM_REWRITE_TAC[]], 1342 CONJ_TAC THENL 1343 [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ���x2:real��� THEN 1344 ASM_REWRITE_TAC[], 1345 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���x1:real��� THEN 1346 ASM_REWRITE_TAC[]]]]); 1347 1348val pi = new_definition("pi", 1349 Term `pi = &2 * @x. &0 <= x /\ x <= &2 /\ (cos x = &0)`); 1350 1351(*---------------------------------------------------------------------------*) 1352(* Periodicity and related properties of the trig functions *) 1353(*---------------------------------------------------------------------------*) 1354 1355val PI2 = store_thm("PI2", 1356 ���pi / &2 = @x. &0 <= x /\ x <= &2 /\ (cos(x) = &0)���, 1357 REWRITE_TAC[pi, real_div] THEN 1358 ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM) 1359 ���(a * b) * c = (c * a) * b���] THEN 1360 IMP_SUBST_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_INJ] THEN 1361 REDUCE_TAC THEN REWRITE_TAC[REAL_MUL_LID]); 1362 1363val COS_PI2 = store_thm("COS_PI2", 1364 ���cos(pi / &2) = &0���, 1365 MP_TAC(SELECT_RULE (EXISTENCE COS_ISZERO)) THEN 1366 REWRITE_TAC[GSYM PI2] THEN 1367 DISCH_THEN(fn th => REWRITE_TAC[th])); 1368 1369val PI2_BOUNDS = store_thm("PI2_BOUNDS", 1370 ���&0 < (pi / &2) /\ (pi / &2) < &2���, 1371 MP_TAC(SELECT_RULE (EXISTENCE COS_ISZERO)) THEN 1372 REWRITE_TAC[GSYM PI2] THEN DISCH_TAC THEN 1373 ASM_REWRITE_TAC[REAL_LT_LE] THEN CONJ_TAC THENL 1374 [DISCH_TAC THEN MP_TAC COS_0 THEN ASM_REWRITE_TAC[] THEN 1375 FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM REAL_10], 1376 DISCH_TAC THEN MP_TAC COS_PI2 THEN FIRST_ASSUM SUBST1_TAC THEN 1377 REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN 1378 MATCH_ACCEPT_TAC COS_2]); 1379 1380val PI_POS = store_thm("PI_POS", 1381 ���&0 < pi���, 1382 GEN_REWR_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN 1383 MATCH_MP_TAC REAL_LT_ADD THEN REWRITE_TAC[PI2_BOUNDS]); 1384 1385val SIN_PI2 = store_thm("SIN_PI2", 1386 ���sin(pi / &2) = &1���, 1387 MP_TAC(SPEC ���pi / &2��� SIN_CIRCLE) THEN 1388 REWRITE_TAC[COS_PI2, POW_2, REAL_MUL_LZERO, REAL_ADD_RID] THEN 1389 GEN_REWR_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN 1390 ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN 1391 REWRITE_TAC[GSYM REAL_DIFFSQ, REAL_ENTIRE] THEN 1392 DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN 1393 POP_ASSUM MP_TAC THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN 1394 REWRITE_TAC[REAL_LNEG_UNIQ] THEN DISCH_THEN(MP_TAC o AP_TERM ���$real_neg���) THEN 1395 REWRITE_TAC[REAL_NEGNEG] THEN DISCH_TAC THEN 1396 MP_TAC REAL_LT_01 THEN POP_ASSUM(SUBST1_TAC o SYM) THEN 1397 REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_GT THEN 1398 REWRITE_TAC[REAL_NEG_LT0] THEN MATCH_MP_TAC SIN_POS THEN 1399 REWRITE_TAC[PI2_BOUNDS]); 1400 1401val COS_PI = store_thm("COS_PI", 1402 ���cos(pi) = ~(&1)���, 1403 MP_TAC(SPECL [���pi / &2���, ���pi / &2���] COS_ADD) THEN 1404 REWRITE_TAC[SIN_PI2, COS_PI2, REAL_MUL_LZERO, REAL_MUL_LID] THEN 1405 REWRITE_TAC[REAL_SUB_LZERO] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN 1406 AP_TERM_TAC THEN REWRITE_TAC[REAL_DOUBLE] THEN 1407 CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_LMUL THEN 1408 REWRITE_TAC[REAL_INJ] THEN REDUCE_TAC); 1409 1410val SIN_PI = store_thm("SIN_PI", 1411 ���sin(pi) = &0���, 1412 MP_TAC(SPECL [���pi / &2���, ���pi / &2���] SIN_ADD) THEN 1413 REWRITE_TAC[COS_PI2, REAL_MUL_LZERO, REAL_MUL_RZERO, REAL_ADD_LID] THEN 1414 DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN 1415 REWRITE_TAC[REAL_DOUBLE] THEN CONV_TAC SYM_CONV THEN 1416 MATCH_MP_TAC REAL_DIV_LMUL THEN 1417 REWRITE_TAC[REAL_INJ] THEN REDUCE_TAC); 1418 1419val SIN_COS = store_thm("SIN_COS", 1420 ���!x. sin(x) = cos((pi / &2) - x)���, 1421 GEN_TAC THEN REWRITE_TAC[real_sub, COS_ADD] THEN 1422 REWRITE_TAC[SIN_PI2, COS_PI2, REAL_MUL_LZERO] THEN 1423 REWRITE_TAC[REAL_ADD_LID, REAL_MUL_LID] THEN 1424 REWRITE_TAC[SIN_NEG, REAL_NEGNEG]); 1425 1426val COS_SIN = store_thm("COS_SIN", 1427 ���!x. cos(x) = sin((pi / &2) - x)���, 1428 GEN_TAC THEN REWRITE_TAC[real_sub, SIN_ADD] THEN 1429 REWRITE_TAC[SIN_PI2, COS_PI2, REAL_MUL_LZERO] THEN 1430 REWRITE_TAC[REAL_MUL_LID, REAL_ADD_RID] THEN 1431 REWRITE_TAC[COS_NEG]); 1432 1433val SIN_PERIODIC_PI = store_thm("SIN_PERIODIC_PI", 1434 ���!x. sin(x + pi) = ~(sin(x))���, 1435 GEN_TAC THEN REWRITE_TAC[SIN_ADD, SIN_PI, COS_PI] THEN 1436 REWRITE_TAC[REAL_MUL_RZERO, REAL_ADD_RID, GSYM REAL_NEG_RMUL] THEN 1437 REWRITE_TAC[REAL_MUL_RID]); 1438 1439val COS_PERIODIC_PI = store_thm("COS_PERIODIC_PI", 1440 ���!x. cos(x + pi) = ~(cos(x))���, 1441 GEN_TAC THEN REWRITE_TAC[COS_ADD, SIN_PI, COS_PI] THEN 1442 REWRITE_TAC[REAL_MUL_RZERO, REAL_SUB_RZERO, GSYM REAL_NEG_RMUL] THEN 1443 REWRITE_TAC[REAL_MUL_RID]); 1444 1445val SIN_PERIODIC = store_thm("SIN_PERIODIC", 1446 ���!x. sin(x + (&2 * pi)) = sin(x)���, 1447 GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE, REAL_ADD_ASSOC] THEN 1448 REWRITE_TAC[SIN_PERIODIC_PI, REAL_NEGNEG]); 1449 1450val COS_PERIODIC = store_thm("COS_PERIODIC", 1451 ���!x. cos(x + (&2 * pi)) = cos(x)���, 1452 GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE, REAL_ADD_ASSOC] THEN 1453 REWRITE_TAC[COS_PERIODIC_PI, REAL_NEGNEG]); 1454 1455val COS_NPI = store_thm("COS_NPI", 1456 ���!n. cos(&n * pi) = ~(&1) pow n���, 1457 INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO, COS_0, pow] THEN 1458 REWRITE_TAC[ADD1, GSYM REAL_ADD, REAL_RDISTRIB, COS_ADD] THEN 1459 REWRITE_TAC[REAL_MUL_LID, SIN_PI, REAL_MUL_RZERO, REAL_SUB_RZERO] THEN 1460 ASM_REWRITE_TAC[COS_PI] THEN 1461 MATCH_ACCEPT_TAC REAL_MUL_SYM); 1462 1463val SIN_NPI = store_thm("SIN_NPI", 1464 ���!n. sin(&n * pi) = &0���, 1465 INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO, SIN_0, pow] THEN 1466 REWRITE_TAC[ADD1, GSYM REAL_ADD, REAL_RDISTRIB, SIN_ADD] THEN 1467 REWRITE_TAC[REAL_MUL_LID, SIN_PI, REAL_MUL_RZERO, REAL_ADD_RID] THEN 1468 ASM_REWRITE_TAC[REAL_MUL_LZERO]); 1469 1470val SIN_POS_PI2 = store_thm("SIN_POS_PI2", 1471 ���!x. &0 < x /\ x < pi / &2 ==> &0 < sin(x)���, 1472 GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SIN_POS THEN 1473 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_TRANS THEN 1474 EXISTS_TAC ���pi / &2��� THEN ASM_REWRITE_TAC[PI2_BOUNDS]); 1475 1476val COS_POS_PI2 = store_thm("COS_POS_PI2", 1477 ���!x. &0 < x /\ x < pi / &2 ==> &0 < cos(x)���, 1478 GEN_TAC THEN STRIP_TAC THEN 1479 GEN_REWR_TAC I [TAUT_CONV ���a:bool = ~~a���] THEN 1480 PURE_REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN 1481 MP_TAC(SPECL [���cos���, ���&0���, ���x:real���, ���&0���] IVT2) THEN 1482 ASM_REWRITE_TAC[COS_0, REAL_LE_01, NOT_IMP] THEN REPEAT CONJ_TAC THENL 1483 [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[], 1484 X_GEN_TAC ���z:real��� THEN DISCH_THEN(K ALL_TAC) THEN 1485 MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC ���~(sin z)��� THEN 1486 REWRITE_TAC[DIFF_COS], 1487 DISCH_THEN(X_CHOOSE_TAC ���z:real���) THEN 1488 MP_TAC(CONJUNCT2 (CONV_RULE EXISTS_UNIQUE_CONV COS_ISZERO)) THEN 1489 DISCH_THEN(MP_TAC o SPECL [���z:real���, ���pi / &2���]) THEN 1490 ASM_REWRITE_TAC[COS_PI2] THEN REWRITE_TAC[NOT_IMP] THEN 1491 REPEAT CONJ_TAC THENL 1492 [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ���x:real��� THEN 1493 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN 1494 EXISTS_TAC ���pi / &2��� THEN ASM_REWRITE_TAC[] THEN CONJ_TAC, 1495 ALL_TAC, 1496 ALL_TAC, 1497 DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC ���x < pi / &2��� THEN 1498 ASM_REWRITE_TAC[REAL_NOT_LT]] THEN 1499 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[PI2_BOUNDS]]); 1500 1501val COS_POS_PI = store_thm("COS_POS_PI", 1502 ���!x. ~(pi / &2) < x /\ x < pi / &2 ==> &0 < cos(x)���, 1503 GEN_TAC THEN STRIP_TAC THEN 1504 REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC 1505 (SPECL [���x:real���, ���&0���] REAL_LT_TOTAL) THENL 1506 [ASM_REWRITE_TAC[COS_0, REAL_LT_01], 1507 ONCE_REWRITE_TAC[GSYM COS_NEG] THEN MATCH_MP_TAC COS_POS_PI2 THEN 1508 ONCE_REWRITE_TAC[GSYM REAL_NEG_LT0] THEN ASM_REWRITE_TAC[REAL_NEGNEG] THEN 1509 ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN ASM_REWRITE_TAC[REAL_NEGNEG], 1510 MATCH_MP_TAC COS_POS_PI2 THEN ASM_REWRITE_TAC[]]); 1511 1512val SIN_POS_PI = store_thm("SIN_POS_PI", 1513 ���!x. &0 < x /\ x < pi ==> &0 < sin(x)���, 1514 GEN_TAC THEN STRIP_TAC THEN 1515 REWRITE_TAC[SIN_COS] THEN ONCE_REWRITE_TAC[GSYM COS_NEG] THEN 1516 REWRITE_TAC[REAL_NEG_SUB] THEN 1517 MATCH_MP_TAC COS_POS_PI THEN 1518 REWRITE_TAC[REAL_LT_SUB_LADD, REAL_LT_SUB_RADD] THEN 1519 ASM_REWRITE_TAC[REAL_HALF_DOUBLE, REAL_ADD_LINV]); 1520 1521val COS_POS_PI2_LE = store_thm("COS_POS_PI2_LE", 1522 ���!x. &0 <= x /\ x <= (pi / &2) ==> &0 <= cos(x)���, 1523 GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN 1524 DISCH_THEN(CONJUNCTS_THEN DISJ_CASES_TAC) THEN 1525 ASM_REWRITE_TAC[COS_PI2] THEN 1526 TRY(DISJ1_TAC THEN MATCH_MP_TAC COS_POS_PI2 THEN 1527 ASM_REWRITE_TAC[] THEN NO_TAC) THEN 1528 SUBST1_TAC(SYM(ASSUME ���&0 = x���)) THEN 1529 REWRITE_TAC[COS_0, REAL_LT_01]); 1530 1531val COS_POS_PI_LE = store_thm("COS_POS_PI_LE", 1532 ���!x. ~(pi / &2) <= x /\ x <= (pi / &2) ==> &0 <= cos(x)���, 1533 GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN 1534 DISCH_THEN(CONJUNCTS_THEN DISJ_CASES_TAC) THEN 1535 ASM_REWRITE_TAC[COS_PI2] THENL 1536 [DISJ1_TAC THEN MATCH_MP_TAC COS_POS_PI THEN ASM_REWRITE_TAC[], 1537 FIRST_ASSUM(SUBST1_TAC o SYM) THEN 1538 REWRITE_TAC[COS_NEG, COS_PI2, REAL_LT_01]]); 1539 1540val SIN_POS_PI2_LE = store_thm("SIN_POS_PI2_LE", 1541 ���!x. &0 <= x /\ x <= (pi / &2) ==> &0 <= sin(x)���, 1542 GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN 1543 DISCH_THEN(CONJUNCTS_THEN DISJ_CASES_TAC) THEN 1544 ASM_REWRITE_TAC[SIN_PI2, REAL_LT_01] THENL 1545 [DISJ1_TAC THEN MATCH_MP_TAC SIN_POS_PI2 THEN ASM_REWRITE_TAC[], 1546 FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[SIN_0], 1547 MP_TAC PI2_BOUNDS THEN ASM_REWRITE_TAC[REAL_LT_REFL]]); 1548 1549val SIN_POS_PI_LE = store_thm("SIN_POS_PI_LE", 1550 ���!x. &0 <= x /\ x <= pi ==> &0 <= sin(x)���, 1551 GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN 1552 DISCH_THEN(CONJUNCTS_THEN DISJ_CASES_TAC) THEN 1553 ASM_REWRITE_TAC[SIN_PI] THENL 1554 [DISJ1_TAC THEN MATCH_MP_TAC SIN_POS_PI THEN ASM_REWRITE_TAC[], 1555 FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[SIN_0]]); 1556 1557 1558val COS_TOTAL = store_thm("COS_TOTAL", 1559 ���!y. ~(&1) <= y /\ y <= &1 ==> ?!x. &0 <= x /\ x <= pi /\ (cos(x) = y)���, 1560 GEN_TAC THEN STRIP_TAC THEN 1561 CONV_TAC EXISTS_UNIQUE_CONV THEN CONJ_TAC THENL 1562 [MATCH_MP_TAC IVT2 THEN ASM_REWRITE_TAC[COS_0, COS_PI] THEN 1563 REWRITE_TAC[MATCH_MP REAL_LT_IMP_LE PI_POS] THEN 1564 GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN 1565 MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC ���~(sin x)��� THEN 1566 REWRITE_TAC[DIFF_COS], 1567 MAP_EVERY X_GEN_TAC [���x1:real���, ���x2:real���] THEN STRIP_TAC THEN 1568 REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC 1569 (SPECL [���x1:real���, ���x2:real���] REAL_LT_TOTAL) THENL 1570 [FIRST_ASSUM ACCEPT_TAC, 1571 MP_TAC(SPECL [���cos���, ���x1:real���, ���x2:real���] ROLLE), 1572 MP_TAC(SPECL [���cos���, ���x2:real���, ���x1:real���] ROLLE)]] THEN 1573 ASM_REWRITE_TAC[] THEN 1574 (W(C SUBGOAL_THEN (fn t => REWRITE_TAC[t]) o funpow 2 1575 (fst o dest_imp) o snd) THENL 1576 [CONJ_TAC THEN X_GEN_TAC ���x:real��� THEN DISCH_THEN(K ALL_TAC) THEN 1577 TRY(MATCH_MP_TAC DIFF_CONT) THEN REWRITE_TAC[differentiable] THEN 1578 EXISTS_TAC ���~(sin x)��� THEN REWRITE_TAC[DIFF_COS], ALL_TAC]) THEN 1579 DISCH_THEN(X_CHOOSE_THEN ���x:real��� STRIP_ASSUME_TAC) THEN 1580 UNDISCH_TAC ���(cos diffl &0)(x)��� THEN 1581 DISCH_THEN(MP_TAC o CONJ (SPEC ���x:real��� DIFF_COS)) THEN 1582 DISCH_THEN(MP_TAC o MATCH_MP DIFF_UNIQ) THEN 1583 REWRITE_TAC[REAL_NEG_EQ0] THEN DISCH_TAC THEN 1584 MP_TAC(SPEC ���x:real��� SIN_POS_PI) THEN 1585 ASM_REWRITE_TAC[REAL_LT_REFL] THEN 1586 CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN 1587 REWRITE_TAC[] THEN CONJ_TAC THENL 1588 [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ���x1:real���, 1589 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���x2:real���, 1590 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ���x2:real���, 1591 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���x1:real���] THEN 1592 ASM_REWRITE_TAC[]); 1593 1594val SIN_TOTAL = store_thm("SIN_TOTAL", 1595 ���!y. ~(&1) <= y /\ y <= &1 ==> 1596 ?!x. ~(pi / &2) <= x /\ x <= pi / &2 /\ (sin(x) = y)���, 1597 GEN_TAC THEN DISCH_TAC THEN 1598 SUBGOAL_THEN ���!x. ~(pi / &2) <= x /\ x <= pi / &2 /\ (sin(x) = y) 1599 = 1600 &0 <= (x + pi / &2) /\ 1601 (x + pi / &2) <= pi /\ 1602 (cos(x + pi / &2) = ~y)��� 1603 (fn th => REWRITE_TAC[th]) THENL 1604 [GEN_TAC THEN REWRITE_TAC[COS_ADD, SIN_PI2, COS_PI2] THEN 1605 REWRITE_TAC[REAL_MUL_RZERO, REAL_MUL_RZERO, REAL_MUL_RID] THEN 1606 REWRITE_TAC[REAL_SUB_LZERO] THEN 1607 REWRITE_TAC[GSYM REAL_LE_SUB_RADD, GSYM REAL_LE_SUB_LADD] THEN 1608 REWRITE_TAC[REAL_SUB_LZERO] THEN AP_TERM_TAC THEN 1609 REWRITE_TAC[REAL_EQ_NEG] THEN AP_THM_TAC THEN 1610 REPEAT AP_TERM_TAC THEN 1611 GEN_REWR_TAC (RAND_CONV o LAND_CONV) [GSYM REAL_HALF_DOUBLE] THEN 1612 REWRITE_TAC[REAL_ADD_SUB], ALL_TAC] THEN 1613 MP_TAC(Q.SPEC ���~y��� COS_TOTAL) THEN ASM_REWRITE_TAC[REAL_LE_NEG] THEN 1614 ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN ASM_REWRITE_TAC[REAL_NEGNEG] THEN 1615 REWRITE_TAC[REAL_LE_NEG] THEN 1616 CONV_TAC(ONCE_DEPTH_CONV EXISTS_UNIQUE_CONV) THEN 1617 DISCH_THEN(curry op THEN CONJ_TAC o MP_TAC) THENL 1618 [DISCH_THEN(X_CHOOSE_TAC ���x:real��� o CONJUNCT1) THEN 1619 EXISTS_TAC ���x - pi / &2��� THEN ASM_REWRITE_TAC[REAL_SUB_ADD], 1620 POP_ASSUM(K ALL_TAC) THEN DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN 1621 REPEAT GEN_TAC THEN 1622 DISCH_THEN(fn th => FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN 1623 REWRITE_TAC[REAL_EQ_RADD]]); 1624 1625val COS_ZERO_LEMMA = store_thm("COS_ZERO_LEMMA", 1626 ���!x. &0 <= x /\ (cos(x) = &0) ==> 1627 ?n. ~EVEN n /\ (x = &n * (pi / &2))���, 1628 GEN_TAC THEN STRIP_TAC THEN 1629 MP_TAC(SPEC ���x:real��� (MATCH_MP REAL_ARCH_LEAST PI_POS)) THEN 1630 ASM_REWRITE_TAC[] THEN 1631 DISCH_THEN(X_CHOOSE_THEN ���n:num��� STRIP_ASSUME_TAC) THEN 1632 SUBGOAL_THEN ���&0 <= x - &n * pi /\ (x - &n * pi) <= pi /\ 1633 (cos(x - &n * pi) = &0)��� ASSUME_TAC THENL 1634 [ASM_REWRITE_TAC[REAL_SUB_LE] THEN 1635 REWRITE_TAC[REAL_LE_SUB_RADD] THEN 1636 REWRITE_TAC[real_sub, COS_ADD, SIN_NEG, COS_NEG, SIN_NPI, COS_NPI] THEN 1637 ASM_REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_LID] THEN 1638 REWRITE_TAC[REAL_NEG_RMUL, REAL_NEGNEG, REAL_MUL_RZERO] THEN 1639 MATCH_MP_TAC REAL_LT_IMP_LE THEN UNDISCH_TAC ���x < &(SUC n) * pi��� THEN 1640 REWRITE_TAC[ADD1] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN 1641 REWRITE_TAC[GSYM REAL_ADD, REAL_RDISTRIB, REAL_MUL_LID], 1642 MP_TAC(SPEC ���&0��� COS_TOTAL) THEN 1643 REWRITE_TAC[REAL_LE_01, REAL_NEG_LE0] THEN 1644 DISCH_THEN(MP_TAC o CONV_RULE EXISTS_UNIQUE_CONV) THEN 1645 DISCH_THEN(MP_TAC o SPECL [���x - &n * pi���, ���pi / &2���] o CONJUNCT2) THEN 1646 ASM_REWRITE_TAC[COS_PI2] THEN 1647 W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL 1648 [CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN MP_TAC PI2_BOUNDS THEN 1649 REWRITE_TAC[REAL_LT_HALF1, REAL_LT_HALF2] THEN DISCH_TAC THEN 1650 ASM_REWRITE_TAC[], 1651 DISCH_THEN(fn th => REWRITE_TAC[th])] THEN 1652 REWRITE_TAC[REAL_EQ_SUB_RADD] THEN DISCH_TAC THEN 1653 EXISTS_TAC ���SUC(2 * n)��� THEN REWRITE_TAC[EVEN_ODD, ODD_DOUBLE] THEN 1654 REWRITE_TAC[ADD1, GSYM REAL_ADD, GSYM REAL_MUL] THEN 1655 REWRITE_TAC[REAL_RDISTRIB, REAL_MUL_LID] THEN 1656 ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[] THEN 1657 AP_TERM_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN 1658 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN 1659 CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN 1660 REWRITE_TAC[REAL_INJ] THEN REDUCE_TAC]); 1661 1662val SIN_ZERO_LEMMA = store_thm("SIN_ZERO_LEMMA", 1663 ���!x. &0 <= x /\ (sin(x) = &0) ==> 1664 ?n. EVEN n /\ (x = &n * (pi / &2))���, 1665 GEN_TAC THEN DISCH_TAC THEN 1666 MP_TAC(SPEC ���x + pi / &2��� COS_ZERO_LEMMA) THEN 1667 W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL 1668 [CONJ_TAC THENL 1669 [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC ���x:real��� THEN 1670 ASM_REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN 1671 REWRITE_TAC[PI2_BOUNDS], 1672 ASM_REWRITE_TAC[COS_ADD, COS_PI2, REAL_MUL_LZERO, REAL_MUL_RZERO] THEN 1673 MATCH_ACCEPT_TAC REAL_SUB_REFL], 1674 DISCH_THEN(fn th => REWRITE_TAC[th])] THEN 1675 DISCH_THEN(X_CHOOSE_THEN ���n:num��� STRIP_ASSUME_TAC) THEN 1676 MP_TAC(SPEC ���n:num��� ODD_EXISTS) THEN ASM_REWRITE_TAC[ODD_EVEN] THEN 1677 DISCH_THEN(X_CHOOSE_THEN ���m:num��� SUBST_ALL_TAC) THEN 1678 EXISTS_TAC ���2 * m:num��� THEN REWRITE_TAC[EVEN_DOUBLE] THEN 1679 RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_EQ_SUB_LADD]) THEN 1680 FIRST_ASSUM SUBST1_TAC THEN 1681 REWRITE_TAC[ADD1, GSYM REAL_ADD, REAL_RDISTRIB, REAL_MUL_LID] THEN 1682 REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_SUB]); 1683 1684val COS_ZERO = store_thm("COS_ZERO", 1685 ���!x. (cos(x) = &0) = (?n. ~EVEN n /\ (x = &n * (pi / &2))) \/ 1686 (?n. ~EVEN n /\ (x = ~(&n * (pi / &2))))���, 1687 GEN_TAC THEN EQ_TAC THENL 1688 [DISCH_TAC THEN DISJ_CASES_TAC (SPECL [���&0���, ���x:real���] REAL_LE_TOTAL) THENL 1689 [DISJ1_TAC THEN MATCH_MP_TAC COS_ZERO_LEMMA THEN ASM_REWRITE_TAC[], 1690 DISJ2_TAC THEN REWRITE_TAC[GSYM REAL_NEG_EQ] THEN 1691 MATCH_MP_TAC COS_ZERO_LEMMA THEN ASM_REWRITE_TAC[COS_NEG] THEN 1692 ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN 1693 ASM_REWRITE_TAC[REAL_NEGNEG, REAL_NEG_0]], 1694 DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC ���n:num���)) THEN 1695 ASM_REWRITE_TAC[COS_NEG] THEN MP_TAC(SPEC ���n:num��� ODD_EXISTS) THEN 1696 ASM_REWRITE_TAC[ODD_EVEN] THEN DISCH_THEN(X_CHOOSE_THEN ���m:num��� SUBST1_TAC) THEN 1697 REWRITE_TAC[ADD1] THEN SPEC_TAC(���m:num���,���m:num���) THEN INDUCT_TAC THEN 1698 REWRITE_TAC[MULT_CLAUSES, ADD_CLAUSES, REAL_MUL_LID, COS_PI2] THEN 1699 REWRITE_TAC[GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[GSYM REAL_ADD] THEN 1700 REWRITE_TAC[REAL_RDISTRIB] THEN REWRITE_TAC[COS_ADD] THEN 1701 REWRITE_TAC[GSYM REAL_DOUBLE, REAL_HALF_DOUBLE] THEN 1702 ASM_REWRITE_TAC[COS_PI, SIN_PI, REAL_MUL_LZERO, REAL_MUL_RZERO] THEN 1703 REWRITE_TAC[REAL_SUB_RZERO]]); 1704 1705val SIN_ZERO = store_thm("SIN_ZERO", 1706 ���!x. (sin(x) = &0) = (?n. EVEN n /\ (x = &n * (pi / &2))) \/ 1707 (?n. EVEN n /\ (x = ~(&n * (pi / &2))))���, 1708 GEN_TAC THEN EQ_TAC THENL 1709 [DISCH_TAC THEN DISJ_CASES_TAC (SPECL [���&0���, ���x:real���] REAL_LE_TOTAL) THENL 1710 [DISJ1_TAC THEN MATCH_MP_TAC SIN_ZERO_LEMMA THEN ASM_REWRITE_TAC[], 1711 DISJ2_TAC THEN REWRITE_TAC[GSYM REAL_NEG_EQ] THEN 1712 MATCH_MP_TAC SIN_ZERO_LEMMA THEN 1713 ASM_REWRITE_TAC[SIN_NEG, REAL_NEG_0, REAL_NEG_GE0]], 1714 DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC ���n:num���)) THEN 1715 ASM_REWRITE_TAC[SIN_NEG, REAL_NEG_EQ0] THEN 1716 MP_TAC(SPEC ���n:num��� EVEN_EXISTS) THEN ASM_REWRITE_TAC[] THEN 1717 DISCH_THEN(X_CHOOSE_THEN ���m:num��� SUBST1_TAC) THEN 1718 REWRITE_TAC[GSYM REAL_MUL] THEN 1719 ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM) 1720 ���(a * b) * c = b * (a * c)���] THEN 1721 REWRITE_TAC[GSYM REAL_DOUBLE, REAL_HALF_DOUBLE, SIN_NPI]]); 1722 1723(*---------------------------------------------------------------------------*) 1724(* Tangent *) 1725(*---------------------------------------------------------------------------*) 1726 1727val tan = new_definition("tan", 1728 ���tan(x) = sin(x) / cos(x)���); 1729 1730val TAN_0 = store_thm("TAN_0", 1731 ���tan(&0) = &0���, 1732 REWRITE_TAC[tan, SIN_0, REAL_DIV_LZERO]); 1733 1734val TAN_PI = store_thm("TAN_PI", 1735 ���tan(pi) = &0���, 1736 REWRITE_TAC[tan, SIN_PI, REAL_DIV_LZERO]); 1737 1738val TAN_NPI = store_thm("TAN_NPI", 1739 ���!n. tan(&n * pi) = &0���, 1740 GEN_TAC THEN REWRITE_TAC[tan, SIN_NPI, REAL_DIV_LZERO]); 1741 1742val TAN_NEG = store_thm("TAN_NEG", 1743 ���!x. tan(~x) = ~(tan x)���, 1744 GEN_TAC THEN REWRITE_TAC[tan, SIN_NEG, COS_NEG] THEN 1745 REWRITE_TAC[real_div, REAL_NEG_LMUL]); 1746 1747val TAN_PERIODIC = store_thm("TAN_PERIODIC", 1748 ���!x. tan(x + &2 * pi) = tan(x)���, 1749 GEN_TAC THEN REWRITE_TAC[tan, SIN_PERIODIC, COS_PERIODIC]); 1750 1751val TAN_ADD = store_thm("TAN_ADD", 1752 ���!x y. ~(cos(x) = &0) /\ ~(cos(y) = &0) /\ ~(cos(x + y) = &0) ==> 1753 (tan(x + y) = (tan(x) + tan(y)) / (&1 - tan(x) * tan(y)))���, 1754 REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[tan] THEN 1755 MP_TAC(SPECL [���cos(x) * cos(y)���, 1756 ���&1 - (sin(x) / cos(x)) * (sin(y) / cos(y))���] 1757 REAL_DIV_MUL2) THEN ASM_REWRITE_TAC[REAL_ENTIRE] THEN 1758 W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL 1759 [DISCH_THEN(MP_TAC o AP_TERM ���$* (cos(x) * cos(y))���) THEN 1760 REWRITE_TAC[real_div, REAL_SUB_LDISTRIB, GSYM REAL_MUL_ASSOC] THEN 1761 REWRITE_TAC[REAL_MUL_RID, REAL_MUL_RZERO] THEN 1762 UNDISCH_TAC ���~(cos(x + y) = &0)��� THEN 1763 MATCH_MP_TAC(TAUT_CONV ���(a = b) ==> a ==> b���) THEN 1764 AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN 1765 REWRITE_TAC[COS_ADD] THEN AP_TERM_TAC, 1766 DISCH_THEN(fn th => DISCH_THEN(MP_TAC o C MATCH_MP th)) THEN 1767 DISCH_THEN(fn th => ONCE_REWRITE_TAC[th]) THEN BINOP_TAC THENL 1768 [REWRITE_TAC[real_div, REAL_LDISTRIB, GSYM REAL_MUL_ASSOC] THEN 1769 REWRITE_TAC[SIN_ADD] THEN BINOP_TAC THENL 1770 [ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM) 1771 ���a * (b * (c * d)) = (d * a) * (c * b)���] THEN 1772 IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[REAL_MUL_LID], 1773 ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM) 1774 ���a * (b * (c * d)) = (d * b) * (a * c)���] THEN 1775 IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[REAL_MUL_LID]], 1776 REWRITE_TAC[COS_ADD, REAL_SUB_LDISTRIB, REAL_MUL_RID] THEN 1777 AP_TERM_TAC THEN REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC]]] THEN 1778 ONCE_REWRITE_TAC[AC(REAL_MUL_ASSOC,REAL_MUL_SYM) 1779 ���a * (b * (c * (d * (e * f)))) = 1780 (f * b) * ((d * a) * (c * e))���] THEN 1781 REPEAT(IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[]) THEN 1782 REWRITE_TAC[REAL_MUL_LID]); 1783 1784val TAN_DOUBLE = store_thm("TAN_DOUBLE", 1785 ���!x. ~(cos(x) = &0) /\ ~(cos(&2 * x) = &0) ==> 1786 (tan(&2 * x) = (&2 * tan(x)) / (&1 - (tan(x) pow 2)))���, 1787 GEN_TAC THEN STRIP_TAC THEN 1788 MP_TAC(SPECL [���x:real���, ���x:real���] TAN_ADD) THEN 1789 ASM_REWRITE_TAC[REAL_DOUBLE, POW_2]); 1790 1791val TAN_POS_PI2 = store_thm("TAN_POS_PI2", 1792 ���!x. &0 < x /\ x < pi / &2 ==> &0 < tan(x)���, 1793 GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[tan, real_div] THEN 1794 MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL 1795 [MATCH_MP_TAC SIN_POS_PI2, 1796 MATCH_MP_TAC REAL_INV_POS THEN MATCH_MP_TAC COS_POS_PI2] THEN 1797 ASM_REWRITE_TAC[]); 1798 1799val DIFF_TAN = store_thm("DIFF_TAN", 1800 ���!x. ~(cos(x) = &0) ==> (tan diffl inv(cos(x) pow 2))(x)���, 1801 GEN_TAC THEN DISCH_TAC THEN MP_TAC(DIFF_CONV ���\x. sin(x) / cos(x)���) THEN 1802 DISCH_THEN(MP_TAC o SPEC ���x:real���) THEN ASM_REWRITE_TAC[REAL_MUL_RID] THEN 1803 REWRITE_TAC[GSYM tan, GSYM REAL_NEG_LMUL, REAL_NEGNEG, real_sub] THEN 1804 CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN 1805 REWRITE_TAC[GSYM POW_2, SIN_CIRCLE, GSYM REAL_INV_1OVER]); 1806 1807 1808val TAN_TOTAL_LEMMA = store_thm("TAN_TOTAL_LEMMA", 1809 ���!y. &0 < y ==> ?x. &0 < x /\ x < pi / &2 /\ y < tan(x)���, 1810 GEN_TAC THEN DISCH_TAC THEN 1811 SUBGOAL_THEN ���((\x. cos(x) / sin(x)) -> &0) (pi / &2)��� 1812 MP_TAC THENL 1813 [SUBST1_TAC(SYM(SPEC ���&1��� REAL_DIV_LZERO)) THEN 1814 CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN MATCH_MP_TAC LIM_DIV THEN 1815 REWRITE_TAC[REAL_10] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN 1816 SUBST1_TAC(SYM COS_PI2) THEN SUBST1_TAC(SYM SIN_PI2) THEN 1817 REWRITE_TAC[GSYM CONTL_LIM] THEN CONJ_TAC THEN MATCH_MP_TAC DIFF_CONT THENL 1818 [EXISTS_TAC ���~(sin(pi / &2))���, 1819 EXISTS_TAC ���cos(pi / &2)���] THEN 1820 REWRITE_TAC[DIFF_SIN, DIFF_COS], ALL_TAC] THEN 1821 REWRITE_TAC[LIM] THEN DISCH_THEN(MP_TAC o SPEC ���inv(y)���) THEN 1822 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP REAL_INV_POS th]) THEN 1823 BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN 1824 DISCH_THEN(X_CHOOSE_THEN ���d:real��� STRIP_ASSUME_TAC) THEN 1825 MP_TAC(SPECL [���d:real���, ���pi / &2���] REAL_DOWN2) THEN 1826 ASM_REWRITE_TAC[PI2_BOUNDS] THEN 1827 DISCH_THEN(X_CHOOSE_THEN ���e:real��� STRIP_ASSUME_TAC) THEN 1828 EXISTS_TAC ���(pi / &2) - e��� THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN 1829 CONJ_TAC THENL 1830 [REWRITE_TAC[real_sub, GSYM REAL_NOT_LE, REAL_LE_ADDR, REAL_NEG_GE0] THEN 1831 ASM_REWRITE_TAC[REAL_NOT_LE], ALL_TAC] THEN 1832 FIRST_ASSUM(UNDISCH_TAC o assert is_forall o concl) THEN 1833 DISCH_THEN(MP_TAC o SPEC ���(pi / &2) - e���) THEN 1834 REWRITE_TAC[REAL_SUB_SUB, ABS_NEG] THEN 1835 SUBGOAL_THEN ���abs(e) = e��� (fn th => ASM_REWRITE_TAC[th]) THENL 1836 [REWRITE_TAC[ABS_REFL] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN 1837 FIRST_ASSUM ACCEPT_TAC, ALL_TAC] THEN 1838 SUBGOAL_THEN ���&0 < cos((pi / &2) - e) / sin((pi / &2) - e)��� 1839 MP_TAC THENL 1840 [ONCE_REWRITE_TAC[real_div] THEN 1841 MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL 1842 [MATCH_MP_TAC COS_POS_PI2, 1843 MATCH_MP_TAC REAL_INV_POS THEN MATCH_MP_TAC SIN_POS_PI2] THEN 1844 ASM_REWRITE_TAC[REAL_SUB_LT] THEN 1845 REWRITE_TAC[GSYM REAL_NOT_LE, real_sub, REAL_LE_ADDR, REAL_NEG_GE0] THEN 1846 ASM_REWRITE_TAC[REAL_NOT_LE], ALL_TAC] THEN 1847 DISCH_THEN(fn th => ASSUME_TAC th THEN MP_TAC(MATCH_MP REAL_POS_NZ th)) THEN 1848 REWRITE_TAC[ABS_NZ, TAUT_CONV ���a ==> b ==> c = a /\ b ==> c���] THEN 1849 DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_INV) THEN REWRITE_TAC[tan] THEN 1850 MATCH_MP_TAC (TAUT_CONV ���(a = b) ==> a ==> b���) THEN BINOP_TAC THENL 1851 [MATCH_MP_TAC REAL_INVINV THEN MATCH_MP_TAC REAL_POS_NZ THEN 1852 FIRST_ASSUM ACCEPT_TAC, ALL_TAC] THEN 1853 MP_TAC(ASSUME���&0 < cos((pi / &2) - e) / sin((pi / &2) - e)���) THEN 1854 DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN 1855 REWRITE_TAC[GSYM ABS_REFL] THEN DISCH_THEN SUBST1_TAC THEN 1856 REWRITE_TAC[real_div] THEN IMP_SUBST_TAC REAL_INV_MUL THENL 1857 [REWRITE_TAC[GSYM DE_MORGAN_THM, GSYM REAL_ENTIRE, GSYM real_div] THEN 1858 MATCH_MP_TAC REAL_POS_NZ THEN FIRST_ASSUM ACCEPT_TAC, 1859 GEN_REWR_TAC RAND_CONV [REAL_MUL_SYM] THEN AP_TERM_TAC THEN 1860 MATCH_MP_TAC REAL_INVINV THEN MATCH_MP_TAC REAL_POS_NZ THEN 1861 MATCH_MP_TAC SIN_POS_PI2 THEN REWRITE_TAC[REAL_SUB_LT, GSYM real_div] THEN 1862 REWRITE_TAC[GSYM REAL_NOT_LE, real_sub, REAL_LE_ADDR, REAL_NEG_GE0] THEN 1863 ASM_REWRITE_TAC[REAL_NOT_LE]]); 1864 1865val TAN_TOTAL_POS = store_thm("TAN_TOTAL_POS", 1866 ���!y. &0 <= y ==> ?x. &0 <= x /\ x < pi / &2 /\ (tan(x) = y)���, 1867 GEN_TAC THEN DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL 1868 [FIRST_ASSUM(MP_TAC o MATCH_MP TAN_TOTAL_LEMMA) THEN 1869 DISCH_THEN(X_CHOOSE_THEN ���x:real��� STRIP_ASSUME_TAC) THEN 1870 MP_TAC(SPECL [���tan���, ���&0���, ���x:real���, ���y:real���] IVT) THEN 1871 W(C SUBGOAL_THEN (fn th => DISCH_THEN(MP_TAC o C MATCH_MP th)) o 1872 funpow 2 (fst o dest_imp) o snd) THENL 1873 [REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_LT_IMP_LE) THEN 1874 ASM_REWRITE_TAC[TAN_0] THEN X_GEN_TAC ���z:real��� THEN STRIP_TAC THEN 1875 MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC ���inv(cos(z) pow 2)��� THEN 1876 MATCH_MP_TAC DIFF_TAN THEN UNDISCH_TAC ���&0 <= z��� THEN 1877 REWRITE_TAC[REAL_LE_LT] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL 1878 [DISCH_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN 1879 MATCH_MP_TAC COS_POS_PI2 THEN ASM_REWRITE_TAC[] THEN 1880 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ���x:real��� THEN 1881 ASM_REWRITE_TAC[], 1882 DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[COS_0, REAL_10]], 1883 DISCH_THEN(X_CHOOSE_THEN ���z:real��� STRIP_ASSUME_TAC) THEN 1884 EXISTS_TAC ���z:real��� THEN ASM_REWRITE_TAC[] THEN 1885 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ���x:real��� THEN 1886 ASM_REWRITE_TAC[]], 1887 POP_ASSUM(SUBST1_TAC o SYM) THEN EXISTS_TAC ���&0��� THEN 1888 REWRITE_TAC[TAN_0, REAL_LE_REFL, PI2_BOUNDS]]); 1889 1890val TAN_TOTAL = store_thm("TAN_TOTAL", 1891 ���!y. ?!x. ~(pi / &2) < x /\ x < (pi / &2) /\ (tan(x) = y)���, 1892 GEN_TAC THEN CONV_TAC EXISTS_UNIQUE_CONV THEN CONJ_TAC THENL 1893 [DISJ_CASES_TAC(SPEC ���y:real��� REAL_LE_NEGTOTAL) THEN 1894 POP_ASSUM(X_CHOOSE_TAC ���x:real��� o MATCH_MP TAN_TOTAL_POS) THENL 1895 [EXISTS_TAC ���x:real��� THEN ASM_REWRITE_TAC[] THEN 1896 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���&0��� THEN 1897 ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN 1898 REWRITE_TAC[REAL_NEGNEG, REAL_NEG_0, PI2_BOUNDS], 1899 Q.EXISTS_TAC ���~x��� THEN ASM_REWRITE_TAC[REAL_LT_NEG] THEN 1900 ASM_REWRITE_TAC[TAN_NEG, REAL_NEG_EQ, REAL_NEGNEG] THEN 1901 ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN 1902 REWRITE_TAC[REAL_LT_NEG] THEN MATCH_MP_TAC REAL_LET_TRANS THEN 1903 EXISTS_TAC ���x:real��� THEN ASM_REWRITE_TAC[REAL_LE_NEGL]], 1904 MAP_EVERY X_GEN_TAC [���x1:real���, ���x2:real���] THEN 1905 REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC 1906 (SPECL [���x1:real���, ���x2:real���] REAL_LT_TOTAL) THENL 1907 [DISCH_THEN(K ALL_TAC) THEN POP_ASSUM ACCEPT_TAC, 1908 ALL_TAC, 1909 POP_ASSUM MP_TAC THEN SPEC_TAC(���x1:real���,���z1:real���) THEN 1910 SPEC_TAC(���x2:real���,���z2:real���) THEN 1911 MAP_EVERY X_GEN_TAC [���x1:real���, ���x2:real���] THEN DISCH_TAC THEN 1912 CONV_TAC(RAND_CONV SYM_CONV) THEN ONCE_REWRITE_TAC[CONJ_SYM]] THEN 1913 (STRIP_TAC THEN MP_TAC(SPECL [���tan���, ���x1:real���, ���x2:real���] ROLLE) THEN 1914 ASM_REWRITE_TAC[] THEN CONV_TAC CONTRAPOS_CONV THEN 1915 DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[NOT_IMP] THEN 1916 REPEAT CONJ_TAC THENL 1917 [X_GEN_TAC ���x:real��� THEN STRIP_TAC THEN MATCH_MP_TAC DIFF_CONT THEN 1918 EXISTS_TAC ���inv(cos(x) pow 2)��� THEN MATCH_MP_TAC DIFF_TAN, 1919 X_GEN_TAC ���x:real��� THEN 1920 DISCH_THEN(CONJUNCTS_THEN (ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE)) THEN 1921 REWRITE_TAC[differentiable] THEN EXISTS_TAC ���inv(cos(x) pow 2)��� THEN 1922 MATCH_MP_TAC DIFF_TAN, 1923 REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(X_CHOOSE_THEN ���x:real��� 1924 (CONJUNCTS_THEN2 (CONJUNCTS_THEN (ASSUME_TAC o MATCH_MP 1925 REAL_LT_IMP_LE)) ASSUME_TAC)) THEN 1926 MP_TAC(SPEC ���x:real��� DIFF_TAN) THEN 1927 SUBGOAL_THEN ���~(cos(x) = &0)��� ASSUME_TAC THENL 1928 [ALL_TAC, 1929 ASM_REWRITE_TAC[] THEN 1930 DISCH_THEN(MP_TAC o C CONJ (ASSUME ���(tan diffl &0)(x)���)) THEN 1931 DISCH_THEN(MP_TAC o MATCH_MP DIFF_UNIQ) THEN REWRITE_TAC[] THEN 1932 MATCH_MP_TAC REAL_INV_NZ THEN MATCH_MP_TAC POW_NZ THEN 1933 ASM_REWRITE_TAC[]]] THEN 1934 (MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC COS_POS_PI THEN 1935 CONJ_TAC THENL 1936 [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���x1:real���, 1937 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC ���x2:real���] THEN 1938 ASM_REWRITE_TAC[]))]); 1939 1940(*---------------------------------------------------------------------------*) 1941(* Inverse trig functions *) 1942(*---------------------------------------------------------------------------*) 1943 1944val asn = new_definition("asn", 1945 ���asn(y) = @x. ~(pi / &2) <= x /\ x <= pi / &2 /\ (sin x = y)���); 1946 1947val acs = new_definition("acs", 1948 ���acs(y) = @x. &0 <= x /\ x <= pi /\ (cos x = y)���); 1949 1950val atn = new_definition("atn", 1951 ���atn(y) = @x. ~(pi / &2) < x /\ x < pi / &2 /\ (tan x = y)���); 1952 1953val ASN = store_thm("ASN", 1954 ���!y. ~(&1) <= y /\ y <= &1 ==> 1955 ~(pi / &2) <= asn(y) /\ (asn(y) <= pi / &2 /\ (sin(asn y) = y))���, 1956 GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SIN_TOTAL) THEN 1957 DISCH_THEN(MP_TAC o CONJUNCT1 o CONV_RULE EXISTS_UNIQUE_CONV) THEN 1958 DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM asn]); 1959 1960val ASN_SIN = store_thm("ASN_SIN", 1961 ���!y. ~(&1) <= y /\ y <= &1 ==> (sin(asn(y)) = y)���, 1962 GEN_TAC THEN DISCH_THEN(fn th => REWRITE_TAC[MATCH_MP ASN th])); 1963 1964val ASN_BOUNDS = store_thm("ASN_BOUNDS", 1965 ���!y. ~(&1) <= y /\ y <= &1 1966 ==> ~(pi / &2) <= asn(y) /\ asn(y) <= pi / &2���, 1967GEN_TAC THEN DISCH_THEN(fn th => REWRITE_TAC[MATCH_MP ASN th])); 1968 1969val ASN_BOUNDS_LT = store_thm("ASN_BOUNDS_LT", 1970 ���!y. ~(&1) < y /\ y < &1 ==> ~(pi / &2) < asn(y) /\ asn(y) < pi / &2���, 1971 GEN_TAC THEN STRIP_TAC THEN 1972 SUBGOAL_THEN ���~(pi / &2) <= asn(y) /\ asn(y) <= pi / &2��� ASSUME_TAC THENL 1973 [MATCH_MP_TAC ASN_BOUNDS THEN CONJ_TAC THEN 1974 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[], 1975 ASM_REWRITE_TAC[REAL_LT_LE]] THEN 1976 CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM ���sin���) THEN 1977 REWRITE_TAC[SIN_NEG, SIN_PI2] THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN 1978 SUBGOAL_THEN ���sin(asn y) = y��� (fn th => ASM_REWRITE_TAC[th]) THEN 1979 MATCH_MP_TAC ASN_SIN THEN CONJ_TAC THEN 1980 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]); 1981 1982val SIN_ASN = store_thm("SIN_ASN", 1983 ���!x. ~(pi / &2) <= x /\ x <= pi / &2 ==> (asn(sin(x)) = x)���, 1984 GEN_TAC THEN DISCH_TAC THEN 1985 MP_TAC(MATCH_MP SIN_TOTAL (SPEC ���x:real��� SIN_BOUNDS)) THEN 1986 DISCH_THEN(MATCH_MP_TAC o CONJUNCT2 o CONV_RULE EXISTS_UNIQUE_CONV) THEN 1987 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ASN THEN 1988 MATCH_ACCEPT_TAC SIN_BOUNDS); 1989 1990val ACS = store_thm("ACS", 1991 ���!y. ~(&1) <= y /\ y <= &1 ==> 1992 &0 <= acs(y) /\ acs(y) <= pi /\ (cos(acs y) = y)���, 1993 GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP COS_TOTAL) THEN 1994 DISCH_THEN(MP_TAC o CONJUNCT1 o CONV_RULE EXISTS_UNIQUE_CONV) THEN 1995 DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM acs]); 1996 1997val ACS_COS = store_thm("ACS_COS", 1998 ���!y. ~(&1) <= y /\ y <= &1 ==> (cos(acs(y)) = y)���, 1999 GEN_TAC THEN DISCH_THEN(fn th => REWRITE_TAC[MATCH_MP ACS th])); 2000 2001val ACS_BOUNDS = store_thm("ACS_BOUNDS", 2002 ���!y. ~(&1) <= y /\ y <= &1 ==> &0 <= acs(y) /\ acs(y) <= pi���, 2003 GEN_TAC THEN DISCH_THEN(fn th => REWRITE_TAC[MATCH_MP ACS th])); 2004 2005val ACS_BOUNDS_LT = store_thm("ACS_BOUNDS_LT", 2006 ���!y. ~(&1) < y /\ y < &1 ==> &0 < acs(y) /\ acs(y) < pi���, 2007 GEN_TAC THEN STRIP_TAC THEN 2008 SUBGOAL_THEN ���&0 <= acs(y) /\ acs(y) <= pi��� ASSUME_TAC THENL 2009 [MATCH_MP_TAC ACS_BOUNDS THEN CONJ_TAC THEN 2010 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[], 2011 ASM_REWRITE_TAC[REAL_LT_LE]] THEN 2012 CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM ���cos���) THEN 2013 REWRITE_TAC[COS_0, COS_PI] THEN 2014 CONV_TAC(RAND_CONV SYM_CONV) THEN 2015 MATCH_MP_TAC REAL_LT_IMP_NE THEN 2016 SUBGOAL_THEN ���cos(acs y) = y��� (fn th => ASM_REWRITE_TAC[th]) THEN 2017 MATCH_MP_TAC ACS_COS THEN CONJ_TAC THEN 2018 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]); 2019 2020val COS_ACS = store_thm("COS_ACS", 2021 ���!x. &0 <= x /\ x <= pi ==> (acs(cos(x)) = x)���, 2022 GEN_TAC THEN DISCH_TAC THEN 2023 MP_TAC(MATCH_MP COS_TOTAL (SPEC ���x:real��� COS_BOUNDS)) THEN 2024 DISCH_THEN(MATCH_MP_TAC o CONJUNCT2 o CONV_RULE EXISTS_UNIQUE_CONV) THEN 2025 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ACS THEN 2026 MATCH_ACCEPT_TAC COS_BOUNDS); 2027 2028val ATN = store_thm("ATN", 2029 ���!y. ~(pi / &2) < atn(y) /\ atn(y) < (pi / &2) /\ (tan(atn y) = y)���, 2030 GEN_TAC THEN MP_TAC(SPEC ���y:real��� TAN_TOTAL) THEN 2031 DISCH_THEN(MP_TAC o CONJUNCT1 o CONV_RULE EXISTS_UNIQUE_CONV) THEN 2032 DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM atn]); 2033 2034val ATN_TAN = store_thm("ATN_TAN", 2035 ���!y. tan(atn y) = y���, 2036 REWRITE_TAC[ATN]); 2037 2038val ATN_BOUNDS = store_thm("ATN_BOUNDS", 2039 ���!y. ~(pi / &2) < atn(y) /\ atn(y) < (pi / &2)���, 2040 REWRITE_TAC[ATN]); 2041 2042val TAN_ATN = store_thm("TAN_ATN", 2043 ���!x. ~(pi / &2) < x /\ x < (pi / &2) ==> (atn(tan(x)) = x)���, 2044 GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC ���tan(x)��� TAN_TOTAL) THEN 2045 DISCH_THEN(MATCH_MP_TAC o CONJUNCT2 o CONV_RULE EXISTS_UNIQUE_CONV) THEN 2046 ASM_REWRITE_TAC[ATN]); 2047 2048(*---------------------------------------------------------------------------*) 2049(* A few additional results about the trig functions *) 2050(*---------------------------------------------------------------------------*) 2051 2052val TAN_SEC = store_thm("TAN_SEC", 2053 ���!x. ~(cos(x) = &0) ==> (&1 + (tan(x) pow 2) = inv(cos x) pow 2)���, 2054 GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[tan] THEN 2055 FIRST_ASSUM(fn th => ONCE_REWRITE_TAC[GSYM 2056 (MATCH_MP REAL_DIV_REFL (SPEC ���2:num��� (MATCH_MP POW_NZ th)))]) THEN 2057 REWRITE_TAC[real_div, POW_MUL] THEN 2058 POP_ASSUM(fn th => REWRITE_TAC[MATCH_MP POW_INV th]) THEN 2059 ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN 2060 REWRITE_TAC[GSYM REAL_RDISTRIB, SIN_CIRCLE, REAL_MUL_LID]); 2061 2062val SIN_COS_SQ = store_thm("SIN_COS_SQ", 2063 ���!x. &0 <= x /\ x <= pi ==> (sin(x) = sqrt(&1 - (cos(x) pow 2)))���, 2064 GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC SQRT_EQ THEN 2065 REWRITE_TAC[REAL_EQ_SUB_LADD, SIN_CIRCLE] THEN 2066 MATCH_MP_TAC SIN_POS_PI_LE THEN ASM_REWRITE_TAC[]); 2067 2068val COS_SIN_SQ = store_thm("COS_SIN_SQ", 2069 ���!x. ~(pi / &2) <= x /\ x <= (pi / &2) ==> 2070 (cos(x) = sqrt(&1 - (sin(x) pow 2)))���, 2071 GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC SQRT_EQ THEN 2072 REWRITE_TAC[REAL_EQ_SUB_LADD] THEN 2073 ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN 2074 REWRITE_TAC[SIN_CIRCLE] THEN 2075 MATCH_MP_TAC COS_POS_PI_LE THEN ASM_REWRITE_TAC[]); 2076 2077val COS_ATN_NZ = store_thm("COS_ATN_NZ", 2078 ���!x. ~(cos(atn(x)) = &0)���, 2079 GEN_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN 2080 MATCH_MP_TAC COS_POS_PI THEN MATCH_ACCEPT_TAC ATN_BOUNDS); 2081 2082val COS_ASN_NZ = store_thm("COS_ASN_NZ", 2083 ���!x. ~(&1) < x /\ x < &1 ==> ~(cos(asn(x)) = &0)���, 2084 GEN_TAC THEN DISCH_TAC THEN 2085 MAP_EVERY MATCH_MP_TAC [REAL_POS_NZ, COS_POS_PI, ASN_BOUNDS_LT] THEN 2086 POP_ASSUM ACCEPT_TAC); 2087 2088val SIN_ACS_NZ = store_thm("SIN_ACS_NZ", 2089 ���!x. ~(&1) < x /\ x < &1 ==> ~(sin(acs(x)) = &0)���, 2090 GEN_TAC THEN DISCH_TAC THEN 2091 MAP_EVERY MATCH_MP_TAC [REAL_POS_NZ, SIN_POS_PI, ACS_BOUNDS_LT] THEN 2092 POP_ASSUM ACCEPT_TAC); 2093 2094val COS_SIN_SQRT = store_thm("COS_SIN_SQRT", 2095 Term `!x. &0 <= cos(x) ==> (cos(x) = sqrt(&1 - (sin(x) pow 2)))`, 2096 GEN_TAC THEN DISCH_TAC THEN 2097 MP_TAC (ONCE_REWRITE_RULE[REAL_ADD_SYM] (SPEC (Term`x:real`) SIN_CIRCLE)) 2098 THEN REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN 2099 DISCH_THEN(SUBST1_TAC o SYM) THEN 2100 REWRITE_TAC[sqrt, TWO] THEN 2101 CONV_TAC SYM_CONV THEN MATCH_MP_TAC POW_ROOT_POS THEN 2102 ASM_REWRITE_TAC[]);; 2103 2104val SIN_COS_SQRT = store_thm("SIN_COS_SQRT", 2105 Term`!x. &0 <= sin(x) ==> (sin(x) = sqrt(&1 - (cos(x) pow 2)))`, 2106 GEN_TAC THEN DISCH_TAC THEN 2107 MP_TAC (SPEC (Term`x:real`) SIN_CIRCLE) THEN 2108 REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN 2109 DISCH_THEN(SUBST1_TAC o SYM) THEN 2110 REWRITE_TAC[sqrt, TWO] THEN 2111 CONV_TAC SYM_CONV THEN MATCH_MP_TAC POW_ROOT_POS THEN 2112 ASM_REWRITE_TAC[]);; 2113 2114 2115(*---------------------------------------------------------------------------*) 2116(* Derivatives of the inverse functions, starting with natural log *) 2117(*---------------------------------------------------------------------------*) 2118 2119val DIFF_LN = store_thm("DIFF_LN", 2120 ���!x. &0 < x ==> (ln diffl (inv x))(x)���, 2121 GEN_TAC THEN DISCH_TAC THEN 2122 SUBGOAL_THEN ���(ln diffl (inv x))(exp(ln(x)))��� MP_TAC THENL 2123 [MATCH_MP_TAC DIFF_INVERSE_OPEN, 2124 MATCH_MP_TAC(TAUT_CONV ���(a = b) ==> a ==> b���) THEN AP_TERM_TAC THEN 2125 ASM_REWRITE_TAC[EXP_LN]] THEN 2126 MAP_EVERY EXISTS_TAC [���ln(x) - &1���, ���ln(x) + &1���] THEN 2127 REWRITE_TAC[REAL_LT_SUB_RADD, REAL_LT_ADDR, REAL_LT_01, LN_EXP, 2128 MATCH_MP DIFF_CONT (SPEC_ALL DIFF_EXP)] THEN 2129 CONJ_TAC THENL 2130 [MP_TAC(SPEC ���ln(x)��� DIFF_EXP) THEN 2131 RULE_ASSUM_TAC(REWRITE_RULE[GSYM EXP_LN]), MATCH_MP_TAC REAL_POS_NZ] THEN 2132 ASM_REWRITE_TAC[]); 2133 2134(* Known as DIFF_ASN_COS in GTT *) 2135val DIFF_ASN_LEMMA = store_thm("DIFF_ASN_LEMMA", 2136 ���!x. ~(&1) < x /\ x < &1 ==> (asn diffl (inv(cos(asn x))))(x)���, 2137 GEN_TAC THEN STRIP_TAC THEN IMP_RES_TAC REAL_LT_IMP_LE THEN 2138 MP_TAC(SPEC ���x:real��� ASN_SIN) THEN ASM_REWRITE_TAC[] THEN 2139 DISCH_THEN(fn th => GEN_REWR_TAC RAND_CONV [SYM th]) THEN 2140 MATCH_MP_TAC DIFF_INVERSE_OPEN THEN REWRITE_TAC[DIFF_SIN] THEN 2141 MAP_EVERY EXISTS_TAC [���~(pi / &2)���, ���pi / &2���] THEN 2142 MP_TAC(SPEC ���x:real��� ASN_BOUNDS_LT) THEN ASM_REWRITE_TAC[] THEN 2143 DISCH_THEN(fn th => REWRITE_TAC[th]) THEN CONJ_TAC THENL 2144 [GEN_TAC THEN STRIP_TAC THEN IMP_RES_TAC REAL_LT_IMP_LE THEN 2145 REWRITE_TAC[MATCH_MP DIFF_CONT (SPEC_ALL DIFF_SIN)] THEN 2146 MATCH_MP_TAC SIN_ASN THEN ASM_REWRITE_TAC[], 2147 MATCH_MP_TAC COS_ASN_NZ THEN ASM_REWRITE_TAC[]]); 2148 2149val DIFF_ASN = store_thm("DIFF_ASN", 2150 ���!x. ~(&1) < x /\ x < &1 ==> (asn diffl (inv(sqrt(&1 - (x pow 2)))))(x)���, 2151 GEN_TAC THEN DISCH_TAC THEN 2152 FIRST_ASSUM(MP_TAC o MATCH_MP DIFF_ASN_LEMMA) THEN 2153 MATCH_MP_TAC(TAUT_CONV ���(a = b) ==> a ==> b���) THEN 2154 AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN 2155 SUBGOAL_THEN ���cos(asn(x)) = sqrt(&1 - (sin(asn x) pow 2))��� SUBST1_TAC THENL 2156 [MATCH_MP_TAC COS_SIN_SQ THEN MATCH_MP_TAC ASN_BOUNDS, 2157 SUBGOAL_THEN ���sin(asn x) = x��� SUBST1_TAC THEN REWRITE_TAC[] THEN 2158 MATCH_MP_TAC ASN_SIN] THEN 2159 CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]); 2160 2161(* Known as DIFF_ACS_SIN in GTT *) 2162val DIFF_ACS_LEMMA = store_thm("DIFF_ACS_LEMMA", 2163 ���!x. ~(&1) < x /\ x < &1 ==> (acs diffl inv(~(sin(acs x))))(x)���, 2164 GEN_TAC THEN STRIP_TAC THEN IMP_RES_TAC REAL_LT_IMP_LE THEN 2165 MP_TAC(SPEC ���x:real��� ACS_COS) THEN ASM_REWRITE_TAC[] THEN 2166 DISCH_THEN(fn th => GEN_REWR_TAC RAND_CONV [SYM th]) THEN 2167 MATCH_MP_TAC DIFF_INVERSE_OPEN THEN REWRITE_TAC[DIFF_COS] THEN 2168 MAP_EVERY EXISTS_TAC [���&0���, ���pi���] THEN 2169 MP_TAC(SPEC ���x:real��� ACS_BOUNDS_LT) THEN ASM_REWRITE_TAC[] THEN 2170 DISCH_THEN(fn th => REWRITE_TAC[th]) THEN CONJ_TAC THENL 2171 [GEN_TAC THEN STRIP_TAC THEN IMP_RES_TAC REAL_LT_IMP_LE THEN 2172 REWRITE_TAC[MATCH_MP DIFF_CONT (SPEC_ALL DIFF_COS)] THEN 2173 MATCH_MP_TAC COS_ACS THEN ASM_REWRITE_TAC[], 2174 REWRITE_TAC[REAL_NEG_EQ, REAL_NEG_0] THEN 2175 MATCH_MP_TAC SIN_ACS_NZ THEN ASM_REWRITE_TAC[]]); 2176 2177val DIFF_ACS = store_thm("DIFF_ACS", 2178 ���!x. ~(&1) < x /\ x < &1 ==> (acs diffl ~(inv(sqrt(&1 - (x pow 2)))))(x)���, 2179 GEN_TAC THEN DISCH_TAC THEN 2180 FIRST_ASSUM(MP_TAC o MATCH_MP DIFF_ACS_LEMMA) THEN 2181 MATCH_MP_TAC(TAUT_CONV ���(a = b) ==> a ==> b���) THEN 2182 AP_THM_TAC THEN AP_TERM_TAC THEN 2183 SUBGOAL_THEN ���sin(acs(x)) = sqrt(&1 - (cos(acs x) pow 2))��� SUBST1_TAC THENL 2184 [MATCH_MP_TAC SIN_COS_SQ THEN MATCH_MP_TAC ACS_BOUNDS, 2185 SUBGOAL_THEN ���cos(acs x) = x��� SUBST1_TAC THENL 2186 [MATCH_MP_TAC ACS_COS, 2187 CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_NEG_INV THEN 2188 MATCH_MP_TAC REAL_POS_NZ THEN REWRITE_TAC[sqrt, TWO] THEN 2189 MATCH_MP_TAC ROOT_POS_LT THEN 2190 REWRITE_TAC[REAL_LT_SUB_LADD, REAL_ADD_LID] THEN 2191 REWRITE_TAC[SYM(TWO), POW_2] THEN 2192 GEN_REWR_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN 2193 DISJ_CASES_TAC (SPEC ���x:real��� REAL_LE_NEGTOTAL) THENL 2194 [ALL_TAC, GEN_REWR_TAC LAND_CONV [GSYM REAL_NEG_MUL2]] THEN 2195 MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_REWRITE_TAC[] THEN 2196 ONCE_REWRITE_TAC [GSYM REAL_LT_NEG] THEN 2197 ASM_REWRITE_TAC[REAL_NEGNEG]]] THEN 2198 CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]); 2199 2200val DIFF_ATN = store_thm("DIFF_ATN", 2201 ���!x. (atn diffl (inv(&1 + (x pow 2))))(x)���, 2202 GEN_TAC THEN 2203 SUBGOAL_THEN ���(atn diffl (inv(&1 + (x pow 2))))(tan(atn x))��� MP_TAC THENL 2204 [MATCH_MP_TAC DIFF_INVERSE_OPEN, REWRITE_TAC[ATN_TAN]] THEN 2205 MAP_EVERY EXISTS_TAC [���~(pi / &2)���, ���pi / &2���] THEN 2206 REWRITE_TAC[ATN_BOUNDS] THEN REPEAT CONJ_TAC THENL 2207 [X_GEN_TAC ���x:real��� THEN DISCH_TAC THEN 2208 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP TAN_ATN th]) THEN 2209 MATCH_MP_TAC DIFF_CONT THEN 2210 EXISTS_TAC ���inv(cos(x) pow 2)��� THEN 2211 MATCH_MP_TAC DIFF_TAN THEN 2212 MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC COS_POS_PI THEN 2213 ASM_REWRITE_TAC[], 2214 MP_TAC(SPEC ���atn(x)��� DIFF_TAN) THEN REWRITE_TAC[COS_ATN_NZ] THEN 2215 REWRITE_TAC[MATCH_MP POW_INV (SPEC ���x:real��� COS_ATN_NZ)] THEN 2216 REWRITE_TAC[GSYM(MATCH_MP TAN_SEC (SPEC ���x:real��� COS_ATN_NZ))] THEN 2217 REWRITE_TAC[ATN_TAN], 2218 MATCH_MP_TAC REAL_POS_NZ THEN 2219 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC ���&1��� THEN 2220 REWRITE_TAC[REAL_LT_01, REAL_LE_ADDR, POW_2, REAL_LE_SQUARE]]); 2221 2222 2223 2224(* ======================================================================== *) 2225(* Formalization of Kurzweil-Henstock gauge integral *) 2226(* ======================================================================== *) 2227 2228fun LE_MATCH_TAC th (asl,w) = 2229 let val thi = PART_MATCH (rand o rator) th (rand(rator w)) 2230 val tm = rand(concl thi) 2231 in 2232 (MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC tm THEN CONJ_TAC THENL 2233 [MATCH_ACCEPT_TAC th, ALL_TAC]) (asl,w) 2234 end; 2235 2236(* ------------------------------------------------------------------------ *) 2237(* Some miscellaneous lemmas *) 2238(* ------------------------------------------------------------------------ *) 2239(* 2240let LESS_SUC_EQ = prove( 2241 `!m n. m < SUC n = m <= n`, 2242 REPEAT GEN_TAC THEN REWRITE_TAC[CONJUNCT2 LT; LE_LT] THEN 2243 EQ_TAC THEN DISCH_THEN(DISJ_CASES_THEN(fun th -> REWRITE_TAC[th])));; 2244*) 2245(* ------------------------------------------------------------------------ *) 2246(* Divisions and tagged divisions etc. *) 2247(* ------------------------------------------------------------------------ *) 2248 2249val division = new_definition("division", 2250Term`division(a,b) D = 2251 (D 0 = a) /\ 2252 (?N. (!n. n < N ==> D(n) < D(SUC n)) /\ 2253 (!n. n >= N ==> (D(n) = b)))`); 2254 2255val dsize = new_definition("dsize", 2256 Term`dsize D = 2257 @N. (!n. n < N ==> D(n) < D(SUC n)) /\ 2258 (!n. n >= N ==> (D(n) = D(N)))`); 2259 2260val tdiv = new_definition("tdiv", 2261 Term`tdiv(a,b) (D,p) = 2262 division(a,b) D /\ 2263 (!n. D(n) <= p(n) /\ p(n) <= D(SUC n))`); 2264 2265(* ------------------------------------------------------------------------ *) 2266(* Gauges and gauge-fine divisions *) 2267(* ------------------------------------------------------------------------ *) 2268 2269val gauge = new_definition("gauge", 2270 Term`gauge(E) (g:real->real) = !x. E x ==> &0 < g(x)`);; 2271 2272val fine = new_definition("fine", 2273 Term`fine(g:real->real) (D,p) = 2274 !n. n < dsize D ==> D(SUC n) - D(n) < g(p(n))`); 2275 2276(* ------------------------------------------------------------------------ *) 2277(* Riemann sum *) 2278(* ------------------------------------------------------------------------ *) 2279 2280val rsum = new_definition("rsum", 2281 Term`rsum (D,(p:num->real)) f = 2282 sum(0,dsize(D))(\n. f(p n) * (D(SUC n) - D(n)))`); 2283 2284(* ------------------------------------------------------------------------ *) 2285(* Gauge integrability (definite) *) 2286(* ------------------------------------------------------------------------ *) 2287 2288val Dint = new_definition("Dint", 2289 Term `Dint(a,b) f k = 2290 !e. &0 < e ==> 2291 ?g. gauge(\x. a <= x /\ x <= b) g /\ 2292 !D p. tdiv(a,b) (D,p) /\ fine(g)(D,p) ==> 2293 abs(rsum(D,p) f - k) < e`);; 2294 2295(* ------------------------------------------------------------------------ *) 2296(* Useful lemmas about the size of `trivial` divisions etc. *) 2297(* ------------------------------------------------------------------------ *) 2298 2299val DIVISION_0 = store_thm("DIVISION_0", 2300 Term `!a b. (a = b) ==> (dsize(\n:num. if (n = 0) then a else b) = 0)`, 2301 REPEAT GEN_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[COND_ID] THEN 2302 REWRITE_TAC[dsize] THEN MATCH_MP_TAC SELECT_UNIQUE THEN 2303 X_GEN_TAC (Term `n:num`) THEN BETA_TAC THEN 2304 REWRITE_TAC[REAL_LT_REFL, NOT_LESS] THEN EQ_TAC THENL 2305 [DISCH_THEN(MP_TAC o SPEC (Term `0:num`)) THEN 2306 REWRITE_TAC[LESS_OR_EQ,NOT_LESS_0], 2307 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ZERO_LESS_EQ]]);; 2308 2309val DIVISION_1 = store_thm("DIVISION_1", 2310 Term `!a b. a < b ==> (dsize(\n. if (n = 0) then a else b) = 1)`, 2311 REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[dsize] THEN 2312 MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC (Term `n:num`) THEN BETA_TAC THEN 2313 REWRITE_TAC[NOT_SUC] THEN EQ_TAC THENL 2314 [DISCH_TAC THEN MATCH_MP_TAC LESS_EQUAL_ANTISYM THEN CONJ_TAC THENL 2315 [POP_ASSUM(MP_TAC o SPEC (Term`1:num`) o CONJUNCT1) THEN 2316 REWRITE_TAC[ONE, GSYM SUC_NOT] THEN 2317 REWRITE_TAC[REAL_LT_REFL, NOT_LESS], 2318 POP_ASSUM(MP_TAC o SPEC (Term `2:num`) o CONJUNCT2) THEN 2319 REWRITE_TAC[TWO, GSYM SUC_NOT, GREATER_EQ] THEN 2320 CONV_TAC CONTRAPOS_CONV THEN 2321 REWRITE_TAC[ONE, NOT_SUC_LESS_EQ, CONJUNCT1 LE] THEN 2322 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[NOT_SUC, NOT_IMP] THEN 2323 REWRITE_TAC[LE] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN 2324 MATCH_MP_TAC REAL_LT_IMP_NE THEN POP_ASSUM ACCEPT_TAC], 2325 DISCH_THEN SUBST1_TAC THEN CONJ_TAC THENL 2326 [GEN_TAC THEN REWRITE_TAC[ONE,LESS_THM, NOT_LESS_0] THEN 2327 DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[], 2328 X_GEN_TAC (Term `n:num`) THEN REWRITE_TAC[GREATER_EQ,ONE] 2329 THEN ASM_CASES_TAC (Term `n:num = 0`) THEN 2330 ASM_REWRITE_TAC[CONJUNCT1 LE, GSYM NOT_SUC, NOT_SUC]]]); 2331 2332val LESS_1 = prove (Term`!x:num. x < 1 = (x = 0)`, 2333 INDUCT_TAC THEN 2334 REWRITE_TAC [ONE,LESS_0,LESS_MONO_EQ,NOT_LESS_0,GSYM SUC_NOT]); 2335 2336val DIVISION_SINGLE = store_thm("DIVISION_SINGLE", 2337 Term `!a b. a <= b ==> division(a,b)(\n. if (n = 0) then a else b)`, 2338 REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[division] THEN 2339 BETA_TAC THEN REWRITE_TAC[] THEN 2340 POP_ASSUM(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL 2341 [EXISTS_TAC (Term `1:num`) THEN CONJ_TAC THEN X_GEN_TAC (Term `n:num`) THENL 2342 [REWRITE_TAC[LESS_1] THEN DISCH_THEN SUBST1_TAC THEN 2343 ASM_REWRITE_TAC[NOT_SUC], 2344 REWRITE_TAC[GREATER_EQ] THEN 2345 COND_CASES_TAC THEN ASM_REWRITE_TAC[ONE] THEN 2346 REWRITE_TAC[LE, NOT_SUC]], 2347 EXISTS_TAC (Term `0:num`) THEN REWRITE_TAC[NOT_LESS_0] THEN 2348 ASM_REWRITE_TAC[COND_ID]]); 2349 2350val DIVISION_LHS = store_thm("DIVISION_LHS", 2351 Term `!D a b. division(a,b) D ==> (D(0) = a)`, 2352 REPEAT GEN_TAC THEN REWRITE_TAC[division] THEN 2353 DISCH_THEN(fn th => REWRITE_TAC[th])); 2354 2355val DIVISION_THM = store_thm("DIVISION_THM", 2356 Term `!D a b. 2357 division(a,b) D 2358 = 2359 (D(0) = a) /\ 2360 (!n. n < (dsize D) ==> D(n) < D(SUC n)) /\ 2361 (!n. n >= (dsize D) ==> (D(n) = b))`, 2362 REPEAT GEN_TAC THEN REWRITE_TAC[division] THEN 2363 EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THENL 2364 [ALL_TAC, EXISTS_TAC (Term `dsize D`) THEN ASM_REWRITE_TAC[]] THEN 2365 POP_ASSUM(X_CHOOSE_THEN (Term `N:num`) STRIP_ASSUME_TAC o CONJUNCT2) THEN 2366 SUBGOAL_THEN (Term `dsize D:num = N`) (fn th => ASM_REWRITE_TAC[th]) THEN 2367 REWRITE_TAC[dsize] THEN MATCH_MP_TAC SELECT_UNIQUE THEN 2368 X_GEN_TAC (Term `M:num`) THEN BETA_TAC THEN EQ_TAC THENL 2369 [ALL_TAC, DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN 2370 MP_TAC(SPEC (Term `N:num`) (ASSUME (Term `!n:num. n >= N ==> (D n:real = b)`))) 2371 THEN DISCH_THEN(MP_TAC o REWRITE_RULE[GREATER_EQ, LESS_EQ_REFL]) THEN 2372 DISCH_THEN SUBST1_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC] THEN 2373 REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC 2374 (SPECL [Term `M:num`, Term `N:num`] LESS_LESS_CASES) THEN 2375 ASM_REWRITE_TAC[] THENL 2376 [DISCH_THEN(MP_TAC o SPEC (Term `SUC M`) o CONJUNCT2) THEN 2377 REWRITE_TAC[GREATER_EQ, LESS_EQ_SUC_REFL] THEN DISCH_TAC THEN 2378 UNDISCH_TAC (Term `!n:num. n < N ==> (D n) < (D(SUC n))`) THEN 2379 DISCH_THEN(MP_TAC o SPEC (Term`M:num`)) THEN ASM_REWRITE_TAC[REAL_LT_REFL], 2380 DISCH_THEN(MP_TAC o SPEC (Term`N:num`) o CONJUNCT1) THEN ASM_REWRITE_TAC[] 2381 THEN UNDISCH_TAC (Term`!n:num. n >= N ==> (D n:real = b)`) THEN 2382 DISCH_THEN(fn th => MP_TAC(SPEC (Term`N:num`) th) THEN 2383 MP_TAC(SPEC (Term`SUC N`) th)) THEN 2384 REWRITE_TAC[GREATER_EQ, LESS_EQ_SUC_REFL, LESS_EQ_REFL] THEN 2385 DISCH_THEN SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN 2386 REWRITE_TAC[REAL_LT_REFL]]); 2387 2388val DIVISION_RHS = store_thm("DIVISION_RHS", 2389 Term`!D a b. division(a,b) D ==> (D(dsize D) = b)`, 2390 REPEAT GEN_TAC THEN REWRITE_TAC[DIVISION_THM] THEN 2391 DISCH_THEN(MP_TAC o SPEC (Term`dsize D`) o last o CONJUNCTS) THEN 2392 REWRITE_TAC[GREATER_EQ, LESS_EQ_REFL]); 2393 2394val DIVISION_LT_GEN = store_thm("DIVISION_LT_GEN", 2395Term`!D a b m n. division(a,b) D /\ m < n /\ n <= (dsize D) ==> D(m) < D(n)`, 2396 REPEAT STRIP_TAC THEN UNDISCH_TAC (Term`m:num < n`) THEN 2397 DISCH_THEN(X_CHOOSE_THEN (Term`d:num`) MP_TAC o MATCH_MP LESS_ADD_1) THEN 2398 REWRITE_TAC[GSYM ADD1] THEN DISCH_THEN SUBST_ALL_TAC THEN 2399 UNDISCH_TAC (Term `m + SUC d <= dsize D`) THEN 2400 SPEC_TAC(Term`d:num`,Term`d:num`) THEN INDUCT_TAC THENL 2401 [REWRITE_TAC[ADD_CLAUSES] THEN 2402 DISCH_THEN(MP_TAC o MATCH_MP OR_LESS) THEN 2403 RULE_ASSUM_TAC(REWRITE_RULE[DIVISION_THM]) THEN ASM_REWRITE_TAC[], 2404 REWRITE_TAC[ADD_CLAUSES] THEN 2405 DISCH_THEN(MP_TAC o MATCH_MP OR_LESS) THEN 2406 DISCH_TAC THEN MATCH_MP_TAC REAL_LT_TRANS THEN 2407 EXISTS_TAC (Term`D(m + SUC d):real`) THEN CONJ_TAC THENL 2408 [FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN 2409 MATCH_MP_TAC LESS_IMP_LESS_OR_EQ THEN ASM_REWRITE_TAC[], 2410 REWRITE_TAC[ADD_CLAUSES] THEN 2411 FIRST_ASSUM(MATCH_MP_TAC o el 2 o 2412 CONJUNCTS o REWRITE_RULE[DIVISION_THM]) THEN 2413 ASM_REWRITE_TAC[]]]);; 2414 2415val DIVISION_LT = store_thm("DIVISION_LT", 2416 Term`!D a b. division(a,b) D ==> !n. n < (dsize D) ==> D(0) < D(SUC n)`, 2417 REPEAT GEN_TAC THEN REWRITE_TAC[DIVISION_THM] THEN STRIP_TAC THEN 2418 INDUCT_TAC THEN DISCH_THEN(fn th => ASSUME_TAC th THEN 2419 FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN 2420 ASM_REWRITE_TAC[] THEN DISCH_TAC THEN 2421 MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC (Term`D(SUC n):real`) THEN 2422 ASM_REWRITE_TAC[] THEN UNDISCH_TAC (Term`D(0:num):real = a`) THEN 2423 DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_ASSUM MATCH_MP_TAC THEN 2424 MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC (Term`SUC n`) THEN 2425 ASM_REWRITE_TAC[LESS_SUC_REFL]); 2426 2427val DIVISION_LE = store_thm("DIVISION_LE", 2428 Term`!D a b. division(a,b) D ==> a <= b`, 2429 REPEAT GEN_TAC THEN DISCH_TAC THEN 2430 FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_LT) THEN 2431 POP_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[DIVISION_THM]) THEN 2432 UNDISCH_TAC (Term`D(0:num):real = a`) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN 2433 UNDISCH_TAC (Term`!n. n >= (dsize D) ==> (D n = b)`) THEN 2434 DISCH_THEN(MP_TAC o SPEC (Term`dsize D`)) THEN 2435 REWRITE_TAC[GREATER_EQ, LESS_EQ_REFL] THEN 2436 DISCH_THEN(SUBST1_TAC o SYM) THEN 2437 DISCH_THEN(MP_TAC o SPEC (Term`PRE(dsize D)`)) THEN 2438 STRUCT_CASES_TAC(SPEC (Term`dsize D`) num_CASES) THEN 2439 ASM_REWRITE_TAC[PRE, REAL_LE_REFL, LESS_SUC_REFL, REAL_LT_IMP_LE]);; 2440 2441val DIVISION_GT = store_thm("DIVISION_GT", 2442 Term`!D a b. division(a,b) D ==> !n. n < (dsize D) ==> D(n) < D(dsize D)`, 2443 REPEAT STRIP_TAC THEN MATCH_MP_TAC DIVISION_LT_GEN THEN 2444 MAP_EVERY EXISTS_TAC [Term`a:real`, Term`b:real`] THEN 2445 ASM_REWRITE_TAC[LESS_EQ_REFL]);; 2446 2447val DIVISION_EQ = store_thm("DIVISION_EQ", 2448 Term`!D a b. division(a,b) D ==> ((a = b) = (dsize D = 0))`, 2449 REPEAT GEN_TAC THEN DISCH_TAC THEN 2450 FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_LT) THEN 2451 POP_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[DIVISION_THM]) THEN 2452 UNDISCH_TAC (Term`D(0:num):real = a`) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN 2453 UNDISCH_TAC (Term`!n. n >= (dsize D) ==> (D n = b)`) THEN 2454 DISCH_THEN(MP_TAC o SPEC (Term`dsize D`)) THEN 2455 REWRITE_TAC[GREATER_EQ, LESS_EQ_REFL] THEN 2456 DISCH_THEN(SUBST1_TAC o SYM) THEN 2457 DISCH_THEN(MP_TAC o SPEC (Term`PRE(dsize D)`)) THEN 2458 STRUCT_CASES_TAC(SPEC (Term`dsize D`) num_CASES) THEN 2459 ASM_REWRITE_TAC[PRE, NOT_SUC, LESS_SUC_REFL, REAL_LT_IMP_NE]); 2460 2461val DIVISION_LBOUND = store_thm("DIVISION_LBOUND", 2462 Term`!D a b. division(a,b) D ==> !r. a <= D(r)`, 2463 REPEAT GEN_TAC THEN REWRITE_TAC[DIVISION_THM] THEN STRIP_TAC THEN 2464 INDUCT_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN 2465 DISJ_CASES_TAC(SPECL [Term`SUC r`, Term`dsize D`] LESS_CASES) THENL 2466 [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC (Term`(D:num->real) r`) THEN 2467 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN 2468 FIRST_ASSUM MATCH_MP_TAC THEN 2469 MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC (Term`SUC r`) THEN 2470 ASM_REWRITE_TAC[LESS_SUC_REFL], 2471 MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC (Term`b:real`) THEN CONJ_TAC 2472 THENL 2473 [MATCH_MP_TAC DIVISION_LE THEN 2474 EXISTS_TAC (Term`D:num->real`) THEN ASM_REWRITE_TAC[DIVISION_THM], 2475 MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN 2476 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GREATER_EQ]]]);; 2477 2478val DIVISION_LBOUND_LT = store_thm("DIVISION_LBOUND_LT", 2479 Term`!D a b. division(a,b) D /\ ~(dsize D = 0) ==> !n. a < D(SUC n)`, 2480 REPEAT STRIP_TAC THEN 2481 FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP DIVISION_LHS) THEN 2482 DISJ_CASES_TAC(SPECL [Term`dsize D`, Term`SUC n`] LESS_CASES) THENL 2483 [FIRST_ASSUM(MP_TAC o el 3 o CONJUNCTS o REWRITE_RULE[DIVISION_THM]) THEN 2484 DISCH_THEN(MP_TAC o SPEC (Term`SUC n`)) THEN REWRITE_TAC[GREATER_EQ] THEN 2485 IMP_RES_THEN ASSUME_TAC LESS_IMP_LESS_OR_EQ THEN ASM_REWRITE_TAC[] THEN 2486 DISCH_THEN SUBST1_TAC THEN 2487 FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP DIVISION_RHS) THEN 2488 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP DIVISION_GT) THEN 2489 ASM_REWRITE_TAC[GSYM NOT_LESS_EQUAL, CONJUNCT1 LE], 2490 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP DIVISION_LT) THEN 2491 MATCH_MP_TAC OR_LESS THEN ASM_REWRITE_TAC[]]);; 2492 2493val DIVISION_UBOUND = store_thm("DIVISION_UBOUND", 2494 Term`!D a b. division(a,b) D ==> !r. D(r) <= b`, 2495 REPEAT GEN_TAC THEN REWRITE_TAC[DIVISION_THM] THEN STRIP_TAC THEN 2496 GEN_TAC THEN DISJ_CASES_TAC(SPECL [Term`r:num`, Term`dsize D`] LESS_CASES) 2497 THENL [ALL_TAC, 2498 MATCH_MP_TAC REAL_EQ_IMP_LE THEN FIRST_ASSUM MATCH_MP_TAC THEN 2499 ASM_REWRITE_TAC[GREATER_EQ]] THEN 2500 SUBGOAL_THEN (Term`!r. D((dsize D) - r) <= b`) MP_TAC THENL 2501 [ALL_TAC, 2502 DISCH_THEN(MP_TAC o SPEC (Term`(dsize D) - r`)) THEN 2503 MATCH_MP_TAC(TAUT_CONV (Term`(a = b) ==> a ==> b`)) THEN 2504 AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN 2505 FIRST_ASSUM(fn th => REWRITE_TAC[MATCH_MP SUB_SUB 2506 (MATCH_MP LESS_IMP_LESS_OR_EQ th)]) 2507 THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB]] THEN 2508 UNDISCH_TAC (Term`r < dsize D`) THEN DISCH_THEN(K ALL_TAC) THEN 2509 INDUCT_TAC THENL 2510 [REWRITE_TAC[SUB_0] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN 2511 FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GREATER_EQ, LESS_EQ_REFL], 2512 ALL_TAC] THEN 2513 DISJ_CASES_TAC(SPECL [Term`r:num`, Term`dsize D`] LESS_CASES) THENL 2514 [ALL_TAC, 2515 SUBGOAL_THEN (Term`(dsize D) - (SUC r) = 0`) SUBST1_TAC THENL 2516 [REWRITE_TAC[SUB_EQ_0] THEN MATCH_MP_TAC LESS_EQ_TRANS THEN 2517 EXISTS_TAC (Term`r:num`) THEN ASM_REWRITE_TAC[LESS_EQ_SUC_REFL], 2518 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVISION_LE THEN 2519 EXISTS_TAC (Term`D:num->real`) THEN ASM_REWRITE_TAC[DIVISION_THM]]] THEN 2520 MATCH_MP_TAC REAL_LE_TRANS THEN 2521 EXISTS_TAC (Term`D((dsize D) - r):real`) THEN ASM_REWRITE_TAC[] THEN 2522 SUBGOAL_THEN (Term`(dsize D) - r = SUC((dsize D) - (SUC r))`) 2523 SUBST1_TAC THENL 2524 [ALL_TAC, 2525 MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM MATCH_MP_TAC THEN 2526 MATCH_MP_TAC LESS_CASES_IMP THEN 2527 REWRITE_TAC[NOT_LESS, SUB_LESS_EQ] THEN 2528 CONV_TAC(RAND_CONV SYM_CONV) THEN 2529 REWRITE_TAC[SUB_EQ_EQ_0, NOT_SUC] THEN 2530 DISCH_THEN SUBST_ALL_TAC THEN 2531 UNDISCH_TAC (Term`r:num < 0`) THEN REWRITE_TAC[NOT_LESS_0]] THEN 2532 MP_TAC(SPECL [Term`dsize D`, Term`SUC r`] (CONJUNCT2 SUB)) THEN 2533 COND_CASES_TAC THENL 2534 [REWRITE_TAC[SUB_EQ_0, LESS_EQ_MONO] THEN 2535 ASM_REWRITE_TAC[GSYM NOT_LESS], 2536 DISCH_THEN (SUBST1_TAC o SYM) THEN REWRITE_TAC[SUB_MONO_EQ]]); 2537 2538val DIVISION_UBOUND_LT = store_thm("DIVISION_UBOUND_LT", 2539 Term`!D a b n. division(a,b) D /\ n < dsize D ==> D(n) < b`, 2540 REPEAT STRIP_TAC THEN 2541 FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP DIVISION_RHS) THEN 2542 FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP DIVISION_GT) THEN 2543 ASM_REWRITE_TAC[]); 2544 2545(* ------------------------------------------------------------------------ *) 2546(* Divisions of adjacent intervals can be combined into one *) 2547(* ------------------------------------------------------------------------ *) 2548 2549val D_tm = Term`\n. if n < dsize D1 then D1(n) else D2(n - dsize D1)` 2550and p_tm = Term`\n. if n < dsize D1 then (p1:num->real)(n) else p2(n - dsize D1)`; 2551 2552val DIVISION_APPEND_LEMMA1 = prove( 2553 Term `!a b c D1 D2. 2554 division(a,b) D1 /\ division(b,c) D2 2555 ==> 2556 (!n. n < dsize D1 + dsize D2 2557 ==> 2558 (\n. if n < dsize D1 then D1(n) else D2(n - dsize D1)) (n) 2559 < 2560 (\n. if n < dsize D1 then D1(n) else D2(n - dsize D1)) (SUC n)) /\ 2561 (!n. n >= dsize D1 + dsize D2 2562 ==> 2563 ((\n. if n<dsize D1 then D1(n) else D2(n - dsize D1)) (n) 2564 = 2565 (\n. if n<dsize D1 then D1(n) else D2(n - dsize D1)) (dsize D1 + dsize D2)))`, 2566 REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THEN 2567 X_GEN_TAC (Term`n:num`) THEN DISCH_TAC THEN BETA_TAC THENL 2568 [ASM_CASES_TAC (Term`SUC n < dsize D1`) THEN ASM_REWRITE_TAC[] THENL 2569 [SUBGOAL_THEN (Term`n < dsize D1`) ASSUME_TAC THEN 2570 ASM_REWRITE_TAC[] THENL 2571 [MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC (Term`SUC n`) THEN 2572 ASM_REWRITE_TAC[LESS_SUC_REFL], 2573 UNDISCH_TAC (Term`division(a,b) D1`) THEN REWRITE_TAC[DIVISION_THM] THEN 2574 STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN 2575 FIRST_ASSUM ACCEPT_TAC], 2576 ASM_CASES_TAC (Term`n < dsize D1`) THEN ASM_REWRITE_TAC[] THENL 2577 [RULE_ASSUM_TAC(REWRITE_RULE[NOT_LESS]) THEN 2578 MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC (Term`b:real`) THEN 2579 CONJ_TAC THENL 2580 [MATCH_MP_TAC DIVISION_UBOUND_LT THEN 2581 EXISTS_TAC (Term`a:real`) THEN ASM_REWRITE_TAC[], 2582 MATCH_MP_TAC DIVISION_LBOUND THEN 2583 EXISTS_TAC (Term`c:real`) THEN ASM_REWRITE_TAC[]], 2584 UNDISCH_TAC (Term`~(n < dsize D1)`) THEN 2585 REWRITE_TAC[NOT_LESS] THEN 2586 DISCH_THEN(X_CHOOSE_THEN (Term`d:num`) SUBST_ALL_TAC o 2587 REWRITE_RULE[LESS_EQ_EXISTS]) THEN 2588 REWRITE_TAC[SUB, GSYM NOT_LESS_EQUAL, LESS_EQ_ADD] THEN 2589 ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN 2590 FIRST_ASSUM(MATCH_MP_TAC o Lib.trye el 2 o CONJUNCTS o 2591 REWRITE_RULE[DIVISION_THM]) THEN 2592 UNDISCH_TAC (Term`dsize D1 + d < dsize D1 + dsize D2`) THEN 2593 ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[LESS_MONO_ADD_EQ]]], 2594 REWRITE_TAC[GSYM NOT_LESS_EQUAL, LESS_EQ_ADD] THEN 2595 ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN 2596 REWRITE_TAC[NOT_LESS_EQUAL] THEN COND_CASES_TAC THEN 2597 UNDISCH_TAC (Term`n >= dsize D1 + dsize D2`) THENL 2598 [CONV_TAC CONTRAPOS_CONV THEN DISCH_TAC THEN 2599 REWRITE_TAC[GREATER_EQ, NOT_LESS_EQUAL] THEN 2600 MATCH_MP_TAC LESS_IMP_LESS_ADD THEN ASM_REWRITE_TAC[], 2601 REWRITE_TAC[GREATER_EQ, LESS_EQ_EXISTS] THEN 2602 DISCH_THEN(X_CHOOSE_THEN (Term`d:num`) SUBST_ALL_TAC) THEN 2603 REWRITE_TAC[GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN 2604 REWRITE_TAC[ADD_SUB] THEN 2605 FIRST_ASSUM(CHANGED_TAC o 2606 (SUBST1_TAC o MATCH_MP DIVISION_RHS)) THEN 2607 FIRST_ASSUM(MATCH_MP_TAC o el 3 o CONJUNCTS o 2608 REWRITE_RULE[DIVISION_THM]) THEN 2609 REWRITE_TAC[GREATER_EQ, LESS_EQ_ADD]]]); 2610 2611val DIVISION_APPEND_LEMMA2 = prove( 2612 Term`!a b c D1 D2. 2613 division(a,b) D1 /\ division(b,c) D2 2614 ==> 2615 (dsize(\n. if n < dsize D1 then D1(n) else D2(n - dsize D1)) 2616 = 2617 dsize D1 + dsize D2)`, 2618 REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [] [dsize] THEN 2619 MATCH_MP_TAC SELECT_UNIQUE THEN 2620 X_GEN_TAC (Term`N:num`) THEN BETA_TAC THEN EQ_TAC THENL 2621 [DISCH_THEN(curry op THEN (MATCH_MP_TAC LESS_EQUAL_ANTISYM) o MP_TAC) THEN 2622 CONV_TAC CONTRAPOS_CONV THEN 2623 REWRITE_TAC[DE_MORGAN_THM, NOT_LESS_EQUAL] THEN 2624 DISCH_THEN DISJ_CASES_TAC THENL 2625 [DISJ1_TAC THEN 2626 DISCH_THEN(MP_TAC o SPEC (Term`dsize D1 + dsize D2`)) THEN 2627 ASM_REWRITE_TAC[] THEN 2628 REWRITE_TAC[GSYM NOT_LESS_EQUAL, LESS_EQ_ADD] THEN 2629 SUBGOAL_THEN (Term`!x y. x <= SUC(x + y)`) ASSUME_TAC THENL 2630 [REPEAT GEN_TAC THEN MATCH_MP_TAC LESS_EQ_TRANS THEN 2631 EXISTS_TAC (Term`(x:num) + y`) THEN 2632 REWRITE_TAC[LESS_EQ_ADD, LESS_EQ_SUC_REFL], ALL_TAC] THEN 2633 ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUB, GSYM NOT_LESS_EQUAL] THEN 2634 REWRITE_TAC[LESS_EQ_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN 2635 REWRITE_TAC[ADD_SUB] THEN 2636 MP_TAC(ASSUME (Term`division(b,c) D2`)) THEN REWRITE_TAC[DIVISION_THM] 2637 THEN DISCH_THEN(MP_TAC o SPEC (Term`SUC(dsize D2)`) o el 3 o CONJUNCTS) 2638 THEN REWRITE_TAC[GREATER_EQ, LESS_EQ_SUC_REFL] THEN 2639 DISCH_THEN SUBST1_TAC THEN 2640 FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_RHS) THEN 2641 REWRITE_TAC[REAL_LT_REFL], 2642 DISJ2_TAC THEN 2643 DISCH_THEN(MP_TAC o SPEC (Term`dsize D1 + dsize D2`)) THEN 2644 FIRST_ASSUM(ASSUME_TAC o MATCH_MP LESS_IMP_LESS_OR_EQ) THEN 2645 ASM_REWRITE_TAC[GREATER_EQ] THEN 2646 REWRITE_TAC[GSYM NOT_LESS_EQUAL, LESS_EQ_ADD] THEN 2647 ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN 2648 COND_CASES_TAC THENL 2649 [SUBGOAL_THEN (Term`D1(N:num) < D2(dsize D2)`) MP_TAC THENL 2650 [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC (Term`b:real`) THEN 2651 CONJ_TAC THENL 2652 [MATCH_MP_TAC DIVISION_UBOUND_LT THEN EXISTS_TAC (Term`a:real`) THEN 2653 ASM_REWRITE_TAC[GSYM NOT_LESS_EQUAL], 2654 MATCH_MP_TAC DIVISION_LBOUND THEN 2655 EXISTS_TAC (Term`c:real`) THEN ASM_REWRITE_TAC[]], 2656 CONV_TAC CONTRAPOS_CONV THEN ASM_REWRITE_TAC[] THEN 2657 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_LT_REFL]], 2658 RULE_ASSUM_TAC(REWRITE_RULE[]) THEN 2659 SUBGOAL_THEN (Term`D2(N - dsize D1) < D2(dsize D2)`) MP_TAC THENL 2660 [MATCH_MP_TAC DIVISION_LT_GEN THEN 2661 MAP_EVERY EXISTS_TAC [Term`b:real`, Term`c:real`] THEN 2662 ASM_REWRITE_TAC[LESS_EQ_REFL] THEN 2663 REWRITE_TAC[GSYM NOT_LESS_EQUAL] THEN 2664 REWRITE_TAC[SUB_LEFT_LESS_EQ, DE_MORGAN_THM] THEN 2665 ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[NOT_LESS_EQUAL] THEN 2666 UNDISCH_TAC (Term`dsize(D1) <= N`) THEN 2667 REWRITE_TAC[LESS_EQ_EXISTS] THEN 2668 DISCH_THEN(X_CHOOSE_THEN (Term`d:num`) SUBST_ALL_TAC) THEN 2669 RULE_ASSUM_TAC(ONCE_REWRITE_RULE[ADD_SYM]) THEN 2670 RULE_ASSUM_TAC(REWRITE_RULE[LESS_MONO_ADD_EQ]) THEN 2671 MATCH_MP_TAC LESS_EQ_LESS_TRANS THEN EXISTS_TAC (Term`d:num`) THEN 2672 ASM_REWRITE_TAC[ZERO_LESS_EQ], 2673 CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN 2674 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_LT_REFL]]]], 2675 DISCH_THEN SUBST1_TAC THEN CONJ_TAC THENL 2676 [X_GEN_TAC (Term`n:num`) THEN DISCH_TAC THEN 2677 ASM_CASES_TAC (Term`SUC n < dsize D1`) THEN 2678 ASM_REWRITE_TAC[] THENL 2679 [SUBGOAL_THEN (Term`n < dsize D1`) ASSUME_TAC THENL 2680 [MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC (Term`SUC n`) THEN 2681 ASM_REWRITE_TAC[LESS_SUC_REFL], ALL_TAC] THEN 2682 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVISION_LT_GEN THEN 2683 MAP_EVERY EXISTS_TAC [Term`a:real`, Term`b:real`] THEN 2684 ASM_REWRITE_TAC[LESS_SUC_REFL] THEN 2685 MATCH_MP_TAC LESS_IMP_LESS_OR_EQ THEN ASM_REWRITE_TAC[], 2686 COND_CASES_TAC THENL 2687 [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC (Term`b:real`) THEN 2688 CONJ_TAC THENL 2689 [MATCH_MP_TAC DIVISION_UBOUND_LT THEN EXISTS_TAC (Term`a:real`) THEN 2690 ASM_REWRITE_TAC[], 2691 FIRST_ASSUM(MATCH_ACCEPT_TAC o MATCH_MP DIVISION_LBOUND)], 2692 MATCH_MP_TAC DIVISION_LT_GEN THEN 2693 MAP_EVERY EXISTS_TAC [Term`b:real`, Term`c:real`] THEN 2694 ASM_REWRITE_TAC[] THEN 2695 CONJ_TAC THENL [ASM_REWRITE_TAC[SUB, LESS_SUC_REFL], ALL_TAC] THEN 2696 REWRITE_TAC[REWRITE_RULE[GREATER_EQ] SUB_LEFT_GREATER_EQ] THEN 2697 ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[GSYM LESS_EQ]]], 2698 X_GEN_TAC (Term`n:num`) THEN REWRITE_TAC[GREATER_EQ] THEN DISCH_TAC THEN 2699 REWRITE_TAC[GSYM NOT_LESS_EQUAL,LESS_EQ_ADD] THEN 2700 SUBGOAL_THEN (Term`dsize D1 <= n`) ASSUME_TAC THENL 2701 [MATCH_MP_TAC LESS_EQ_TRANS THEN 2702 EXISTS_TAC (Term `dsize D1 + dsize D2`) THEN 2703 ASM_REWRITE_TAC[LESS_EQ_ADD], 2704 ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN 2705 REWRITE_TAC[ADD_SUB] THEN 2706 FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_RHS) THEN 2707 FIRST_ASSUM(MATCH_MP_TAC o el 3 o 2708 CONJUNCTS o REWRITE_RULE[DIVISION_THM]) THEN 2709 REWRITE_TAC[GREATER_EQ, SUB_LEFT_LESS_EQ] THEN 2710 ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[]]]]); 2711 2712val DIVISION_APPEND = store_thm("DIVISION_APPEND", 2713 Term`!a b c. 2714 (?D1 p1. tdiv(a,b) (D1,p1) /\ fine(g) (D1,p1)) /\ 2715 (?D2 p2. tdiv(b,c) (D2,p2) /\ fine(g) (D2,p2)) ==> 2716 ?D p. tdiv(a,c) (D,p) /\ fine(g) (D,p)`, 2717 REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC [D_tm, p_tm] THEN 2718 DISJ_CASES_TAC(GSYM (SPEC (Term`dsize(D1)`) LESS_0_CASES)) THENL 2719 [ASM_REWRITE_TAC[NOT_LESS_0, SUB_0] THEN 2720 CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN 2721 SUBGOAL_THEN (Term`a:real = b`) (fn th => ASM_REWRITE_TAC[th]) THEN 2722 MP_TAC(SPECL [Term`D1:num->real`, Term`a:real`,Term`b:real`] DIVISION_EQ) 2723 THEN RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN ASM_REWRITE_TAC[], ALL_TAC] 2724 THEN CONJ_TAC THENL 2725 [ALL_TAC, 2726 REWRITE_TAC[fine] THEN X_GEN_TAC (Term`n:num`) THEN 2727 RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN 2728 MP_TAC(SPECL [Term`a:real`, Term`b:real`, Term`c:real`, 2729 Term`D1:num->real`, Term`D2:num->real`] 2730 DIVISION_APPEND_LEMMA2) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN 2731 ASM_REWRITE_TAC[] THEN BETA_TAC THEN DISCH_TAC THEN 2732 ASM_CASES_TAC (Term`SUC n < dsize D1`) THEN ASM_REWRITE_TAC[] THENL 2733 [SUBGOAL_THEN (Term`n < dsize D1`) ASSUME_TAC THENL 2734 [MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC (Term`SUC n`) THEN 2735 ASM_REWRITE_TAC[LESS_SUC_REFL], ALL_TAC] THEN 2736 ASM_REWRITE_TAC[] THEN 2737 FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[fine]) THEN 2738 ASM_REWRITE_TAC[], ALL_TAC] THEN 2739 ASM_CASES_TAC (Term`n < dsize D1`) THEN ASM_REWRITE_TAC[] THENL 2740 [SUBGOAL_THEN (Term`SUC n = dsize D1`) ASSUME_TAC THENL 2741 [MATCH_MP_TAC LESS_EQUAL_ANTISYM THEN 2742 ASM_REWRITE_TAC[GSYM NOT_LESS] THEN 2743 REWRITE_TAC[NOT_LESS] THEN MATCH_MP_TAC LESS_OR THEN 2744 ASM_REWRITE_TAC[], 2745 ASM_REWRITE_TAC[SUB_EQUAL_0] THEN 2746 FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_LHS o 2747 CONJUNCT1) THEN 2748 FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o SYM o 2749 MATCH_MP DIVISION_RHS o CONJUNCT1) THEN 2750 SUBST1_TAC(SYM(ASSUME (Term`SUC n = dsize D1`))) THEN 2751 FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[fine]) THEN 2752 ASM_REWRITE_TAC[]], 2753 ASM_REWRITE_TAC[SUB] THEN UNDISCH_TAC (Term`~(n < (dsize D1))`) THEN 2754 REWRITE_TAC[LESS_EQ_EXISTS, NOT_LESS] THEN 2755 DISCH_THEN(X_CHOOSE_THEN (Term`d:num`) SUBST_ALL_TAC) THEN 2756 ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN 2757 FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[fine]) THEN 2758 RULE_ASSUM_TAC(ONCE_REWRITE_RULE[ADD_SYM]) THEN 2759 RULE_ASSUM_TAC(REWRITE_RULE[LESS_MONO_ADD_EQ]) THEN 2760 FIRST_ASSUM ACCEPT_TAC]] THEN 2761 REWRITE_TAC[tdiv] THEN BETA_TAC THEN CONJ_TAC THENL 2762 [RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN 2763 REWRITE_TAC[DIVISION_THM] THEN CONJ_TAC THENL 2764 [BETA_TAC THEN ASM_REWRITE_TAC[] THEN 2765 MATCH_MP_TAC DIVISION_LHS THEN EXISTS_TAC (Term`b:real`) THEN 2766 ASM_REWRITE_TAC[], ALL_TAC] THEN 2767 SUBGOAL_THEN (Term`c = (\n. if n < dsize D1 then D1(n) else D2(n - dsize D1)) 2768 (dsize D1 + dsize D2)`) SUBST1_TAC THENL 2769 [BETA_TAC THEN REWRITE_TAC[GSYM NOT_LESS_EQUAL, LESS_EQ_ADD] THEN 2770 ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN 2771 CONV_TAC SYM_CONV THEN MATCH_MP_TAC DIVISION_RHS THEN 2772 EXISTS_TAC (Term`b:real`) THEN ASM_REWRITE_TAC[], ALL_TAC] THEN 2773 MP_TAC(SPECL [Term`a:real`, Term`b:real`, Term`c:real`, 2774 Term`D1:num->real`, Term`D2:num->real`] 2775 DIVISION_APPEND_LEMMA2) THEN ASM_REWRITE_TAC[] THEN 2776 DISCH_THEN(fn th => REWRITE_TAC[th]) THEN 2777 MATCH_MP_TAC DIVISION_APPEND_LEMMA1 THEN 2778 MAP_EVERY EXISTS_TAC [Term`a:real`, Term`b:real`, Term`c:real`] THEN 2779 ASM_REWRITE_TAC[], ALL_TAC] THEN 2780 X_GEN_TAC (Term`n:num`) THEN RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN 2781 ASM_CASES_TAC (Term`SUC n < dsize D1`) THEN ASM_REWRITE_TAC[] THENL 2782 [SUBGOAL_THEN (Term`n < dsize D1`) ASSUME_TAC THENL 2783 [MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC (Term`SUC n`) THEN 2784 ASM_REWRITE_TAC[LESS_SUC_REFL], ALL_TAC] THEN 2785 ASM_REWRITE_TAC[], ALL_TAC] THEN 2786 COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL 2787 [ASM_REWRITE_TAC[SUB] THEN 2788 FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_LHS o 2789 CONJUNCT1) THEN 2790 FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o SYM o 2791 MATCH_MP DIVISION_RHS o CONJUNCT1) THEN 2792 SUBGOAL_THEN (Term`dsize D1 = SUC n`) (fn th => ASM_REWRITE_TAC[th]) THEN 2793 MATCH_MP_TAC LESS_EQUAL_ANTISYM THEN 2794 ASM_REWRITE_TAC[GSYM NOT_LESS] THEN REWRITE_TAC[NOT_LESS] THEN 2795 MATCH_MP_TAC LESS_OR THEN ASM_REWRITE_TAC[], 2796 ASM_REWRITE_TAC[SUB]]); 2797 2798(* ------------------------------------------------------------------------ *) 2799(* We can always find a division which is fine wrt any gauge *) 2800(* ------------------------------------------------------------------------ *) 2801 2802val DIVISION_EXISTS = store_thm("DIVISION_EXISTS", 2803 Term `!a b g. a <= b /\ gauge(\x. a <= x /\ x <= b) g 2804 ==> 2805 ?D p. tdiv(a,b) (D,p) /\ fine(g) (D,p)`, 2806 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN 2807 (MP_TAC o C SPEC BOLZANO_LEMMA) 2808 (Term `\(u,v). a <= u /\ v <= b 2809 ==> ?D p. tdiv(u,v) (D,p) /\ fine(g) (D,p)`) THEN 2810 CONV_TAC(ONCE_DEPTH_CONV PAIRED_BETA_CONV) THEN 2811 W(C SUBGOAL_THEN (fn t => REWRITE_TAC[t]) o 2812 funpow 2 (fst o dest_imp) o snd) THENL 2813 [CONJ_TAC, 2814 DISCH_THEN(MP_TAC o SPECL [Term`a:real`, Term`b:real`]) THEN 2815 REWRITE_TAC[REAL_LE_REFL]] 2816 THENL 2817 [MAP_EVERY X_GEN_TAC [Term`u:real`, Term`v:real`, Term`w:real`] THEN 2818 REPEAT STRIP_TAC THEN MATCH_MP_TAC DIVISION_APPEND THEN 2819 EXISTS_TAC (Term`v:real`) THEN CONJ_TAC THEN 2820 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THENL 2821 [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC (Term`w:real`), 2822 MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC (Term`u:real`)] THEN 2823 ASM_REWRITE_TAC[], ALL_TAC] THEN 2824 X_GEN_TAC (Term`x:real`) THEN ASM_CASES_TAC (Term`a <= x /\ x <= b`) THENL 2825 [ALL_TAC, 2826 EXISTS_TAC (Term`&1`) THEN REWRITE_TAC[REAL_LT_01] THEN 2827 MAP_EVERY X_GEN_TAC [Term`w:real`, Term`y:real`] THEN STRIP_TAC THEN 2828 CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN 2829 FIRST_ASSUM(UNDISCH_TAC o assert is_neg o concl) THEN 2830 REWRITE_TAC[DE_MORGAN_THM, REAL_NOT_LE] THEN 2831 DISCH_THEN DISJ_CASES_TAC THENL 2832 [DISJ1_TAC THEN MATCH_MP_TAC REAL_LET_TRANS, 2833 DISJ2_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS] THEN 2834 EXISTS_TAC (Term`x:real`) THEN ASM_REWRITE_TAC[]] THEN 2835 UNDISCH_TAC (Term`gauge(\x. a <= x /\ x <= b) g`) THEN 2836 REWRITE_TAC[gauge] THEN BETA_TAC THEN 2837 DISCH_THEN(fn th => FIRST_ASSUM(ASSUME_TAC o MATCH_MP th)) THEN 2838 EXISTS_TAC (Term`(g:real->real) x`) THEN ASM_REWRITE_TAC[] THEN 2839 MAP_EVERY X_GEN_TAC [Term`w:real`, Term`y:real`] THEN REPEAT STRIP_TAC THEN 2840 EXISTS_TAC (Term`\n:num. if (n = 0) then (w:real) else y`) THEN 2841 EXISTS_TAC (Term`\n:num. if (n = 0) then (x:real) else y`) THEN 2842 SUBGOAL_THEN (Term`w <= y`) ASSUME_TAC THENL 2843 [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC (Term`x:real`) THEN 2844 ASM_REWRITE_TAC[], ALL_TAC] THEN 2845 CONJ_TAC THENL 2846 [REWRITE_TAC[tdiv] THEN CONJ_TAC THENL 2847 [MATCH_MP_TAC DIVISION_SINGLE THEN FIRST_ASSUM ACCEPT_TAC, 2848 X_GEN_TAC (Term`n:num`) THEN BETA_TAC THEN REWRITE_TAC[NOT_SUC] THEN 2849 COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]], 2850 REWRITE_TAC[fine] THEN BETA_TAC THEN REWRITE_TAC[NOT_SUC] THEN 2851 X_GEN_TAC (Term`n:num`) THEN 2852 DISJ_CASES_THEN MP_TAC (REWRITE_RULE[REAL_LE_LT] (ASSUME(Term`w <= y`))) 2853 THENL 2854 [DISCH_THEN(ASSUME_TAC o MATCH_MP DIVISION_1) THEN 2855 ASM_REWRITE_TAC[num_CONV (Term`1:num`), LESS_THM, NOT_LESS_0] THEN 2856 DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[], 2857 DISCH_THEN(SUBST1_TAC o MATCH_MP DIVISION_0) THEN 2858 REWRITE_TAC[NOT_LESS_0]]]); 2859 2860(* ------------------------------------------------------------------------ *) 2861(* Lemmas about combining gauges *) 2862(* ------------------------------------------------------------------------ *) 2863 2864val GAUGE_MIN = store_thm("GAUGE_MIN", 2865 Term`!E g1 g2. gauge(E) g1 /\ gauge(E) g2 ==> 2866 gauge(E) (\x. if g1(x) < g2(x) then g1(x) else g2(x))`, 2867 REPEAT GEN_TAC THEN REWRITE_TAC[gauge] THEN STRIP_TAC THEN 2868 X_GEN_TAC (Term`x:real`) THEN BETA_TAC THEN DISCH_TAC THEN 2869 COND_CASES_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN 2870 FIRST_ASSUM ACCEPT_TAC);; 2871 2872val FINE_MIN = store_thm("FINE_MIN", 2873 Term`!g1 g2 D p. 2874 fine (\x. if g1(x) < g2(x) then g1(x) else g2(x)) (D,p) ==> 2875 fine(g1) (D,p) /\ fine(g2) (D,p)`, 2876 REPEAT GEN_TAC THEN REWRITE_TAC[fine] THEN 2877 BETA_TAC THEN DISCH_TAC THEN CONJ_TAC THEN 2878 X_GEN_TAC (Term`n:num`) THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN 2879 COND_CASES_TAC THEN REWRITE_TAC[] THEN DISCH_TAC THENL 2880 [RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN 2881 MATCH_MP_TAC REAL_LTE_TRANS, 2882 MATCH_MP_TAC REAL_LT_TRANS] THEN 2883 FIRST_ASSUM(fn th => EXISTS_TAC(rand(concl th)) THEN 2884 ASM_REWRITE_TAC[] THEN NO_TAC));; 2885 2886(* ------------------------------------------------------------------------ *) 2887(* The integral is unique if it exists *) 2888(* ------------------------------------------------------------------------ *) 2889 2890val DINT_UNIQ = store_thm("DINT_UNIQ", 2891 Term`!a b f k1 k2. 2892 a <= b /\ Dint(a,b) f k1 /\ Dint(a,b) f k2 ==> (k1 = k2)`, 2893 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN 2894 GEN_REWRITE_TAC RAND_CONV [] [GSYM REAL_SUB_0] THEN 2895 CONV_TAC CONTRAPOS_CONV THEN ONCE_REWRITE_TAC[ABS_NZ] THEN DISCH_TAC THEN 2896 REWRITE_TAC[Dint] THEN 2897 DISCH_THEN(CONJUNCTS_THEN(MP_TAC o SPEC (Term`abs(k1 - k2) / &2`))) THEN 2898 ASM_REWRITE_TAC[REAL_LT_HALF1] THEN 2899 DISCH_THEN(X_CHOOSE_THEN (Term`g1:real->real`) STRIP_ASSUME_TAC) THEN 2900 DISCH_THEN(X_CHOOSE_THEN (Term`g2:real->real`) STRIP_ASSUME_TAC) THEN 2901 MP_TAC(SPECL [Term`\x. a <= x /\ x <= b`, 2902 Term`g1:real->real`, Term`g2:real->real`] GAUGE_MIN) THEN 2903 ASM_REWRITE_TAC[] THEN DISCH_TAC THEN 2904 MP_TAC(SPECL [Term`a:real`, Term`b:real`, 2905 Term`\x:real. if g1(x) < g2(x) then g1(x) else g2(x)`] 2906 DIVISION_EXISTS) THEN ASM_REWRITE_TAC[] THEN 2907 DISCH_THEN(X_CHOOSE_THEN (Term`D:num->real`) 2908 (X_CHOOSE_THEN(Term`p:num->real`) STRIP_ASSUME_TAC)) THEN 2909 FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP FINE_MIN) THEN 2910 REPEAT(FIRST_ASSUM(UNDISCH_TAC o assert is_forall o concl) THEN 2911 DISCH_THEN(MP_TAC o SPECL [Term`D:num->real`, Term`p:num->real`]) THEN 2912 ASM_REWRITE_TAC[] THEN DISCH_TAC) THEN 2913 SUBGOAL_THEN (Term`abs((rsum(D,p) f - k2) - (rsum(D,p) f - k1)) 2914 < abs(k1 - k2)`) MP_TAC THENL 2915 [MATCH_MP_TAC REAL_LET_TRANS THEN 2916 EXISTS_TAC (Term`abs(rsum(D,p) f - k2) + abs(rsum(D,p) f - k1)`) THEN 2917 CONJ_TAC THENL 2918 [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [] [real_sub] THEN 2919 GEN_REWRITE_TAC (funpow 2 RAND_CONV) [] [GSYM ABS_NEG] THEN 2920 MATCH_ACCEPT_TAC ABS_TRIANGLE, 2921 GEN_REWRITE_TAC RAND_CONV [] [GSYM REAL_HALF_DOUBLE] THEN 2922 MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[]], 2923 REWRITE_TAC[real_sub, REAL_NEG_ADD, REAL_NEG_SUB] THEN 2924 ONCE_REWRITE_TAC[AC (REAL_ADD_ASSOC,REAL_ADD_SYM) 2925 (Term`(a + b) + (c + d) = (d + a) + (c + b)`)] THEN 2926 REWRITE_TAC[REAL_ADD_LINV, REAL_ADD_LID, REAL_LT_REFL]]); 2927 2928(* ------------------------------------------------------------------------ *) 2929(* Integral over a null interval is 0 *) 2930(* ------------------------------------------------------------------------ *) 2931 2932val INTEGRAL_NULL = store_thm("INTEGRAL_NULL", 2933 Term`!f a. Dint(a,a) f (&0)`, 2934 REPEAT GEN_TAC THEN REWRITE_TAC[Dint] THEN GEN_TAC THEN 2935 DISCH_TAC THEN EXISTS_TAC (Term`\x:real. &1`) THEN 2936 REWRITE_TAC[gauge, REAL_LT_01] THEN REPEAT GEN_TAC THEN 2937 REWRITE_TAC[tdiv] THEN STRIP_TAC THEN 2938 FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_EQ) THEN 2939 REWRITE_TAC[rsum] THEN DISCH_THEN SUBST1_TAC THEN 2940 ASM_REWRITE_TAC[sum, REAL_SUB_REFL, ABS_0]);; 2941 2942(* ------------------------------------------------------------------------ *) 2943(* Fundamental theorem of calculus (Part I) *) 2944(* ------------------------------------------------------------------------ *) 2945 2946val STRADDLE_LEMMA = prove( 2947 Term 2948 `!f f' a b e. (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) /\ &0 < e 2949 ==> ?g. gauge(\x. a <= x /\ x <= b) g /\ 2950 !x u v. a <= u /\ u <= x /\ 2951 x <= v /\ v <= b /\ (v - u) < g(x) 2952 ==> abs((f(v) - f(u)) - (f'(x) * (v - u))) 2953 <= e * (v - u)`, 2954 REPEAT STRIP_TAC THEN REWRITE_TAC[gauge] THEN BETA_TAC THEN 2955 SUBGOAL_THEN 2956 (Term`!x. a <= x /\ x <= b ==> 2957 ?d. &0 < d /\ 2958 !u v. u <= x /\ x <= v /\ (v - u) < d 2959 ==> 2960 abs((f(v) - f(u)) - (f'(x) * (v - u))) 2961 <= e * (v - u)`) MP_TAC THENL 2962 [ALL_TAC, 2963 FIRST_ASSUM(UNDISCH_TAC o assert is_forall o concl) THEN 2964 DISCH_THEN(K ALL_TAC) THEN 2965 DISCH_THEN(MP_TAC o CONV_RULE 2966 ((ONCE_DEPTH_CONV RIGHT_IMP_EXISTS_CONV) THENC SKOLEM_CONV)) THEN 2967 DISCH_THEN(X_CHOOSE_THEN (Term`g:real->real`) STRIP_ASSUME_TAC) THEN 2968 EXISTS_TAC (Term`g:real->real`) THEN CONJ_TAC THENL 2969 [GEN_TAC THEN 2970 DISCH_THEN(fn th => FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN 2971 DISCH_THEN(fn th => REWRITE_TAC[th]), 2972 REPEAT STRIP_TAC THEN 2973 C SUBGOAL_THEN (fn th => FIRST_ASSUM(MP_TAC o C MATCH_MP th)) 2974 (Term`a <= x /\ x <= b`) THENL 2975 [CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL 2976 [EXISTS_TAC (Term`u:real`), EXISTS_TAC (Term`v:real`)] THEN 2977 ASM_REWRITE_TAC[], 2978 DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[]]]] THEN 2979 X_GEN_TAC (Term`x:real`) THEN 2980 DISCH_THEN(fn th => STRIP_ASSUME_TAC th THEN 2981 FIRST_ASSUM(UNDISCH_TAC o assert is_forall o concl) THEN 2982 DISCH_THEN(MP_TAC o C MATCH_MP th)) THEN 2983 REWRITE_TAC[diffl, LIM] THEN 2984 DISCH_THEN(MP_TAC o SPEC (Term`e / &2`)) THEN 2985 ASM_REWRITE_TAC[REAL_LT_HALF1] THEN 2986 BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN 2987 DISCH_THEN(X_CHOOSE_THEN (Term`d:real`) STRIP_ASSUME_TAC) THEN 2988 SUBGOAL_THEN (Term`!z. abs(z - x) < d ==> 2989 abs((f(z) - f(x)) - (f'(x) * (z - x))) 2990 <= (e / &2) * abs(z - x)`) 2991 ASSUME_TAC THENL 2992 [GEN_TAC THEN ASM_CASES_TAC (Term`&0 < abs(z - x)`) THENL 2993 [ALL_TAC, 2994 UNDISCH_TAC (Term`~(&0 < abs(z - x))`) THEN 2995 REWRITE_TAC[GSYM ABS_NZ, REAL_SUB_0] THEN 2996 DISCH_THEN SUBST1_TAC THEN 2997 REWRITE_TAC[REAL_SUB_REFL, REAL_MUL_RZERO, ABS_0, REAL_LE_REFL]] THEN 2998 DISCH_THEN(MP_TAC o CONJ (ASSUME (Term`&0 < abs(z - x)`))) THEN 2999 DISCH_THEN(curry op THEN (MATCH_MP_TAC REAL_LT_IMP_LE) o MP_TAC) THEN 3000 DISCH_THEN(fn th => FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN 3001 FIRST_ASSUM(fn th => GEN_REWRITE_TAC LAND_CONV [] 3002 [GSYM(MATCH_MP REAL_LT_RMUL th)]) THEN 3003 MATCH_MP_TAC (TAUT_CONV (Term`(a = b) ==> a ==> b`)) THEN 3004 AP_THM_TAC THEN AP_TERM_TAC THEN 3005 REWRITE_TAC[GSYM ABS_MUL] THEN AP_TERM_TAC THEN 3006 REWRITE_TAC[REAL_SUB_RDISTRIB] THEN AP_THM_TAC THEN AP_TERM_TAC THEN 3007 REWRITE_TAC[REAL_SUB_ADD2] THEN MATCH_MP_TAC REAL_DIV_RMUL THEN 3008 ASM_REWRITE_TAC[ABS_NZ], ALL_TAC] THEN 3009 EXISTS_TAC (Term`d:real`) THEN ASM_REWRITE_TAC[] THEN 3010 REPEAT STRIP_TAC THEN 3011 SUBGOAL_THEN (Term`u <= v`) (DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) 3012 THENL 3013 [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC (Term`x:real`) THEN 3014 ASM_REWRITE_TAC[], 3015 ALL_TAC, 3016 ASM_REWRITE_TAC[REAL_SUB_REFL, REAL_MUL_RZERO, ABS_0, REAL_LE_REFL]] THEN 3017 MATCH_MP_TAC REAL_LE_TRANS THEN 3018 EXISTS_TAC (Term`abs((f(v) - f(x)) - (f'(x) * (v - x))) + 3019 abs((f(x) - f(u)) - (f'(x) * (x - u)))`) THEN 3020 CONJ_TAC THENL 3021 [MP_TAC(SPECL[Term`(f(v) - f(x)) - (f'(x) * (v - x))`, 3022 Term`(f(x) - f(u)) - (f'(x) * (x - u))`] ABS_TRIANGLE) 3023 THEN MATCH_MP_TAC(TAUT_CONV (Term`(a = b) ==> a ==> b`)) THEN 3024 AP_THM_TAC THEN REPEAT AP_TERM_TAC THEN 3025 ONCE_REWRITE_TAC[GSYM REAL_ADD2_SUB2] THEN 3026 REWRITE_TAC[REAL_SUB_LDISTRIB] THEN 3027 SUBGOAL_THEN (Term`!a b c. (a - b) + (b - c) = (a - c)`) 3028 (fn th => REWRITE_TAC[th]) THEN 3029 REPEAT GEN_TAC THEN REWRITE_TAC[real_sub] THEN 3030 ONCE_REWRITE_TAC[AC (REAL_ADD_ASSOC,REAL_ADD_SYM) 3031 (Term`(a + b) + (c + d) = (b + c) + (a + d)`)] THEN 3032 REWRITE_TAC[REAL_ADD_LINV, REAL_ADD_LID], ALL_TAC] THEN 3033 GEN_REWRITE_TAC RAND_CONV [] [GSYM REAL_HALF_DOUBLE] THEN 3034 MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL 3035 [MATCH_MP_TAC REAL_LE_TRANS THEN 3036 EXISTS_TAC (Term`(e / &2) * abs(v - x)`) THEN CONJ_TAC THENL 3037 [FIRST_ASSUM MATCH_MP_TAC THEN 3038 ASM_REWRITE_TAC[abs, REAL_SUB_LE] THEN 3039 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC (Term`v - u`) THEN 3040 ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_sub, REAL_LE_LADD] THEN 3041 ASM_REWRITE_TAC[REAL_LE_NEG], 3042 ASM_REWRITE_TAC[abs, REAL_SUB_LE] THEN REWRITE_TAC[real_div] THEN 3043 GEN_REWRITE_TAC LAND_CONV [] [AC (REAL_MUL_ASSOC,REAL_MUL_SYM) 3044 (Term`(a * b) * c = (a * c) * b`)] THEN 3045 REWRITE_TAC[GSYM REAL_MUL_ASSOC, 3046 MATCH_MP REAL_LE_LMUL (ASSUME (Term`&0 < e`))] THEN 3047 SUBGOAL_THEN (Term`!x y. (x * inv(&2)) <= (y * inv(&2)) = x <= y`) 3048 (fn th => ASM_REWRITE_TAC[th, real_sub, REAL_LE_LADD, REAL_LE_NEG]) THEN 3049 REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN 3050 MATCH_MP_TAC REAL_INV_POS THEN 3051 REWRITE_TAC[REAL_LT, TWO, LESS_0]], 3052 MATCH_MP_TAC REAL_LE_TRANS THEN 3053 EXISTS_TAC (Term`(e / &2) * abs(x - u)`) THEN CONJ_TAC THENL 3054 [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [] [real_sub] THEN 3055 ONCE_REWRITE_TAC[GSYM ABS_NEG] THEN 3056 REWRITE_TAC[REAL_NEG_ADD, REAL_NEG_SUB] THEN 3057 ONCE_REWRITE_TAC[REAL_NEG_RMUL] THEN 3058 REWRITE_TAC[REAL_NEG_SUB] THEN REWRITE_TAC[GSYM real_sub] THEN 3059 FIRST_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[ABS_SUB] THEN 3060 ASM_REWRITE_TAC[abs, REAL_SUB_LE] THEN 3061 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC (Term`v - u`) THEN 3062 ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[real_sub, REAL_LE_RADD], 3063 ASM_REWRITE_TAC[abs, REAL_SUB_LE] THEN REWRITE_TAC[real_div] THEN 3064 GEN_REWRITE_TAC LAND_CONV [] [AC (REAL_MUL_ASSOC,REAL_MUL_SYM) 3065 (Term `(a * b) * c = (a * c) * b`)] THEN 3066 REWRITE_TAC[GSYM REAL_MUL_ASSOC, 3067 MATCH_MP REAL_LE_LMUL (ASSUME (Term`&0 < e`))] THEN 3068 SUBGOAL_THEN (Term`!x y. (x * inv(&2)) <= (y * inv(&2)) = x <= y`) 3069 (fn th => ASM_REWRITE_TAC[th, real_sub, REAL_LE_RADD, REAL_LE_NEG]) THEN 3070 REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN 3071 MATCH_MP_TAC REAL_INV_POS THEN 3072 REWRITE_TAC[REAL_LT, TWO, LESS_0]]]); 3073 3074val FTC1 = store_thm("FTC1", 3075 Term `!f f' a b. 3076 a <= b /\ (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) 3077 ==> Dint(a,b) f' (f(b) - f(a))`, 3078 REPEAT STRIP_TAC THEN 3079 UNDISCH_TAC (Term`a <= b`) THEN REWRITE_TAC[REAL_LE_LT] THEN 3080 DISCH_THEN DISJ_CASES_TAC THENL 3081 [ALL_TAC, ASM_REWRITE_TAC[REAL_SUB_REFL, INTEGRAL_NULL]] THEN 3082 REWRITE_TAC[Dint] THEN X_GEN_TAC (Term`e:real`) THEN DISCH_TAC THEN 3083 SUBGOAL_THEN 3084 (Term`!e. &0 < e ==> 3085 ?g. gauge(\x. a <= x /\ x <= b) g /\ 3086 (!D p. tdiv(a,b)(D,p) /\ fine g(D,p) 3087 ==> 3088 (abs((rsum(D,p)f') - (f b - f a))) <= e)`) 3089 MP_TAC THENL 3090 [ALL_TAC, 3091 DISCH_THEN(MP_TAC o SPEC (Term`e / &2`)) THEN 3092 ASM_REWRITE_TAC[REAL_LT_HALF1] THEN 3093 DISCH_THEN(X_CHOOSE_THEN (Term`g:real->real`) STRIP_ASSUME_TAC) THEN 3094 EXISTS_TAC (Term`g:real->real`) THEN ASM_REWRITE_TAC[] THEN 3095 REPEAT GEN_TAC THEN 3096 DISCH_THEN(fn th => FIRST_ASSUM(ASSUME_TAC o C MATCH_MP th)) THEN 3097 MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC (Term`e / &2`) THEN 3098 ASM_REWRITE_TAC[REAL_LT_HALF2]] THEN 3099 UNDISCH_TAC (Term`&0 < e`) THEN DISCH_THEN(K ALL_TAC) THEN 3100 X_GEN_TAC (Term`e:real`) THEN DISCH_TAC THEN 3101 MP_TAC(SPECL [Term`f:real->real`, Term`f':real->real`, 3102 Term`a:real`, Term`b:real`, Term`e / (b - a)`] STRADDLE_LEMMA) THEN 3103 ASM_REWRITE_TAC[] THEN 3104 SUBGOAL_THEN (Term`&0 < e / (b - a)`) (fn th => REWRITE_TAC[th]) THENL 3105 [REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LT_MUL THEN 3106 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INV_POS THEN 3107 ASM_REWRITE_TAC[REAL_SUB_LT], ALL_TAC] THEN 3108 DISCH_THEN(X_CHOOSE_THEN (Term`g:real->real`) STRIP_ASSUME_TAC) THEN 3109 EXISTS_TAC (Term`g:real->real`) THEN ASM_REWRITE_TAC[] THEN 3110 MAP_EVERY X_GEN_TAC [Term`D:num->real`, Term`p:num->real`] THEN 3111 REWRITE_TAC[tdiv] THEN STRIP_TAC THEN REWRITE_TAC[rsum] THEN 3112 SUBGOAL_THEN (Term`f b - f a = sum(0,dsize D)(\n. f(D(SUC n)) - f(D(n)))`) 3113 SUBST1_TAC THENL 3114 [MP_TAC(SPECL [Term`\n:num. (f:real->real)(D(n))`, Term`0:num`, Term`dsize D`] 3115 SUM_CANCEL) THEN BETA_TAC THEN DISCH_THEN SUBST1_TAC THEN 3116 ASM_REWRITE_TAC[ADD_CLAUSES] THEN 3117 MAP_EVERY (IMP_RES_THEN SUBST1_TAC) [DIVISION_LHS, DIVISION_RHS] THEN 3118 REFL_TAC, ALL_TAC] THEN 3119 ONCE_REWRITE_TAC[ABS_SUB] THEN REWRITE_TAC[GSYM SUM_SUB] THEN BETA_TAC THEN 3120 LE_MATCH_TAC ABS_SUM THEN BETA_TAC THEN 3121 SUBGOAL_THEN (Term`e = sum(0,dsize D) 3122 (\n. (e / (b - a)) * (D(SUC n) - D n))`) 3123 SUBST1_TAC THENL 3124 [ONCE_REWRITE_TAC[SYM(BETA_CONV (Term`(\n. (D(SUC n) - D n)) n`))] THEN 3125 ASM_REWRITE_TAC[SUM_CMUL, SUM_CANCEL, ADD_CLAUSES] THEN 3126 MAP_EVERY (IMP_RES_THEN SUBST1_TAC) [DIVISION_LHS, DIVISION_RHS] THEN 3127 CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN 3128 REWRITE_TAC[REAL_SUB_0] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN 3129 MATCH_MP_TAC REAL_LT_IMP_NE THEN FIRST_ASSUM ACCEPT_TAC, ALL_TAC] THEN 3130 MATCH_MP_TAC SUM_LE THEN X_GEN_TAC (Term`r:num`) THEN 3131 REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN BETA_TAC THEN 3132 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL 3133 [IMP_RES_THEN (fn th => REWRITE_TAC[th]) DIVISION_LBOUND, 3134 IMP_RES_THEN (fn th => REWRITE_TAC[th]) DIVISION_UBOUND, 3135 UNDISCH_TAC (Term`fine(g)(D,p)`) THEN REWRITE_TAC[fine] THEN 3136 DISCH_THEN MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]); 3137 3138(* ======================================================================== *) 3139(* MacLaurin's theorem. *) 3140(* ======================================================================== *) 3141 3142(* ------------------------------------------------------------------------ *) 3143(* SYM_CANON_CONV - Canonicalizes single application of symmetric operator *) 3144(* Rewrites `so as to make fn true`, e.g. fn = (<<) or fn = curry(=) `1` o fst*) 3145(* ------------------------------------------------------------------------ *) 3146 3147fun SYM_CANON_CONV sym f = 3148 REWR_CONV sym o assert 3149 (not o f o ((snd o dest_comb) ## I) o dest_comb);; 3150 3151(* ----------------------------------------------------------- *) 3152(* EXT_CONV `!x. f x = g x` = |- (!x. f x = g x) = (f = g) *) 3153(* ----------------------------------------------------------- *) 3154 3155val EXT_CONV = SYM o uncurry X_FUN_EQ_CONV o 3156 (I ## (mk_eq o (rator ## rator) o dest_eq)) o dest_forall;; 3157 3158(* ======================================================================== *) 3159(* Mclaurin's theorem with Lagrange form of remainder *) 3160(* We could weaken the hypotheses slightly, but it's not worth it *) 3161(* ======================================================================== *) 3162 3163val _ = Parse.hide "B"; 3164 3165val MCLAURIN = store_thm("MCLAURIN", 3166 Term 3167 `!f diff h n. 3168 &0 < h /\ 0 < n /\ (diff(0) = f) /\ 3169 (!m t. m < n /\ &0 <= t /\ t <= h ==> 3170 (diff(m) diffl diff(SUC m)(t))(t)) ==> 3171 (?t. &0 < t /\ t < h /\ 3172 (f(h) = sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (h pow m)) 3173 + 3174 ((diff(n)(t) / &(FACT n)) * (h pow n))))`, 3175 REPEAT GEN_TAC THEN STRIP_TAC THEN 3176 UNDISCH_TAC (Term`0 < n:num`) THEN 3177 DISJ_CASES_THEN2 SUBST_ALL_TAC (X_CHOOSE_THEN (Term`r:num`) MP_TAC) 3178 (SPEC (Term`n:num`) num_CASES) THEN REWRITE_TAC[LESS_REFL] THEN 3179 DISCH_THEN(ASSUME_TAC o SYM) THEN DISCH_THEN(K ALL_TAC) THEN 3180 SUBGOAL_THEN 3181 (Term`?B. f(h) = sum(0,n) 3182 (\m. (diff(m)(&0) / &(FACT m)) * (h pow m)) 3183 + (B * ((h pow n) / &(FACT n)))`) MP_TAC THENL 3184 [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN 3185 ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_RADD] THEN 3186 EXISTS_TAC (Term 3187 `(f h - sum(0,n) (\m. (diff(m)(&0) / &(FACT m)) * (h pow m))) 3188 * &(FACT n) / (h pow n)`) THEN REWRITE_TAC[real_div] THEN 3189 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN 3190 GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [] [GSYM REAL_MUL_RID] THEN 3191 AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN 3192 ONCE_REWRITE_TAC[AC (REAL_MUL_ASSOC,REAL_MUL_SYM) 3193 (Term`a * (b * (c * d)) = (d * a) * (b * c)`)] THEN 3194 GEN_REWRITE_TAC RAND_CONV [] [GSYM REAL_MUL_LID] THEN BINOP_TAC THEN 3195 MATCH_MP_TAC REAL_MUL_LINV THENL 3196 [MATCH_MP_TAC REAL_POS_NZ THEN REWRITE_TAC[REAL_LT, FACT_LESS], 3197 MATCH_MP_TAC POW_NZ THEN MATCH_MP_TAC REAL_POS_NZ THEN 3198 ASM_REWRITE_TAC[]], ALL_TAC] THEN 3199 DISCH_THEN(X_CHOOSE_THEN (Term`B:real`) (ASSUME_TAC o SYM)) THEN 3200 ABBREV_TAC (Term`g = 3201 \t. f(t) - (sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (t pow m)) 3202 + (B * ((t pow n) / &(FACT n))))`) THEN 3203 SUBGOAL_THEN (Term`(g(&0) = &0) /\ (g(h) = &0)`) ASSUME_TAC THENL 3204 [EXPAND_TAC "g" THEN BETA_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL] THEN 3205 EXPAND_TAC "n" THEN REWRITE_TAC[POW_0, REAL_DIV_LZERO] THEN 3206 REWRITE_TAC[REAL_MUL_RZERO, REAL_ADD_RID] THEN REWRITE_TAC[REAL_SUB_0] THEN 3207 MP_TAC(GEN (Term`j:num->real`) 3208 (SPECL [Term`j:num->real`, Term`r:num`, Term`1:num`] SUM_OFFSET)) THEN 3209 REWRITE_TAC[ADD1, REAL_EQ_SUB_LADD] THEN 3210 DISCH_THEN(fn th => REWRITE_TAC[GSYM th]) THEN BETA_TAC THEN 3211 REWRITE_TAC[SUM_1] THEN BETA_TAC THEN REWRITE_TAC[pow, FACT] THEN 3212 ASM_REWRITE_TAC[real_div, REAL_INV1, REAL_MUL_RID] THEN 3213 CONV_TAC SYM_CONV THEN REWRITE_TAC[REAL_ADD_LID_UNIQ] THEN 3214 REWRITE_TAC[GSYM ADD1, POW_0, REAL_MUL_RZERO, SUM_0], ALL_TAC] THEN 3215 ABBREV_TAC (Term`difg = 3216 \m t. diff(m) t - (sum(0,n-m)(\p. (diff(m+p)(&0) / &(FACT p)) * (t pow p)) 3217 + (B * ((t pow (n - m)) / &(FACT(n - m)))))`) THEN 3218 SUBGOAL_THEN (Term`difg(0:num):real->real = g`) ASSUME_TAC THENL 3219 [EXPAND_TAC "difg" THEN BETA_TAC THEN EXPAND_TAC "g" THEN 3220 CONV_TAC FUN_EQ_CONV THEN GEN_TAC THEN BETA_TAC THEN 3221 ASM_REWRITE_TAC[ADD_CLAUSES, SUB_0], ALL_TAC] THEN 3222 SUBGOAL_THEN (Term 3223 `(!m t. m < n /\ (& 0) <= t /\ t <= h 3224 ==> (difg(m) diffl difg(SUC m)(t))(t))`) ASSUME_TAC THENL 3225 [REPEAT GEN_TAC THEN DISCH_TAC THEN EXPAND_TAC "difg" THEN BETA_TAC THEN 3226 CONV_TAC((funpow 2 RATOR_CONV o RAND_CONV) HABS_CONV) THEN 3227 MATCH_MP_TAC DIFF_SUB THEN CONJ_TAC THENL 3228 [CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN 3229 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[], ALL_TAC] THEN 3230 CONV_TAC((funpow 2 RATOR_CONV o RAND_CONV) HABS_CONV) THEN 3231 MATCH_MP_TAC DIFF_ADD THEN CONJ_TAC THENL 3232 [ALL_TAC, 3233 W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN 3234 REWRITE_TAC[REAL_MUL_LZERO, REAL_MUL_RID, REAL_ADD_LID] THEN 3235 REWRITE_TAC[REAL_FACT_NZ, REAL_SUB_RZERO] THEN 3236 DISCH_THEN(MP_TAC o SPEC (Term`t:real`)) THEN 3237 MATCH_MP_TAC(TAUT_CONV (Term`(a = b) ==> a ==> b`)) THEN 3238 AP_THM_TAC THEN CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV (Term`t:real`))) THEN 3239 AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [] [REAL_MUL_SYM] THEN 3240 AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[real_div] THEN 3241 REWRITE_TAC[GSYM REAL_MUL_ASSOC, POW_2] THEN 3242 ONCE_REWRITE_TAC[AC (REAL_MUL_ASSOC,REAL_MUL_SYM) 3243 (Term`a * (b * (c * d)) = b * (a * (d * c))`)] THEN 3244 FIRST_ASSUM(X_CHOOSE_THEN (Term`d:num`) SUBST1_TAC o 3245 MATCH_MP LESS_ADD_1 o CONJUNCT1) THEN 3246 ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN 3247 REWRITE_TAC[GSYM ADD_ASSOC] THEN 3248 REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] (GSYM ADD1)] THEN 3249 REWRITE_TAC[ADD_SUB] THEN AP_TERM_TAC THEN 3250 (IMP_SUBST_TAC REAL_INV_MUL:tactic) THEN REWRITE_TAC[REAL_FACT_NZ] THEN 3251 REWRITE_TAC[GSYM ADD1, FACT, GSYM REAL_MUL] THEN 3252 REPEAT(IMP_SUBST_TAC REAL_INV_MUL THEN 3253 REWRITE_TAC[REAL_FACT_NZ] THEN 3254 REWRITE_TAC [REAL_INJ, NOT_SUC]) THEN 3255 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN 3256 ONCE_REWRITE_TAC[AC (REAL_MUL_ASSOC,REAL_MUL_SYM) 3257 (Term `a * (b * (c * (d * (e * (f * g))))) = 3258 (b * a) * ((d * f) * ((c * g) * e))`)] THEN 3259 REPEAT(IMP_SUBST_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_FACT_NZ] THEN 3260 REWRITE_TAC[REAL_INJ, NOT_SUC]) THEN 3261 REWRITE_TAC[REAL_MUL_LID]] THEN 3262 FIRST_ASSUM(X_CHOOSE_THEN (Term`d:num`) SUBST1_TAC o 3263 MATCH_MP LESS_ADD_1 o CONJUNCT1) THEN 3264 ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN 3265 REWRITE_TAC[GSYM ADD_ASSOC] THEN 3266 REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] (GSYM ADD1)] THEN 3267 REWRITE_TAC[ADD_SUB] THEN 3268 REWRITE_TAC[GSYM(REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_OFFSET)] THEN 3269 BETA_TAC THEN REWRITE_TAC[SUM_1] THEN BETA_TAC THEN 3270 CONV_TAC (funpow 2 RATOR_CONV (RAND_CONV HABS_CONV)) THEN 3271 GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [] [GSYM REAL_ADD_RID] THEN 3272 MATCH_MP_TAC DIFF_ADD THEN REWRITE_TAC[pow, DIFF_CONST] THEN 3273 (MP_TAC o C SPECL DIFF_SUM) 3274 [Term`\p x. (diff((p + 1) + m)(&0) / &(FACT(p + 1))) 3275 * (x pow (p + 1))`, 3276 Term`\p x. (diff(p + (SUC m))(&0) / &(FACT p)) * (x pow p)`, 3277 Term`0:num`, Term`d:num`, Term`t:real`] THEN BETA_TAC THEN 3278 DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN 3279 X_GEN_TAC (Term`k:num`) THEN STRIP_TAC THEN 3280 W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN 3281 DISCH_THEN(MP_TAC o SPEC (Term`t:real`)) THEN 3282 MATCH_MP_TAC(TAUT_CONV (Term`(a = b) ==> a ==> b`)) THEN 3283 CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV (Term`z:real`))) THEN 3284 AP_THM_TAC THEN AP_TERM_TAC THEN 3285 REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_LID, REAL_MUL_RID] THEN 3286 REWRITE_TAC[GSYM ADD1, ADD_CLAUSES, real_div, GSYM REAL_MUL_ASSOC] THEN 3287 REWRITE_TAC[SUC_SUB1] THEN 3288 ONCE_REWRITE_TAC[AC (REAL_MUL_ASSOC,REAL_MUL_SYM) 3289 (Term`a * (b * (c * d)) = c * ((a * d) * b)`)] THEN 3290 AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN 3291 AP_TERM_TAC THEN 3292 SUBGOAL_THEN (Term`&(SUC k) = inv(inv(&(SUC k)))`) SUBST1_TAC THENL 3293 [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INVINV THEN 3294 REWRITE_TAC[REAL_INJ, NOT_SUC], ALL_TAC] THEN 3295 (IMP_SUBST_TAC(GSYM REAL_INV_MUL):tactic) THENL 3296 [CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[REAL_FACT_NZ] THEN 3297 MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC REAL_INV_POS THEN 3298 REWRITE_TAC[REAL_LT, LESS_0], ALL_TAC] THEN 3299 AP_TERM_TAC THEN REWRITE_TAC[FACT, GSYM REAL_MUL, REAL_MUL_ASSOC] THEN 3300 (IMP_SUBST_TAC REAL_MUL_LINV:tactic) THEN REWRITE_TAC[REAL_MUL_LID] THEN 3301 REWRITE_TAC[REAL_INJ, NOT_SUC], ALL_TAC] THEN 3302 SUBGOAL_THEN (Term`!m. m < n ==> 3303 ?t. &0 < t /\ t < h /\ (difg(SUC m)(t) = &0)`) MP_TAC THENL 3304 [ALL_TAC, 3305 DISCH_THEN(MP_TAC o SPEC (Term`r:num`)) THEN EXPAND_TAC "n" THEN 3306 REWRITE_TAC[LESS_SUC_REFL] THEN 3307 DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC) THEN 3308 EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN 3309 UNDISCH_TAC (Term`difg(SUC r)(t:real) = &0`) THEN EXPAND_TAC "difg" THEN 3310 ASM_REWRITE_TAC[SUB_EQUAL_0, sum, pow, FACT] THEN 3311 REWRITE_TAC[REAL_SUB_0, REAL_ADD_LID, real_div] THEN 3312 REWRITE_TAC[REAL_INV1, REAL_MUL_RID] THEN DISCH_THEN SUBST1_TAC THEN 3313 GEN_REWRITE_TAC (funpow 2 RAND_CONV) [] 3314 [AC (REAL_MUL_ASSOC,REAL_MUL_SYM) 3315 (Term`(a * b) * c = a * (c * b)`)] THEN 3316 ASM_REWRITE_TAC[GSYM real_div]] THEN 3317 SUBGOAL_THEN (Term`!m:num. m<n ==> (difg(m)(&0) = &0)`) ASSUME_TAC THENL 3318 [X_GEN_TAC (Term`m:num`) THEN EXPAND_TAC "difg" THEN 3319 DISCH_THEN(X_CHOOSE_THEN (Term`d:num`) SUBST1_TAC o MATCH_MP LESS_ADD_1) 3320 THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN 3321 MP_TAC(GEN (Term`j:num->real`) 3322 (SPECL [Term`j:num->real`, Term`d:num`, Term`1:num`] SUM_OFFSET)) THEN 3323 REWRITE_TAC[ADD1, REAL_EQ_SUB_LADD] THEN 3324 DISCH_THEN(fn th => REWRITE_TAC[GSYM th]) THEN BETA_TAC THEN 3325 REWRITE_TAC[SUM_1] THEN BETA_TAC THEN 3326 REWRITE_TAC[FACT, pow, REAL_INV1, ADD_CLAUSES, real_div, REAL_MUL_RID] THEN 3327 REWRITE_TAC[GSYM ADD1, POW_0, REAL_MUL_RZERO, SUM_0, REAL_ADD_LID] THEN 3328 REWRITE_TAC[REAL_MUL_LZERO, REAL_MUL_RZERO,REAL_ADD_RID] THEN 3329 REWRITE_TAC[REAL_SUB_REFL], ALL_TAC] THEN 3330 SUBGOAL_THEN (Term`!m:num. m < n ==> ?t. &0 < t /\ t < h /\ 3331 (difg(m) diffl &0)(t)`) MP_TAC THENL 3332 [ALL_TAC, 3333 DISCH_THEN(fn th => GEN_TAC THEN 3334 DISCH_THEN(fn t => ASSUME_TAC t THEN MP_TAC(MATCH_MP th t))) THEN 3335 DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC) THEN 3336 EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN 3337 MATCH_MP_TAC DIFF_UNIQ THEN EXISTS_TAC (Term`difg(m:num):real->real`) THEN 3338 EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN 3339 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN 3340 CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN 3341 FIRST_ASSUM ACCEPT_TAC] THEN 3342 INDUCT_TAC THENL 3343 [DISCH_TAC THEN MATCH_MP_TAC ROLLE THEN ASM_REWRITE_TAC[] THEN 3344 SUBGOAL_THEN (Term`!t. &0 <= t /\ t <= h ==> g differentiable t`) 3345 MP_TAC THENL 3346 [GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[differentiable] THEN 3347 EXISTS_TAC (Term`difg(SUC 0)(t:real):real`) THEN 3348 SUBST1_TAC(SYM(ASSUME (Term`difg(0:num):real->real = g`))) THEN 3349 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[], ALL_TAC] THEN 3350 DISCH_TAC THEN CONJ_TAC THENL 3351 [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC DIFF_CONT THEN 3352 REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN 3353 ASM_REWRITE_TAC[], 3354 GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN 3355 CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]], 3356 DISCH_TAC THEN SUBGOAL_THEN (Term`m < n:num`) 3357 (fn th => FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THENL 3358 [MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC (Term`SUC m`) THEN 3359 ASM_REWRITE_TAC[LESS_SUC_REFL], ALL_TAC] THEN 3360 DISCH_THEN(X_CHOOSE_THEN (Term`t0:real`) STRIP_ASSUME_TAC) THEN 3361 SUBGOAL_THEN (Term`?t. (& 0) < t /\ t < t0 /\ 3362 ((difg(SUC m)) diffl (& 0))t`) MP_TAC THENL 3363 [MATCH_MP_TAC ROLLE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL 3364 [SUBGOAL_THEN (Term`difg(SUC m)(&0) = &0`) SUBST1_TAC THENL 3365 [FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC, 3366 MATCH_MP_TAC DIFF_UNIQ THEN EXISTS_TAC (Term`difg(m:num):real->real`) 3367 THEN EXISTS_TAC (Term`t0:real`) THEN ASM_REWRITE_TAC[] THEN 3368 FIRST_ASSUM MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL 3369 [MATCH_MP_TAC LESS_TRANS THEN EXISTS_TAC (Term`SUC m`) THEN 3370 ASM_REWRITE_TAC[LESS_SUC_REFL], 3371 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[], 3372 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]], ALL_TAC] THEN 3373 SUBGOAL_THEN (Term`!t. &0 <= t /\ t <= t0 ==> 3374 difg(SUC m) differentiable t`) ASSUME_TAC THENL 3375 [GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[differentiable] THEN 3376 EXISTS_TAC (Term`difg(SUC(SUC m))(t:real):real`) THEN 3377 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN 3378 MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC (Term`t0:real`) THEN 3379 ASM_REWRITE_TAC[] THEN 3380 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[], ALL_TAC] THEN 3381 CONJ_TAC THENL 3382 [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC DIFF_CONT THEN 3383 REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN 3384 ASM_REWRITE_TAC[], 3385 GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN 3386 CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]], 3387 DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC) THEN 3388 EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN 3389 MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC (Term`t0:real`) THEN 3390 ASM_REWRITE_TAC[]]]); 3391 3392Theorem MCLAURIN_NEG: 3393 !f diff h n. 3394 h < &0 /\ 0<n /\ (diff(0) = f) /\ 3395 (!m t. m < n /\ h <= t /\ t <= &0 ==> 3396 (diff(m) diffl diff(SUC m)(t))(t)) ==> 3397 (?t. h < t /\ t < &0 /\ 3398 (f(h) = sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (h pow m)) 3399 + ((diff(n)(t) / &(FACT n)) * (h pow n)))) 3400Proof 3401 REPEAT GEN_TAC THEN STRIP_TAC THEN 3402 MP_TAC(Q.SPECL[���\x. (f(~x):real)���, 3403 ���\n x. ((~(&1)) pow n) * (diff:num->real->real)(n)(~x)���, 3404 ���~h���, ���n:num���] MCLAURIN) THEN 3405 BETA_TAC THEN ASM_REWRITE_TAC[REAL_NEG_GT0, pow, REAL_MUL_LID] THEN 3406 ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN 3407 REWRITE_TAC[REAL_NEGNEG, REAL_NEG_0] THEN 3408 ONCE_REWRITE_TAC[TAUT_CONV (Term`a /\ b /\ c = a /\ c /\ b`)] THEN 3409 W(C SUBGOAL_THEN (fn t => REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) 3410 THENL 3411 [REPEAT GEN_TAC THEN 3412 DISCH_THEN(fn th => FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN 3413 DISCH_THEN(MP_TAC o 3414 C CONJ (SPEC ���t:real��� (DIFF_CONV ���\x. -x���))) THEN 3415 CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN 3416 DISCH_THEN(MP_TAC o MATCH_MP DIFF_CHAIN) THEN 3417 DISCH_THEN(MP_TAC o GEN_ALL o MATCH_MP DIFF_CMUL) THEN 3418 DISCH_THEN(MP_TAC o SPEC (Term`(~(&1)) pow m`)) THEN BETA_TAC THEN 3419 MATCH_MP_TAC(TAUT_CONV (Term`(a = b) ==> a ==> b`)) THEN 3420 CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV (Term`z:real`))) THEN 3421 AP_THM_TAC THEN AP_TERM_TAC THEN 3422 CONV_TAC(AC_CONV (REAL_MUL_ASSOC,REAL_MUL_SYM)), 3423 DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC)] THEN 3424 Q.EXISTS_TAC ���-t��� THEN ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN 3425 ASM_REWRITE_TAC[REAL_NEGNEG, REAL_NEG_0] THEN 3426 BINOP_TAC THENL 3427 [MATCH_MP_TAC SUM_EQ THEN 3428 X_GEN_TAC (Term`m:num`) THEN REWRITE_TAC[ADD_CLAUSES] THEN 3429 DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN BETA_TAC, ALL_TAC] THEN 3430 REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN 3431 ONCE_REWRITE_TAC[AC (REAL_MUL_ASSOC,REAL_MUL_SYM) 3432 (Term`a * (b * (c * d)) = (b * c) * (a * d)`)] THEN 3433 REWRITE_TAC[GSYM POW_MUL, GSYM REAL_NEG_MINUS1, REAL_NEGNEG] THEN 3434 REWRITE_TAC[REAL_MUL_ASSOC] 3435QED 3436 3437(* ------------------------------------------------------------------------- *) 3438(* Simple strong form if a function is differentiable everywhere. *) 3439(* ------------------------------------------------------------------------- *) 3440 3441val MCLAURIN_ALL_LT = store_thm("MCLAURIN_ALL_LT", 3442 Term`!f diff. 3443 (diff 0 = f) /\ 3444 (!m x. ((diff m) diffl (diff(SUC m) x)) x) 3445 ==> !x n. ~(x = &0) /\ 0 < n 3446 ==> ?t. &0 < abs(t) /\ abs(t) < abs(x) /\ 3447 (f(x) = sum(0,n) 3448 (\m. (diff m (&0) / &(FACT m)) * x pow m) 3449 + 3450 (diff n t / &(FACT n)) * x pow n)`, 3451 REPEAT STRIP_TAC THEN 3452 REPEAT_TCL DISJ_CASES_THEN MP_TAC 3453 (SPECL [Term`x:real`, Term`&0`] REAL_LT_TOTAL) THEN 3454 ASM_REWRITE_TAC[] THEN DISCH_TAC THENL 3455 [MP_TAC(SPECL [Term`f:real->real`, Term`diff:num->real->real`, 3456 Term`x:real`, Term`n:num`] MCLAURIN_NEG) THEN 3457 ASM_REWRITE_TAC[] THEN 3458 DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC) THEN 3459 EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN 3460 UNDISCH_TAC (Term`t < &0`) THEN UNDISCH_TAC (Term`x < t`) 3461 THEN REAL_ARITH_TAC, 3462 MP_TAC(SPECL [Term`f:real->real`, Term`diff:num->real->real`, 3463 Term`x:real`, Term`n:num`] MCLAURIN) THEN 3464 ASM_REWRITE_TAC[] THEN 3465 DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC) THEN 3466 EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN 3467 UNDISCH_TAC (Term`&0 < t`) THEN UNDISCH_TAC (Term`t < x`) 3468 THEN REAL_ARITH_TAC]); 3469 3470val MCLAURIN_ZERO = store_thm("MCLAURIN_ZERO", 3471 Term`!diff n x. (x = &0) /\ 0 < n 3472 ==> 3473 (sum(0,n) (\m. (diff m (&0) / &(FACT m)) * x pow m) 3474 = 3475 diff 0 (&0))`, 3476 REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC MP_TAC) THEN 3477 SPEC_TAC(Term`n:num`,Term`n:num`) THEN INDUCT_TAC THEN 3478 REWRITE_TAC[LESS_REFL] THEN REWRITE_TAC[LESS_THM] THEN 3479 DISCH_THEN(DISJ_CASES_THEN2 (SUBST1_TAC o SYM) MP_TAC) THENL 3480 [REWRITE_TAC[sum, ADD_CLAUSES] THEN BETA_TAC THEN 3481 REWRITE_TAC[FACT, pow, real_div] THEN MP_TAC(SPEC(Term`&1`) REAL_DIV_REFL) 3482 THEN DISCH_THEN (MP_TAC o REWRITE_RULE 3483 [REAL_OF_NUM_EQ,ONE,NOT_SUC]) 3484 THEN REWRITE_TAC [GSYM REAL_INV_1OVER, GSYM (ONE)] 3485 THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_ADD_LID, REAL_MUL_RID], 3486 REWRITE_TAC[sum] THEN 3487 DISCH_THEN(fn th => ASSUME_TAC th THEN ANTE_RES_THEN SUBST1_TAC th) THEN 3488 UNDISCH_TAC (Term`0 < n:num`) THEN SPEC_TAC(Term`n:num`,Term`n:num`) THEN 3489 INDUCT_TAC THEN BETA_TAC THEN REWRITE_TAC[LESS_REFL] THEN 3490 REWRITE_TAC[ADD_CLAUSES, pow, REAL_MUL_LZERO, REAL_MUL_RZERO] THEN 3491 REWRITE_TAC[REAL_ADD_RID]]); 3492 3493 3494 3495val LET_CASES = prove(Term`!m n:num. m <= n \/ n < m`, 3496ONCE_REWRITE_TAC [DISJ_SYM] THEN MATCH_ACCEPT_TAC LESS_CASES); 3497 3498val REAL_POW_EQ_0 = prove 3499 (Term`!x n. (x pow n = &0) = (x = &0) /\ ~(n = 0)`, 3500 GEN_TAC THEN INDUCT_TAC THEN 3501 ASM_REWRITE_TAC[NOT_SUC, pow, REAL_ENTIRE] THENL 3502 [REWRITE_TAC [REAL_OF_NUM_EQ, ONE,NOT_SUC], 3503 EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]); 3504 3505val MCLAURIN_ALL_LE = store_thm("MCLAURIN_ALL_LE", 3506 Term`!f diff. 3507 (diff 0 = f) /\ 3508 (!m x. ((diff m) diffl (diff(SUC m) x)) x) 3509 ==> !x n. ?t. abs t <= abs x /\ 3510 (f(x) = sum(0,n) 3511 (\m. (diff m (&0) / &(FACT m)) * x pow m) 3512 + 3513 (diff n t / &(FACT n)) * x pow n)`, 3514 REPEAT STRIP_TAC THEN 3515 DISJ_CASES_THEN MP_TAC(SPECL [Term`n:num`, Term`0:num`] LET_CASES) THENL 3516 [REWRITE_TAC[LE] THEN DISCH_THEN SUBST1_TAC THEN 3517 ASM_REWRITE_TAC[sum, REAL_ADD_LID, FACT] THEN EXISTS_TAC (Term`x:real`) 3518 THEN REWRITE_TAC[REAL_LE_REFL, pow, REAL_MUL_RID, REAL_OVER1], 3519 DISCH_TAC THEN ASM_CASES_TAC (Term`x = &0`) THENL 3520 [MP_TAC(SPEC_ALL MCLAURIN_ZERO) THEN ASM_REWRITE_TAC[] THEN 3521 DISCH_THEN SUBST1_TAC THEN EXISTS_TAC (Term`&0`) THEN 3522 REWRITE_TAC[REAL_LE_REFL] THEN 3523 SUBGOAL_THEN (Term`&0 pow n = &0`) SUBST1_TAC THENL 3524 [ASM_REWRITE_TAC[REAL_POW_EQ_0, GSYM (CONJUNCT1 LE), NOT_LESS_EQUAL], 3525 REWRITE_TAC[REAL_ADD_RID, REAL_MUL_RZERO]], 3526 MP_TAC(SPEC_ALL MCLAURIN_ALL_LT) THEN ASM_REWRITE_TAC[] THEN 3527 DISCH_THEN(MP_TAC o SPEC_ALL) THEN ASM_REWRITE_TAC[] THEN 3528 DISCH_THEN(X_CHOOSE_THEN (Term`t:real`) STRIP_ASSUME_TAC) THEN 3529 EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC[] THEN 3530 MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]]); 3531 3532 3533(* ------------------------------------------------------------------------- *) 3534(* Version for exp. *) 3535(* ------------------------------------------------------------------------- *) 3536 3537val MCLAURIN_EXP_LEMMA = prove 3538 (Term`((\n:num. exp) 0 = exp) /\ 3539 (!m x. (((\n:num. exp) m) diffl ((\n:num. exp) (SUC m) x)) x)`, 3540 REWRITE_TAC[DIFF_EXP]); 3541 3542val MCLAURIN_EXP_LT = store_thm("MCLAURIN_EXP_LT", 3543 Term`!x n. ~(x = &0) /\ 0 < n 3544 ==> ?t. &0 < abs(t) /\ 3545 abs(t) < abs(x) /\ 3546 (exp(x) = sum(0,n)(\m. x pow m / &(FACT m)) + 3547 (exp(t) / &(FACT n)) * x pow n)`, 3548 MP_TAC (MATCH_MP MCLAURIN_ALL_LT MCLAURIN_EXP_LEMMA) THEN BETA_TAC THEN 3549 REPEAT STRIP_TAC THEN RES_TAC THEN NTAC 3 (POP_ASSUM (K ALL_TAC)) THEN 3550 EXISTS_TAC (Term`t:real`) THEN 3551 ASM_REWRITE_TAC [EXP_0,real_div,REAL_MUL_LID,REAL_MUL_RID] 3552 THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN CONV_TAC FUN_EQ_CONV 3553 THEN GEN_TAC THEN BETA_TAC THEN GEN_REWRITE_TAC LAND_CONV [] [REAL_MUL_SYM] 3554 THEN REFL_TAC); 3555 3556val MCLAURIN_EXP_LE = store_thm("MCLAURIN_EXP_LE", 3557 Term`!x n. ?t. abs(t) <= abs(x) /\ 3558 (exp(x) = sum(0,n)(\m. x pow m / &(FACT m)) + 3559 (exp(t) / &(FACT n)) * x pow n)`, 3560 MP_TAC (MATCH_MP MCLAURIN_ALL_LE MCLAURIN_EXP_LEMMA) THEN 3561 DISCH_THEN (fn th => REPEAT GEN_TAC THEN STRIP_ASSUME_TAC (SPEC_ALL th)) 3562 THEN EXISTS_TAC (Term`t:real`) THEN ASM_REWRITE_TAC [] THEN 3563 AP_THM_TAC THEN REPEAT AP_TERM_TAC THEN CONV_TAC FUN_EQ_CONV 3564 THEN GEN_TAC THEN BETA_TAC THEN 3565 REWRITE_TAC[EXP_0, real_div, REAL_MUL_LID, REAL_MUL_RID] THEN 3566 GEN_REWRITE_TAC LAND_CONV [] [REAL_MUL_SYM] THEN REFL_TAC); 3567 3568(* ------------------------------------------------------------------------- *) 3569(* Version for ln(1 - x). *) 3570(* ------------------------------------------------------------------------- *) 3571 3572val DIFF_LN_COMPOSITE = store_thm("DIFF_LN_COMPOSITE", 3573 Term`!g m x. (g diffl m)(x) /\ &0 < g x 3574 ==> ((\x. ln(g x)) diffl (inv(g x) * m))(x)`, 3575 REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFF_CHAIN THEN 3576 ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFF_LN THEN 3577 ASM_REWRITE_TAC[]); 3578 3579val _ = basic_diffs := !basic_diffs@[SPEC_ALL DIFF_LN_COMPOSITE]; 3580 3581val lem = prove(Term`!n:num. 0 < n ==> ~(n=0)`, 3582INDUCT_TAC THEN ASM_REWRITE_TAC [NOT_SUC,NOT_LESS_0]); 3583 3584(* ---------------------------------------------------------------------- 3585 Exponentiation with real exponents 3586 3587 Contributed by 3588 3589 Umair Siddique 3590 3591 Email: umair.siddique@rcms.nust.edu.pk 3592 DATE: 29-12-2010 3593 3594 System Analysis & Verification (sAvE) LAB 3595 3596 National University of Sciences and Technology (NUST) 3597 Ialamabad,Pakistan 3598 ---------------------------------------------------------------------- *) 3599 3600fun K_TAC _ = ALL_TAC; 3601 3602open bossLib realSimps 3603 3604(* Definition *) 3605val _ = set_fixity "rpow" (Infixr 700); 3606 3607val rpow = Define `a rpow b = exp (b * ln a)`; 3608 3609(* Properties *) 3610 3611val GEN_RPOW = store_thm 3612 ("GEN_RPOW", 3613 ``! a n. 0 < a ==> (a pow n = a rpow &n)``, 3614 Induct_on `n` THENL [ 3615 RW_TAC real_ss [pow,POW_1, rpow, GSYM EXP_0], 3616 3617GEN_TAC THEN 3618 RW_TAC std_ss[rpow,pow,REAL,REAL_RDISTRIB,EXP_ADD,REAL_MUL_LID] THEN 3619 3620 KNOW_TAC ``exp(ln a)= a`` THEN1 3621 PROVE_TAC[EXP_LN] THEN 3622 DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN 3623 KNOW_TAC ``a* exp (&n * ln a) = exp (&n * ln a)*a`` THEN1 3624 RW_TAC std_ss[REAL_MUL_COMM] THEN 3625 DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC]); 3626 3627val RPOW_SUC_N = store_thm 3628 ("RPOW_SUC_N", 3629 ``!(a:real) (n:num). 0 < a ==>(a rpow (&n+1)= a pow SUC n)``, 3630 RW_TAC std_ss [] THEN 3631 KNOW_TAC``&n + (1:real)= & SUC n`` THEN1 3632 RW_TAC std_ss [REAL]THEN 3633 DISCH_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN 3634 RW_TAC std_ss [GEN_RPOW]) ; 3635 3636val RPOW_0= store_thm 3637 ("RPOW_0", 3638 ``! a. (0 < a)==> (a rpow &0 = &1)``, 3639 RW_TAC std_ss [rpow]THEN 3640 RW_TAC std_ss [REAL_MUL_LZERO]THEN 3641 RW_TAC std_ss [EXP_0]); 3642 3643val RPOW_1= store_thm 3644 ("RPOW_1", 3645 ``! a. (0 < a)==> ( a rpow &1 = a)``, 3646 RW_TAC std_ss [GSYM GEN_RPOW,POW_1]); 3647 3648val ONE_RPOW= store_thm 3649 ("ONE_RPOW", 3650 ``! a. (0 < a)==> (1 rpow a = 1)``, 3651RW_TAC real_ss [rpow,LN_1,EXP_0]); 3652 3653val RPOW_POS_LT= store_thm 3654 ("RPOW_POS_LT", 3655 ``! a b. (0 < a)==> (0 < a rpow b)``, 3656 RW_TAC std_ss [rpow, EXP_POS_LT]); 3657 3658val RPOW_NZ= store_thm 3659 ("RPOW_NZ", 3660 ``! a b. (0 <> a)==> ( a rpow b <>0)``, 3661RW_TAC std_ss [rpow,EXP_NZ]); 3662 3663 3664val LN_RPOW= store_thm 3665 ("LN_RPOW", 3666 ``! a b. (0 < a)==> (ln (a rpow b)= (b*ln a))``, 3667 RW_TAC std_ss [rpow,LN_EXP]); 3668 3669val RPOW_ADD= store_thm 3670 ("RPOW_ADD", 3671 ``! a b c. a rpow (b + c)= (a rpow b)*(a rpow c)``, 3672 RW_TAC std_ss [rpow, EXP_ADD, REAL_RDISTRIB] ); 3673 3674val RPOW_ADD_MUL= store_thm 3675 ("RPOW_ADD_MUL", 3676 ``! a b c. a rpow (b + c)* a rpow (-b)= (a rpow c)``, 3677 RW_TAC std_ss [rpow, REAL_RDISTRIB, GSYM EXP_ADD]THEN 3678 KNOW_TAC`` ((b * ln a + c * ln a + -b * ln a)=(b * ln a -b * ln a + c*ln a)) ``THEN1 3679 REAL_ARITH_TAC THEN 3680 DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC THEN 3681 KNOW_TAC``((b * ln a - b * ln a + c * ln a) = (c*ln a )) ``THEN1 3682 REAL_ARITH_TAC THEN 3683 RW_TAC real_ss []); 3684 3685val RPOW_SUB= store_thm 3686 ("RPOW_SUB", 3687 ``! a b c. a rpow (b - c)= (a rpow b)/(a rpow c)``, 3688RW_TAC std_ss [rpow, REAL_SUB_RDISTRIB, EXP_SUB]); 3689 3690val RPOW_DIV= store_thm 3691 ("RPOW_DIV", 3692 ``! a b c. (0 < a)/\ (0<b)==> ((a/b) rpow c= (a rpow c)/(b rpow c))``, 3693 RW_TAC std_ss [rpow ,LN_DIV, REAL_SUB_LDISTRIB, EXP_SUB]); 3694 3695val RPOW_INV= store_thm 3696 ("RPOW_INV", 3697 ``! a b . (0 < a)==>((inv a) rpow b= inv (a rpow b))``, 3698 3699RW_TAC real_ss [rpow, REAL_INV_1OVER, LN_DIV, REAL_SUB_LDISTRIB, EXP_SUB, LN_1, EXP_0]); 3700 3701 3702val RPOW_MUL= store_thm 3703 ("RPOW_MUL", 3704 ``! a b c. (0<a) /\ (0<b)==> (((a*b) rpow c)=(a rpow c)*(b rpow c))``, 3705RW_TAC std_ss [rpow, LN_MUL, REAL_LDISTRIB, EXP_ADD]); 3706 3707val RPOW_RPOW= store_thm 3708 ("RPOW_RPOW", 3709 ``! a b c. (0<a)==> ((a rpow b) rpow c = a rpow (b*c))``, 3710 RW_TAC real_ss [rpow, LN_EXP, REAL_MUL_ASSOC] THEN 3711 PROVE_TAC[ REAL_MUL_COMM] ); 3712 3713 3714val RPOW_LT= store_thm 3715 ("RPOW_LT", 3716 ``! (a:real) (b:real) (c:real).(1 < a)==>((a rpow b < a rpow c)= b < c )``, 3717 RW_TAC std_ss [rpow] THEN 3718 KNOW_TAC`` exp (b * ln a) < exp (c * ln a)= (b*ln a < c*ln a)`` THEN1 3719 RW_TAC real_ss [EXP_MONO_LT] THEN 3720 DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC THEN 3721 KNOW_TAC``((b:real)*ln a < (c:real)*ln a)= (b < c)`` THENL [ 3722 MATCH_MP_TAC REAL_LT_RMUL THEN 3723 KNOW_TAC``0 < ln a = exp (0) < exp (ln a)`` THEN1 3724 PROVE_TAC[EXP_MONO_LT] THEN 3725 DISCH_TAC THEN 3726 FULL_SIMP_TAC real_ss[] THEN 3727 RW_TAC real_ss [EXP_0] THEN 3728 KNOW_TAC``1 < (a:real) ==> 0 <(a:real)`` THENL [ 3729 RW_TAC real_ss [] THEN 3730 MATCH_MP_TAC REAL_LT_TRANS THEN 3731 EXISTS_TAC``(1:real)`` THEN 3732 RW_TAC real_ss [], 3733 RW_TAC real_ss [] THEN 3734 KNOW_TAC``exp (ln a)=(a:real)`` THEN1 3735 RW_TAC real_ss [EXP_LN] THEN 3736 DISCH_TAC THEN ASM_REWRITE_TAC[]], 3737 RW_TAC real_ss []]); 3738 3739val RPOW_LE = store_thm 3740 ("RPOW_LE", 3741 ``!a b c. (1 < a)==>((a rpow b <= a rpow c)= b <= c )``, 3742 RW_TAC std_ss [rpow] THEN 3743 KNOW_TAC`` exp ((b:real) * ln a) <= exp ((c:real) * ln a)= ((b:real)*ln a <= (c:real)*ln a)`` THEN1 3744 RW_TAC real_ss [EXP_MONO_LE] THEN 3745 DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC THEN 3746 KNOW_TAC``(b*ln a <= c*ln a)= ((b:real) <= (c:real))`` THENL[ 3747 MATCH_MP_TAC REAL_LE_RMUL THEN 3748 KNOW_TAC``0 < ln a = exp (0) < exp (ln a)`` THEN1 3749 PROVE_TAC[EXP_MONO_LT] THEN 3750 DISCH_TAC THEN 3751 FULL_SIMP_TAC real_ss[] THEN 3752 RW_TAC real_ss [EXP_0] THEN 3753 KNOW_TAC``1 < (a:real) ==> 0 <(a:real)`` THENL[ 3754 RW_TAC real_ss [] THEN 3755 MATCH_MP_TAC REAL_LT_TRANS THEN 3756 EXISTS_TAC``(1:real)`` THEN 3757 RW_TAC real_ss [] , 3758 RW_TAC real_ss [] THEN 3759 KNOW_TAC``exp (ln a)=(a:real)`` THEN1 3760 RW_TAC real_ss [EXP_LN] THEN 3761 DISCH_TAC THEN ASM_REWRITE_TAC[]], 3762 RW_TAC real_ss []]); 3763 3764 3765val BASE_RPOW_LE= store_thm 3766 ("BASE_RPOW_LE", 3767 ``! a b c. (0 < a)/\ (0 < c)/\ (0 < b)==>((a rpow b <= c rpow b)= a <= c )``, 3768RW_TAC std_ss [rpow, EXP_MONO_LE] THEN 3769KNOW_TAC`` (((b:real) * ln a) <= ((b:real) * ln c))= ((ln a <= ln c))`` THENL[ 3770 MATCH_MP_TAC REAL_LE_LMUL THEN 3771 RW_TAC real_ss [], 3772 3773 DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC THEN 3774 RW_TAC real_ss [LN_MONO_LE]]); 3775 3776val BASE_RPOW_LT= store_thm 3777 ("BASE_RPOW_LT", 3778 ``! a b c. (0 < a)/\ (0 < c)/\ (0 < b)==>((a rpow b < c rpow b)= a < c )``, 3779 3780 RW_TAC std_ss [rpow, EXP_MONO_LT] THEN 3781 KNOW_TAC ``((b * ln a) < (b * ln c))= ((ln a < ln c))`` THENL[ 3782 MATCH_MP_TAC REAL_LT_LMUL THEN 3783 RW_TAC real_ss [] , 3784 3785 DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC THEN 3786 RW_TAC real_ss [LN_MONO_LT] ]); 3787 3788val RPOW_UNIQ_BASE= store_thm ( 3789 "RPOW_UNIQ_BASE", 3790 ``!a b c. 0 < a /\ 0 < c /\ 0 <> b /\ (a rpow b = c rpow b)==> (a = c)``, 3791 3792 3793 RW_TAC std_ss [rpow, GSYM LN_INJ]THEN 3794 POP_ASSUM MP_TAC THEN 3795 KNOW_TAC`` (exp (b * ln a) = exp (b * ln c)) = (ln (exp (b * ln a)) = ln (exp (b * ln c)))``THEN1 3796 PROVE_TAC[LN_EXP]THEN 3797 DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC THEN 3798 FULL_SIMP_TAC real_ss[LN_EXP] THEN 3799 FULL_SIMP_TAC real_ss[REAL_EQ_MUL_LCANCEL]); 3800 3801 3802val RPOW_UNIQ_EXP = store_thm 3803 ("RPOW_UNIQ_EXP", 3804 ``!a b c. 1 < a /\ 0 < c /\ 0 < b /\ (a rpow b = a rpow c) ==> 3805 (b = c)``, 3806 RW_TAC std_ss [rpow, GSYM LN_INJ] THEN 3807 POP_ASSUM MP_TAC THEN 3808 KNOW_TAC`` (exp (b * ln a) = exp (c * ln a)) = (ln (exp (b * ln a)) = ln (exp (c * ln a)))`` THEN1 3809 PROVE_TAC[LN_EXP] THEN 3810 DISCH_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM K_TAC THEN 3811 FULL_SIMP_TAC real_ss[LN_EXP] THEN 3812 FULL_SIMP_TAC real_ss[REAL_EQ_RMUL] THEN 3813 KNOW_TAC``(1 < (a:real))==> 0 < ln a`` THENL[ 3814 RW_TAC real_ss [] THEN 3815 KNOW_TAC``0 < ln a = exp (0) < exp (ln a)`` THEN1 3816 PROVE_TAC[EXP_MONO_LT] THEN 3817 DISCH_TAC THEN 3818 FULL_SIMP_TAC real_ss[] THEN 3819 RW_TAC real_ss [EXP_0] THEN 3820 KNOW_TAC``1 < (a:real) ==> 0 <(a:real)`` THENL[ 3821 RW_TAC real_ss [] THEN 3822 MATCH_MP_TAC REAL_LT_TRANS THEN 3823 EXISTS_TAC``(1:real)`` THEN 3824 RW_TAC real_ss [] , 3825 RW_TAC real_ss [] THEN 3826 KNOW_TAC``exp (ln a)=(a:real)`` THEN1 3827 RW_TAC real_ss [EXP_LN] THEN 3828 DISCH_TAC THEN ASM_REWRITE_TAC[] THEN RW_TAC real_ss []], 3829 FULL_SIMP_TAC real_ss[REAL_POS_NZ] ]); 3830 3831val RPOW_DIV_BASE= store_thm 3832 ("RPOW_DIV_BASE", 3833 `` ! x t. (0 < x)==> ((x rpow t)/x = x rpow (t-1))``, 3834RW_TAC std_ss [rpow, REAL_SUB_RDISTRIB, EXP_SUB, REAL_MUL_LID] THEN 3835KNOW_TAC``exp(ln x)= (x:real)`` THEN1 3836 PROVE_TAC[EXP_LN] THEN 3837DISCH_TAC THEN ASM_REWRITE_TAC [] ); 3838 3839(*----------------------------------------------------------------*) 3840(* Differentiability of real powers *) 3841(*----------------------------------------------------------------*) 3842 3843val DIFF_COMPOSITE_EXP = store_thm 3844 ("DIFF_COMPOSITE_EXP", 3845 ``!g m x. ((g diffl m) x ==> ((\x. exp (g x)) diffl (exp (g x) * m)) x)``, 3846 RW_TAC std_ss [DIFF_COMPOSITE]); 3847 3848val DIFF_RPOW = store_thm 3849 ("DIFF_RPOW", 3850 ``!x y. 0 < x ==> (((\x. (x rpow y)) diffl (y* (x rpow (y-1))))x )``, 3851RW_TAC real_ss [rpow,GSYM RPOW_DIV_BASE] THEN 3852RW_TAC real_ss [REAL_MUL_ASSOC,real_div,REAL_MUL_COMM]THEN 3853RW_TAC real_ss [GSYM real_div] THEN 3854KNOW_TAC ``!x'. exp ((y * ln x')) = exp ((\x'. y *ln x') x')`` THEN1 3855 RW_TAC real_ss [] THEN 3856DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN 3857KNOW_TAC `` ((y / x) * exp ((\x'. y * ln x') x))= ( exp ((\x'. y * ln x') x)*(y/x) ) `` THEN1 3858 RW_TAC std_ss [REAL_MUL_COMM] THEN 3859DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN 3860MATCH_MP_TAC DIFF_COMPOSITE_EXP THEN 3861KNOW_TAC ``((\x. y * ln x) diffl (y/x)) x = ((\x. y * (\x.ln x) x) diffl (y/x)) x`` THEN1 3862 RW_TAC real_ss [] THEN 3863DISCH_TAC THEN ASM_REWRITE_TAC [] THEN POP_ASSUM K_TAC THEN 3864RW_TAC real_ss [real_div] THEN 3865MATCH_MP_TAC DIFF_CMUL THEN 3866MATCH_MP_TAC DIFF_LN THEN 3867RW_TAC real_ss []); 3868 3869 3870(* 3871val MCLAURIN_LN_POS = store_thm("MCLAURIN_LN_POS", 3872 Term`!x n. 3873 &0 < x /\ 0 < n 3874 ==> ?t. &0 < t /\ 3875 t < x /\ 3876 (ln(&1 + x) 3877 = sum(0,n) (\m. ~(&1) pow (SUC m) * (x pow m) / &m) 3878 + 3879 ~(&1) pow (SUC n) * x pow n / (&n * (&1 + t) pow n))`, 3880 REPEAT STRIP_TAC THEN 3881 MP_TAC(SPEC (Term`\x. ln(&1 + x)`) MCLAURIN) THEN 3882 DISCH_THEN(MP_TAC o SPEC 3883 (Term`\n x. (n=0) => ln(&1 + x) 3884 | ~(&1) pow (SUC n) 3885 * &(FACT(PRE n)) * inv((&1 + x) pow n)`)) THEN 3886 DISCH_THEN(MP_TAC o SPECL [Term`x:real`, Term`n:num`]) THEN 3887 BETA_TAC THEN ASM_REWRITE_TAC[] THEN 3888 REWRITE_TAC[NOT_SUC, REAL_ADD_RID, POW_ONE, LN_1, REAL_INV1,REAL_MUL_RID] THEN 3889 SUBGOAL_THEN (Term`~(n = 0)`) ASSUME_TAC THENL 3890 [IMP_RES_TAC lem, ASM_REWRITE_TAC[]] THEN 3891 SUBGOAL_THEN (Term`!p. ~(p = 0) ==> (&(FACT(PRE p)) / &(FACT p) = inv(&p))`) 3892 ASSUME_TAC THENL 3893 [INDUCT_TAC THEN REWRITE_TAC[NOT_SUC, PRE] THEN 3894 REWRITE_TAC[real_div, FACT, GSYM REAL_OF_NUM_MUL] THEN 3895 SUBGOAL_THEN (Term `~(& (SUC p) = &0) /\ ~(& (FACT p) = &0)`) 3896 (fn th => REWRITE_TAC [MATCH_MP REAL_INV_MUL th]) THENL 3897 [REWRITE_TAC[REAL_OF_NUM_EQ,NOT_SUC] THEN MATCH_MP_TAC lem THEN 3898 MATCH_ACCEPT_TAC FACT_LESS, 3899 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN 3900 GEN_REWRITE_TAC RAND_CONV [] [GSYM REAL_MUL_RID] THEN 3901 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN 3902 AP_TERM_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN 3903 REWRITE_TAC[REAL_OF_NUM_EQ] THEN MATCH_MP_TAC lem THEN 3904 MATCH_ACCEPT_TAC FACT_LESS], ALL_TAC] THEN 3905 SUBGOAL_THEN (Term 3906 `!p. (p = 0 => &0 | ~(&1) pow (SUC p) * &(FACT (PRE p))) 3907 / &(FACT p) 3908 = 3909 ~(&1) pow (SUC p) * inv(&p)`) 3910 (fn th => REWRITE_TAC[th]) THENL 3911 [INDUCT_TAC THENL 3912 [REWRITE_TAC[REAL_INV_0, real_div, REAL_MUL_LZERO, REAL_MUL_RZERO], 3913 REWRITE_TAC[NOT_SUC] THEN 3914 REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN 3915 AP_TERM_TAC THEN REWRITE_TAC[GSYM real_div] THEN 3916 FIRST_ASSUM MATCH_MP_TAC THEN 3917 REWRITE_TAC[NOT_SUC]], ALL_TAC] THEN 3918 SUBGOAL_THEN (Term -- what does this parse to??? 3919 `!t. ((~(&1) pow (SUC n) * &(FACT(PRE n)) * inv ((&1 + t) pow n)) 3920 / &(FACT n)) * x pow n 3921 = 3922 ~(&1) pow (SUC n) * x pow n / (&n * (&1 + t) pow n)`) 3923 (fn th => REWRITE_TAC[th]) THENL 3924 [GEN_TAC THEN REWRITE_TAC[real_div, GSYM REAL_MUL_ASSOC] THEN 3925 AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN 3926 GEN_REWRITE_TAC LAND_CONV [] [REAL_MUL_SYM] THEN AP_TERM_TAC THEN 3927 SUBGOAL_THEN (Term`~(& n = &0) /\ ~((& 1 + t) pow n = &0)`) 3928 (fn th => REWRITE_TAC [MATCH_MP REAL_INV_MUL th]) THENL 3929 [CONJ_TAC THENL 3930 [REWRITE_TAC [REAL_OF_NUM_EQ] THEN IMP_RES_TAC lem, 3931 MATCH_MP_TAC POW_NZ THEN REWRITE_TAC [REAL_OF_NUM_EQ] 3932 ,GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN 3933 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN 3934 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN 3935 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[], ALL_TAC] THEN 3936 REWRITE_TAC[real_div, REAL_MUL_AC] THEN 3937 DISCH_THEN MATCH_MP_TAC THEN 3938 X_GEN_TAC `m:num` THEN X_GEN_TAC `u:real` THEN STRIP_TAC THEN 3939 ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THENL 3940 [W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN 3941 REWRITE_TAC[PRE, real_pow, REAL_ADD_LID, REAL_MUL_RID] THEN 3942 REWRITE_TAC[REAL_MUL_RNEG, REAL_MUL_LNEG, REAL_MUL_RID] THEN 3943 REWRITE_TAC[FACT, REAL_MUL_RID, REAL_NEG_NEG] THEN 3944 DISCH_THEN MATCH_MP_TAC THEN UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC, 3945 W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN 3946 SUBGOAL_THEN `~((&1 + u) pow m = &0)` (fun th -> REWRITE_TAC[th]) THENL 3947 [REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN 3948 UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC, 3949 MATCH_MP_TAC (TAUT `(a = b) ==> a ==> b`) THEN 3950 AP_THM_TAC THEN AP_TERM_TAC THEN 3951 REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_RID] THEN 3952 REWRITE_TAC[REAL_ADD_LID, REAL_MUL_RID] THEN 3953 REWRITE_TAC[real_div, real_pow, REAL_MUL_LNEG, REAL_MUL_RNEG] THEN 3954 REWRITE_TAC[REAL_NEG_NEG, REAL_MUL_RID, REAL_MUL_LID] THEN 3955 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN 3956 UNDISCH_TAC `~(m = 0)` THEN SPEC_TAC(`m:num`,`p:num`) THEN 3957 INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN 3958 REWRITE_TAC[SUC_SUB1, PRE] THEN REWRITE_TAC[FACT] THEN 3959 REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN 3960 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN 3961 GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN 3962 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN 3963 REWRITE_TAC[real_pow, REAL_POW_2] THEN REWRITE_TAC[REAL_INV_MUL] THEN 3964 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN 3965 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN 3966 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN 3967 GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN 3968 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN 3969 MATCH_MP_TAC REAL_MUL_LINV THEN 3970 REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN 3971 REWRITE_TAC[DE_MORGAN_THM] THEN DISJ1_TAC THEN 3972 UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC]]),, 3973 3974let MCLAURIN_LN_NEG = prove 3975 (`!x n. &0 < x /\ x < &1 /\ 0 < n 3976 ==> ?t. &0 < t /\ 3977 t < x /\ 3978 (--(ln(&1 - x)) = Sum(0,n) (\m. (x pow m) / &m) + 3979 x pow n / (&n * (&1 - t) pow n))`, 3980 REPEAT STRIP_TAC THEN 3981 MP_TAC(SPEC `\x. --(ln(&1 - x))` MCLAURIN) THEN 3982 DISCH_THEN(MP_TAC o SPEC 3983 `\n x. if n = 0 then --(ln(&1 - x)) 3984 else &(FACT(PRE n)) * inv((&1 - x) pow n)`) THEN 3985 DISCH_THEN(MP_TAC o SPECL [`x:real`, `n:num`]) THEN 3986 ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_SUB_RZERO] THEN 3987 REWRITE_TAC[NOT_SUC, LN_1, REAL_POW_ONE] THEN 3988 SUBGOAL_THEN `~(n = 0)` ASSUME_TAC THENL 3989 [UNDISCH_TAC `0 < n` THEN ARITH_TAC, ASM_REWRITE_TAC[]] THEN 3990 REWRITE_TAC[REAL_INV_1, REAL_MUL_RID, REAL_MUL_LID] THEN 3991 SUBGOAL_THEN `!p. ~(p = 0) ==> (&(FACT(PRE p)) / &(FACT p) = inv(&p))` 3992 ASSUME_TAC THENL 3993 [INDUCT_TAC THEN REWRITE_TAC[NOT_SUC, PRE] THEN 3994 REWRITE_TAC[real_div, FACT, GSYM REAL_OF_NUM_MUL] THEN 3995 REWRITE_TAC[REAL_INV_MUL] THEN 3996 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN 3997 GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN 3998 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN 3999 AP_TERM_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN 4000 REWRITE_TAC[REAL_OF_NUM_EQ] THEN 4001 MP_TAC(SPEC `p:num` FACT_LT) THEN ARITH_TAC, ALL_TAC] THEN 4002 REWRITE_TAC[REAL_NEG_0] THEN 4003 SUBGOAL_THEN `!p. (if p = 0 then &0 else &(FACT (PRE p))) / &(FACT p) = 4004 inv(&p)` 4005 (fun th -> REWRITE_TAC[th]) THENL 4006 [INDUCT_TAC THENL 4007 [REWRITE_TAC[REAL_INV_0, real_div, REAL_MUL_LZERO], 4008 REWRITE_TAC[NOT_SUC] THEN FIRST_ASSUM MATCH_MP_TAC THEN 4009 REWRITE_TAC[NOT_SUC]], ALL_TAC] THEN 4010 SUBGOAL_THEN 4011 `!t. (&(FACT(PRE n)) * inv ((&1 - t) pow n)) / &(FACT n) * x pow n 4012 = x pow n / (&n * (&1 - t) pow n)` 4013 (fun th -> REWRITE_TAC[th]) THENL 4014 [GEN_TAC THEN REWRITE_TAC[real_div, REAL_MUL_ASSOC] THEN 4015 GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN AP_TERM_TAC THEN 4016 REWRITE_TAC[REAL_INV_MUL] THEN 4017 GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN 4018 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN 4019 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN 4020 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[], ALL_TAC] THEN 4021 REWRITE_TAC[real_div, REAL_MUL_AC] THEN 4022 DISCH_THEN MATCH_MP_TAC THEN 4023 X_GEN_TAC `m:num` THEN X_GEN_TAC `u:real` THEN STRIP_TAC THEN 4024 ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THENL 4025 [W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN 4026 REWRITE_TAC[PRE, pow, FACT, REAL_SUB_LZERO] THEN 4027 REWRITE_TAC[REAL_MUL_RNEG, REAL_NEG_NEG, REAL_MUL_RID] THEN 4028 DISCH_THEN MATCH_MP_TAC THEN 4029 UNDISCH_TAC `x < &1` THEN UNDISCH_TAC `u:real <= x` THEN 4030 REAL_ARITH_TAC, 4031 W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN 4032 SUBGOAL_THEN `~((&1 - u) pow m = &0)` (fun th -> REWRITE_TAC[th]) THENL 4033 [REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN 4034 UNDISCH_TAC `x < &1` THEN UNDISCH_TAC `u:real <= x` THEN 4035 REAL_ARITH_TAC, 4036 MATCH_MP_TAC (TAUT `(a = b) ==> a ==> b`) THEN 4037 AP_THM_TAC THEN AP_TERM_TAC THEN 4038 REWRITE_TAC[REAL_SUB_LZERO, real_div, PRE] THEN 4039 REWRITE_TAC[REAL_MUL_LZERO, REAL_ADD_RID] THEN 4040 REWRITE_TAC 4041 [REAL_MUL_RNEG, REAL_MUL_LNEG, REAL_NEG_NEG, REAL_MUL_RID] THEN 4042 UNDISCH_TAC `~(m = 0)` THEN SPEC_TAC(`m:num`,`p:num`) THEN 4043 INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN 4044 REWRITE_TAC[SUC_SUB1, PRE] THEN REWRITE_TAC[FACT] THEN 4045 REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN 4046 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN 4047 GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN 4048 REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN 4049 REWRITE_TAC[real_pow, REAL_POW_2] THEN REWRITE_TAC[REAL_INV_MUL] THEN 4050 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN 4051 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN 4052 ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN 4053 GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN 4054 REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN 4055 MATCH_MP_TAC REAL_MUL_LINV THEN 4056 REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN 4057 UNDISCH_TAC `x < &1` THEN UNDISCH_TAC `u:real <= x` THEN 4058 REAL_ARITH_TAC]]); 4059endnew*) 4060 4061val _ = export_theory(); 4062