100/arithmetic_geometric_mean.ml

   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]]);;