(* ========================================================================= *)
(* More basic properties of the reals. *)
(* *)
(* John Harrison, University of Cambridge Computer Laboratory *)
(* *)
(* (c) Copyright, University of Cambridge 1998 *)
(* (c) Copyright, John Harrison 1998-2007 *)
(* (c) Copyright, Valentina Bruno 2010 *)
(* ========================================================================= *)
needs "realarith.ml";;
(* ------------------------------------------------------------------------- *)
(* Additional commutativity properties of the inclusion map. *)
(* ------------------------------------------------------------------------- *)
let REAL_OF_NUM_SUB = prove
(`!m n. m <= n ==> (&n - &m = &(n - m))`,
REPEAT GEN_TAC THEN REWRITE_TAC[
LE_EXISTS] THEN
STRIP_TAC THEN ASM_REWRITE_TAC[
ADD_SUB2] THEN
REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN
ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
REWRITE_TAC[
real_sub; GSYM REAL_ADD_ASSOC] THEN
MESON_TAC[REAL_ADD_LINV; REAL_ADD_SYM; REAL_ADD_LID]);;
(* ------------------------------------------------------------------------- *)
(* A few theorems we need to prove explicitly for later. *)
(* ------------------------------------------------------------------------- *)
let REAL_MUL_AC = prove
(`(m * n = n * m) /\
((m * n) * p = m * (n * p)) /\
(m * (n * p) = n * (m * p))`,
REWRITE_TAC[REAL_MUL_ASSOC; EQT_INTRO(SPEC_ALL REAL_MUL_SYM)] THEN
AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM);;
let REAL_LT_LADD_IMP = prove
(`!x y z. y < z ==> x + y < x + z`,
REPEAT GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN
REWRITE_TAC[
real_lt] THEN
DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_LADD_IMP) THEN
DISCH_THEN(MP_TAC o SPEC `--x`) THEN
REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID]);;
(* ------------------------------------------------------------------------- *)
(* Tactic version of REAL_ARITH. *)
(* ------------------------------------------------------------------------- *)
let REAL_ARITH_TAC = CONV_TAC REAL_ARITH;;
(* ------------------------------------------------------------------------- *)
(* Prove all the linear theorems we can blow away automatically. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Theorems about "abs". *)
(* ------------------------------------------------------------------------- *)
let REAL_ABS_BETWEEN2 = prove
(`!x0 x y0 y. x0 < y0 /\ &2 * abs(x - x0) < (y0 - x0) /\
&2 * abs(y - y0) < (y0 - x0)
==> x < y`,
REAL_ARITH_TAC);;
(* ------------------------------------------------------------------------- *)
(* Theorems about max and min. *)
(* ------------------------------------------------------------------------- *)
let REAL_MAX_ACI = prove
(`(max x y = max y x) /\
(max (max x y) z = max x (max y z)) /\
(max x (max y z) = max y (max x z)) /\
(max x x = x) /\
(max x (max x y) = max x y)`,
REAL_ARITH_TAC);;
let REAL_MIN_ACI = prove
(`(min x y = min y x) /\
(min (min x y) z = min x (min y z)) /\
(min x (min y z) = min y (min x z)) /\
(min x x = x) /\
(min x (min x y) = min x y)`,
REAL_ARITH_TAC);;
(* ------------------------------------------------------------------------- *)
(* To simplify backchaining, just as in the natural number case. *)
(* ------------------------------------------------------------------------- *)
let REAL_LE_IMP =
let pth = PURE_ONCE_REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS in
fun th -> GEN_ALL(MATCH_MP pth (SPEC_ALL th));;
let REAL_LET_IMP =
let pth = PURE_ONCE_REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS in
fun th -> GEN_ALL(MATCH_MP pth (SPEC_ALL th));;
(* ------------------------------------------------------------------------- *)
(* Now a bit of nonlinear stuff. *)
(* ------------------------------------------------------------------------- *)
let REAL_INV_INV = prove
(`!x. inv(inv x) = x`,
GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN
ASM_REWRITE_TAC[REAL_INV_0] THEN
MATCH_MP_TAC
REAL_MUL_RINV_UNIQ THEN
MATCH_MP_TAC REAL_MUL_LINV THEN
ASM_REWRITE_TAC[]);;
let REAL_INV_EQ_0 = prove
(`!x. inv(x) = &0 <=> x = &0`,
GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[REAL_INV_0] THEN
ONCE_REWRITE_TAC[GSYM
REAL_INV_INV] THEN ASM_REWRITE_TAC[REAL_INV_0]);;
let REAL_LT_INV = prove
(`!x. &0 < x ==> &0 < inv(x)`,
GEN_TAC THEN
REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPEC `inv(x)`
REAL_LT_NEGTOTAL) THEN
ASM_REWRITE_TAC[] THENL
[RULE_ASSUM_TAC(REWRITE_RULE[
REAL_INV_EQ_0]) THEN ASM_REWRITE_TAC[];
DISCH_TAC THEN SUBGOAL_THEN `&0 < --(inv x) * x` MP_TAC THENL
[MATCH_MP_TAC
REAL_LT_MUL THEN ASM_REWRITE_TAC[];
REWRITE_TAC[
REAL_MUL_LNEG]]] THEN
SUBGOAL_THEN `inv(x) * x = &1` SUBST1_TAC THENL
[MATCH_MP_TAC REAL_MUL_LINV THEN
UNDISCH_TAC `&0 < x` THEN REAL_ARITH_TAC;
REWRITE_TAC[
REAL_LT_RNEG; REAL_ADD_LID;
REAL_OF_NUM_LT; ARITH]]);;
let REAL_MUL_RINV = prove
(`!x. ~(x = &0) ==> (x * inv(x) = &1)`,
ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
REWRITE_TAC[REAL_MUL_LINV]);;
let REAL_INV_MUL = prove
(`!x y. inv(x * y) = inv(x) * inv(y)`,
REPEAT GEN_TAC THEN
MAP_EVERY ASM_CASES_TAC [`x = &0`; `y = &0`] THEN
ASM_REWRITE_TAC[REAL_INV_0;
REAL_MUL_LZERO;
REAL_MUL_RZERO] THEN
MATCH_MP_TAC
REAL_MUL_LINV_UNIQ THEN
ONCE_REWRITE_TAC[AC
REAL_MUL_AC `(a * b) * (c * d) = (a * c) * (b * d)`] THEN
EVERY_ASSUM(SUBST1_TAC o MATCH_MP REAL_MUL_LINV) THEN
REWRITE_TAC[REAL_MUL_LID]);;
let REAL_POW_SUB = prove
(`!x m n. ~(x = &0) /\ m <= n ==> (x pow (n - m) = x pow n / x pow m)`,
REPEAT GEN_TAC THEN
DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
REWRITE_TAC[
LE_EXISTS] THEN
DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN
REWRITE_TAC[
ADD_SUB2] THEN REWRITE_TAC[
REAL_POW_ADD] THEN
REWRITE_TAC[
real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN
REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MUL_LINV THEN
MATCH_MP_TAC
REAL_POW_NZ THEN ASM_REWRITE_TAC[]);;
let REAL_LT_LCANCEL_IMP = prove
(`!x y z. &0 < x /\ x * y < x * z ==> y < z`,
REPEAT GEN_TAC THEN
DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT1 th) THEN MP_TAC th) THEN DISCH_THEN
(MP_TAC o uncurry CONJ o (MATCH_MP
REAL_LT_INV F_F I) o CONJ_PAIR) THEN
DISCH_THEN(MP_TAC o MATCH_MP
REAL_LT_LMUL) THEN
POP_ASSUM(ASSUME_TAC o MATCH_MP REAL_MUL_LINV o MATCH_MP
REAL_LT_IMP_NZ) THEN
ASM_REWRITE_TAC[REAL_MUL_ASSOC; REAL_MUL_LID]);;
let REAL_LE_MUL_EQ = prove
(`(!x y. &0 < x ==> (&0 <= x * y <=> &0 <= y)) /\
(!x y. &0 < y ==> (&0 <= x * y <=> &0 <= x))`,
let REAL_LT_MUL_EQ = prove
(`(!x y. &0 < x ==> (&0 < x * y <=> &0 < y)) /\
(!x y. &0 < y ==> (&0 < x * y <=> &0 < x))`,
let REAL_LE_MUL2 = prove
(`!w x y z. &0 <= w /\ w <= x /\ &0 <= y /\ y <= z
==> w * y <= x * z`,
REPEAT STRIP_TAC THEN MATCH_MP_TAC
REAL_LE_TRANS THEN
EXISTS_TAC `w * z` THEN CONJ_TAC THENL
[MATCH_MP_TAC
REAL_LE_LMUL; MATCH_MP_TAC
REAL_LE_RMUL] THEN
ASM_REWRITE_TAC[] THEN
MATCH_MP_TAC
REAL_LE_TRANS THEN EXISTS_TAC `y:real` THEN
ASM_REWRITE_TAC[]);;
let REAL_LT_INV2 = prove
(`!x y. &0 < x /\ x < y ==> inv(y) < inv(x)`,
REPEAT STRIP_TAC THEN MATCH_MP_TAC
REAL_LT_RCANCEL_IMP THEN
EXISTS_TAC `x * y` THEN CONJ_TAC THENL
[MATCH_MP_TAC
REAL_LT_MUL THEN
POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC;
SUBGOAL_THEN `(inv x * x = &1) /\ (inv y * y = &1)` ASSUME_TAC THENL
[CONJ_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN
POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC;
ASM_REWRITE_TAC[REAL_MUL_ASSOC; REAL_MUL_LID] THEN
GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN
ASM_REWRITE_TAC[GSYM REAL_MUL_ASSOC;
REAL_MUL_RID]]]);;
let REAL_LE_INV2 = prove
(`!x y. &0 < x /\ x <= y ==> inv(y) <= inv(x)`,
REPEAT GEN_TAC THEN REWRITE_TAC[
REAL_LE_LT] THEN
ASM_CASES_TAC `x:real = y` THEN ASM_REWRITE_TAC[] THEN
STRIP_TAC THEN DISJ1_TAC THEN MATCH_MP_TAC
REAL_LT_INV2 THEN
ASM_REWRITE_TAC[]);;
let REAL_DOWN = prove
(`!d. &0 < d ==> ?e. &0 < e /\ e < d`,
GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `d / &2` THEN
ASSUME_TAC(REAL_ARITH `&0 < &2`) THEN
ASSUME_TAC(MATCH_MP REAL_MUL_LINV (REAL_ARITH `~(&2 = &0)`)) THEN
CONJ_TAC THEN MATCH_MP_TAC
REAL_LT_RCANCEL_IMP THEN EXISTS_TAC `&2` THEN
ASM_REWRITE_TAC[
real_div; GSYM REAL_MUL_ASSOC;
REAL_MUL_RID] THEN
UNDISCH_TAC `&0 < d` THEN REAL_ARITH_TAC);;
let REAL_DOWN2 = prove
(`!d1 d2. &0 < d1 /\ &0 < d2 ==> ?e. &0 < e /\ e < d1 /\ e < d2`,
REPEAT GEN_TAC THEN STRIP_TAC THEN
DISJ_CASES_TAC(SPECL [`d1:real`; `d2:real`]
REAL_LE_TOTAL) THENL
[MP_TAC(SPEC `d1:real`
REAL_DOWN);
MP_TAC(SPEC `d2:real`
REAL_DOWN)] THEN
ASM_REWRITE_TAC[] THEN
DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
EXISTS_TAC `e:real` THEN
POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
REAL_ARITH_TAC);;
let REAL_POW_LE2 = prove
(`!n x y. &0 <= x /\ x <= y ==> x pow n <= y pow n`,
INDUCT_TAC THEN REWRITE_TAC[
real_pow;
REAL_LE_REFL] THEN
REPEAT STRIP_TAC THEN MATCH_MP_TAC
REAL_LE_MUL2 THEN
ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
[MATCH_MP_TAC
REAL_POW_LE THEN ASM_REWRITE_TAC[];
FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);;
let REAL_POW_MONO = prove
(`!m n x. &1 <= x /\ m <= n ==> x pow m <= x pow n`,
REPEAT GEN_TAC THEN REWRITE_TAC[
LE_EXISTS] THEN
DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN
REWRITE_TAC[
REAL_POW_ADD] THEN
GEN_REWRITE_TAC LAND_CONV [GSYM
REAL_MUL_RID] THEN
MATCH_MP_TAC
REAL_LE_LMUL THEN CONJ_TAC THENL
[MATCH_MP_TAC
REAL_LE_TRANS THEN EXISTS_TAC `&1` THEN
REWRITE_TAC[REAL_OF_NUM_LE; ARITH] THEN
MATCH_MP_TAC
REAL_POW_LE_1 THEN ASM_REWRITE_TAC[];
MATCH_MP_TAC
REAL_POW_LE_1 THEN ASM_REWRITE_TAC[]]);;
let REAL_POW_LT2 = prove
(`!n x y. ~(n = 0) /\ &0 <= x /\ x < y ==> x pow n < y pow n`,
INDUCT_TAC THEN REWRITE_TAC[
NOT_SUC;
real_pow] THEN REPEAT STRIP_TAC THEN
ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[
real_pow;
REAL_MUL_RID] THEN
MATCH_MP_TAC
REAL_LT_MUL2 THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
[MATCH_MP_TAC
REAL_POW_LE THEN ASM_REWRITE_TAC[];
FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);;
let REAL_DIV_POW2 = prove
(`!x m n. ~(x = &0)
==> (x pow m / x pow n = if n <= m then x pow (m - n)
else inv(x pow (n - m)))`,
REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
ASM_SIMP_TAC[
REAL_POW_SUB] THEN
GEN_REWRITE_TAC LAND_CONV [GSYM
REAL_INV_INV] THEN
AP_TERM_TAC THEN REWRITE_TAC[
REAL_INV_DIV] THEN
UNDISCH_TAC `~(n:num <= m)` THEN REWRITE_TAC[
NOT_LE] THEN
DISCH_THEN(MP_TAC o MATCH_MP
LT_IMP_LE) THEN
ASM_SIMP_TAC[
REAL_POW_SUB]);;
let REAL_DIV_POW2_ALT = prove
(`!x m n. ~(x = &0)
==> (x pow m / x pow n = if n < m then x pow (m - n)
else inv(x pow (n - m)))`,
let REAL_SOS_EQ_0 = prove
(`!x y. x pow 2 + y pow 2 = &0 <=> x = &0 /\ y = &0`,
REPEAT GEN_TAC THEN EQ_TAC THEN
SIMP_TAC[REAL_POW_2;
REAL_MUL_LZERO; REAL_ADD_LID] THEN
DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
`x + y = &0 ==> &0 <= x /\ &0 <= y ==> x = &0 /\ y = &0`)) THEN
REWRITE_TAC[
REAL_LE_SQUARE;
REAL_ENTIRE]);;
let REAL_POW_EQ = prove
(`!n x y. ~(n = 0) /\ &0 <= x /\ &0 <= y /\ x pow n = y pow n ==> x = y`,
let REAL_POW_EQ_1 = prove
(`!x n. x pow n = &1 <=> abs(x) = &1 /\ (x < &0 ==>
EVEN(n)) \/ n = 0`,
REPEAT GEN_TAC THEN
ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[
real_pow] THEN
ASM_CASES_TAC `abs(x) = &1` THENL
[ALL_TAC; ASM_MESON_TAC[
REAL_POW_EQ_1_IMP]] THEN
ASM_REWRITE_TAC[] THEN
FIRST_X_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP (REAL_ARITH
`abs x = a ==> x = a \/ x = --a`)) THEN
ASM_REWRITE_TAC[
REAL_POW_NEG;
REAL_POW_ONE] THEN
REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);;
let REAL_POW_LT2_ODD = prove
(`!n x y. x < y /\
ODD n ==> x pow n < y pow n`,
REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN
ASM_REWRITE_TAC[ARITH] THEN STRIP_TAC THEN
DISJ_CASES_TAC(SPEC `y:real`
REAL_LE_NEGTOTAL) THENL
[DISJ_CASES_TAC(REAL_ARITH `&0 <= x \/ &0 < --x`) THEN
ASM_SIMP_TAC[
REAL_POW_LT2] THEN
SUBGOAL_THEN `&0 < --x pow n /\ &0 <= y pow n` MP_TAC THENL
[ASM_SIMP_TAC[
REAL_POW_LE;
REAL_POW_LT];
ASM_REWRITE_TAC[
REAL_POW_NEG; GSYM
NOT_ODD] THEN REAL_ARITH_TAC];
SUBGOAL_THEN `--y pow n < --x pow n` MP_TAC THENL
[MATCH_MP_TAC
REAL_POW_LT2 THEN ASM_REWRITE_TAC[];
ASM_REWRITE_TAC[
REAL_POW_NEG; GSYM
NOT_ODD]] THEN
REPEAT(POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC]);;
(* ------------------------------------------------------------------------- *)
(* Some basic forms of the Archimedian property. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* The sign of a real number, as a real number. *)
(* ------------------------------------------------------------------------- *)
let real_sgn = new_definition
`(real_sgn:real->real) x =
if &0 < x then &1 else if x < &0 then -- &1 else &0`;;
(* ------------------------------------------------------------------------- *)
(* Useful "without loss of generality" lemmas. *)
(* ------------------------------------------------------------------------- *)
let REAL_WLOG_LT = prove
(`(!x. P x x) /\ (!x y. P x y <=> P y x) /\ (!x y. x < y ==> P x y)
==> !x y. P x y`,