|
| 1 | +(* ========================================================================= *) |
| 2 | +(* Arithmetic-geometric mean inequality. *) |
| 3 | +(* ========================================================================= *) |
| 4 | + |
| 5 | +needs "Library/products.ml";; |
| 6 | +prioritize_real();; |
| 7 | + |
| 8 | +(* ------------------------------------------------------------------------- *) |
| 9 | +(* There's already one proof of this in "Library/agm.ml". This one is from *) |
| 10 | +(* an article by Michael Hirschhorn, Math. Intelligencer vol. 29, p7. *) |
| 11 | +(* ------------------------------------------------------------------------- *) |
| 12 | + |
| 13 | +let LEMMA_1 = prove |
| 14 | + (`!x n. x pow (n + 1) - (&n + &1) * x + &n = |
| 15 | + (x - &1) pow 2 * sum(1..n) (\k. &k * x pow (n - k))`, |
| 16 | + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN GEN_TAC THEN INDUCT_TAC THEN |
| 17 | + REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_EQ; ADD_CLAUSES] THENL |
| 18 | + [REAL_ARITH_TAC; REWRITE_TAC[ARITH_RULE `1 <= SUC n`]] THEN |
| 19 | + SIMP_TAC[ARITH_RULE `k <= n ==> SUC n - k = SUC(n - k)`; SUB_REFL] THEN |
| 20 | + REWRITE_TAC[real_pow; REAL_MUL_RID] THEN |
| 21 | + REWRITE_TAC[REAL_ARITH `k * x * x pow n = (k * x pow n) * x`] THEN |
| 22 | + ASM_REWRITE_TAC[SUM_RMUL; REAL_MUL_ASSOC; REAL_ADD_LDISTRIB] THEN |
| 23 | + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_POW_ADD] THEN REAL_ARITH_TAC);; |
| 24 | + |
| 25 | +let LEMMA_2 = prove |
| 26 | + (`!n x. &0 <= x ==> &0 <= x pow (n + 1) - (&n + &1) * x + &n`, |
| 27 | + REPEAT STRIP_TAC THEN REWRITE_TAC[LEMMA_1] THEN |
| 28 | + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN |
| 29 | + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN |
| 30 | + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_POW_LE]);; |
| 31 | + |
| 32 | +let LEMMA_3 = prove |
| 33 | + (`!n x. 1 <= n /\ (!i. 1 <= i /\ i <= n + 1 ==> &0 <= x i) |
| 34 | + ==> x(n + 1) * (sum(1..n) x / &n) pow n |
| 35 | + <= (sum(1..n+1) x / (&n + &1)) pow (n + 1)`, |
| 36 | + REPEAT STRIP_TAC THEN |
| 37 | + ABBREV_TAC `a = sum(1..n+1) x / (&n + &1)` THEN |
| 38 | + ABBREV_TAC `b = sum(1..n) x / &n` THEN |
| 39 | + SUBGOAL_THEN `x(n + 1) = (&n + &1) * a - &n * b` SUBST1_TAC THENL |
| 40 | + [MAP_EVERY EXPAND_TAC ["a"; "b"] THEN |
| 41 | + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; LE_1; |
| 42 | + REAL_ARITH `~(&n + &1 = &0)`] THEN |
| 43 | + SIMP_TAC[SUM_ADD_SPLIT; ARITH_RULE `1 <= n + 1`; SUM_SING_NUMSEG] THEN |
| 44 | + REAL_ARITH_TAC; |
| 45 | + ALL_TAC] THEN |
| 46 | + SUBGOAL_THEN `&0 <= a /\ &0 <= b` STRIP_ASSUME_TAC THENL |
| 47 | + [MAP_EVERY EXPAND_TAC ["a"; "b"] THEN CONJ_TAC THEN |
| 48 | + MATCH_MP_TAC REAL_LE_DIV THEN |
| 49 | + (CONJ_TAC THENL [MATCH_MP_TAC SUM_POS_LE_NUMSEG; REAL_ARITH_TAC]) THEN |
| 50 | + ASM_SIMP_TAC[ARITH_RULE `p <= n ==> p <= n + 1`]; |
| 51 | + ALL_TAC] THEN |
| 52 | + ASM_CASES_TAC `b = &0` THEN |
| 53 | + ASM_SIMP_TAC[REAL_POW_ZERO; LE_1; REAL_MUL_RZERO; REAL_POW_LE] THEN |
| 54 | + MP_TAC(ISPECL [`n:num`; `a / b`] LEMMA_2) THEN ASM_SIMP_TAC[REAL_LE_DIV] THEN |
| 55 | + REWRITE_TAC[REAL_ARITH `&0 <= x - a + b <=> a - b <= x`; REAL_POW_DIV] THEN |
| 56 | + SUBGOAL_THEN `&0 < b` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN |
| 57 | + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_POW_LT] THEN |
| 58 | + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN |
| 59 | + REWRITE_TAC[REAL_POW_ADD] THEN UNDISCH_TAC `~(b = &0)` THEN |
| 60 | + CONV_TAC REAL_FIELD);; |
| 61 | + |
| 62 | +let AGM = prove |
| 63 | + (`!n a. 1 <= n /\ (!i. 1 <= i /\ i <= n ==> &0 <= a(i)) |
| 64 | + ==> product(1..n) a <= (sum(1..n) a / &n) pow n`, |
| 65 | + INDUCT_TAC THEN REWRITE_TAC[ARITH; PRODUCT_CLAUSES_NUMSEG] THEN |
| 66 | + REWRITE_TAC[ARITH_RULE `1 <= SUC n`] THEN X_GEN_TAC `x:num->real` THEN |
| 67 | + ASM_CASES_TAC `n = 0` THENL |
| 68 | + [ASM_REWRITE_TAC[PRODUCT_CLAUSES_NUMSEG; ARITH; SUM_SING_NUMSEG] THEN |
| 69 | + REAL_ARITH_TAC; |
| 70 | + REWRITE_TAC[ADD1] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN |
| 71 | + EXISTS_TAC `x(n + 1) * (sum(1..n) x / &n) pow n` THEN |
| 72 | + ASM_SIMP_TAC[LEMMA_3; GSYM REAL_OF_NUM_ADD; LE_1; |
| 73 | + ARITH_RULE `i <= n ==> i <= n + 1`] THEN |
| 74 | + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_RMUL THEN |
| 75 | + ASM_SIMP_TAC[LE_REFL; LE_1; ARITH_RULE `i <= n ==> i <= n + 1`]]);; |
| 76 | + |
| 77 | +(* ------------------------------------------------------------------------- *) |
| 78 | +(* Finally, reformulate in the usual way using roots. *) |
| 79 | +(* ------------------------------------------------------------------------- *) |
| 80 | + |
| 81 | +needs "Library/transc.ml";; |
| 82 | + |
| 83 | +let AGM_ROOT = prove |
| 84 | + (`!n a. 1 <= n /\ (!i. 1 <= i /\ i <= n ==> &0 <= a(i)) |
| 85 | + ==> root n (product(1..n) a) <= sum(1..n) a / &n`, |
| 86 | + INDUCT_TAC THEN REWRITE_TAC[ARITH; ARITH_RULE `1 <= SUC n`] THEN |
| 87 | + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN |
| 88 | + EXISTS_TAC `root(SUC n) ((sum(1..SUC n) a / &(SUC n)) pow (SUC n))` THEN |
| 89 | + CONJ_TAC THENL |
| 90 | + [MATCH_MP_TAC ROOT_MONO_LE THEN |
| 91 | + ASM_SIMP_TAC[AGM; ARITH_RULE `1 <= SUC n`] THEN |
| 92 | + MATCH_MP_TAC PRODUCT_POS_LE THEN |
| 93 | + ASM_REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG]; |
| 94 | + MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC POW_ROOT_POS THEN |
| 95 | + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; SUM_POS_LE_NUMSEG]]);; |
0 commit comments