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